[project @ 1996-01-11 14:06:51 by partain]
authorpartain <unknown>
Thu, 11 Jan 1996 14:26:13 +0000 (14:26 +0000)
committerpartain <unknown>
Thu, 11 Jan 1996 14:26:13 +0000 (14:26 +0000)
623 files changed:
STARTUP.in
configure.in
ghc/CONTRIB/haskell-modes/README [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/chalmers/original/haskell-mode.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/chalmers/sof/haskell-mode.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/chalmers/thiemann/haskell-mode.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/glasgow/original/haskell-mode.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/simonm/ghc/haskell.el [moved from ghc/CONTRIB/haskell.el with 100% similarity]
ghc/CONTRIB/haskell-modes/simonm/real/haskell.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/chak/haskell.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/original/README [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/original/comint.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/original/haskell-menu.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/original/haskell.el [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/original/optimizer-help.txt [new file with mode: 0644]
ghc/CONTRIB/haskell-modes/yale/original/printer-help.txt [new file with mode: 0644]
ghc/compiler/Jmakefile
ghc/compiler/absCSyn/AbsCFuns.hi
ghc/compiler/absCSyn/AbsCFuns.lhs
ghc/compiler/absCSyn/AbsCSyn.hi
ghc/compiler/absCSyn/AbsCSyn.lhs
ghc/compiler/absCSyn/Costs.hi
ghc/compiler/absCSyn/Costs.lhs
ghc/compiler/absCSyn/HeapOffs.hi
ghc/compiler/absCSyn/PprAbsC.hi
ghc/compiler/absCSyn/PprAbsC.lhs
ghc/compiler/abstractSyn/AbsSyn.hi
ghc/compiler/abstractSyn/AbsSynFuns.hi
ghc/compiler/abstractSyn/HsBinds.hi
ghc/compiler/abstractSyn/HsCore.hi
ghc/compiler/abstractSyn/HsDecls.hi
ghc/compiler/abstractSyn/HsExpr.hi
ghc/compiler/abstractSyn/HsImpExp.hi
ghc/compiler/abstractSyn/HsLit.hi
ghc/compiler/abstractSyn/HsMatches.hi
ghc/compiler/abstractSyn/HsPat.hi
ghc/compiler/abstractSyn/HsPragmas.hi
ghc/compiler/abstractSyn/HsTypes.hi
ghc/compiler/abstractSyn/Name.hi
ghc/compiler/abstractSyn/Name.lhs
ghc/compiler/basicTypes/BasicLit.hi
ghc/compiler/basicTypes/CLabelInfo.hi
ghc/compiler/basicTypes/CLabelInfo.lhs
ghc/compiler/basicTypes/Id.hi
ghc/compiler/basicTypes/IdInfo.hi
ghc/compiler/basicTypes/Inst.hi
ghc/compiler/basicTypes/NameTypes.hi
ghc/compiler/basicTypes/NameTypes.lhs
ghc/compiler/basicTypes/OrdList.hi
ghc/compiler/basicTypes/ProtoName.hi
ghc/compiler/basicTypes/SplitUniq.hi
ghc/compiler/basicTypes/SrcLoc.hi
ghc/compiler/basicTypes/Unique.hi
ghc/compiler/basicTypes/Unique.lhs
ghc/compiler/codeGen/CgBindery.hi
ghc/compiler/codeGen/CgCase.hi
ghc/compiler/codeGen/CgCase.lhs
ghc/compiler/codeGen/CgClosure.hi
ghc/compiler/codeGen/CgClosure.lhs
ghc/compiler/codeGen/CgCompInfo.hi
ghc/compiler/codeGen/CgCompInfo.lhs
ghc/compiler/codeGen/CgCon.hi
ghc/compiler/codeGen/CgCon.lhs
ghc/compiler/codeGen/CgConTbls.hi
ghc/compiler/codeGen/CgConTbls.lhs
ghc/compiler/codeGen/CgExpr.hi
ghc/compiler/codeGen/CgExpr.lhs
ghc/compiler/codeGen/CgHeapery.hi
ghc/compiler/codeGen/CgLetNoEscape.hi
ghc/compiler/codeGen/CgLetNoEscape.lhs
ghc/compiler/codeGen/CgMonad.hi
ghc/compiler/codeGen/CgMonad.lhs
ghc/compiler/codeGen/CgRetConv.hi
ghc/compiler/codeGen/CgRetConv.lhs
ghc/compiler/codeGen/CgStackery.hi
ghc/compiler/codeGen/CgStackery.lhs
ghc/compiler/codeGen/CgTailCall.hi
ghc/compiler/codeGen/CgTailCall.lhs
ghc/compiler/codeGen/CgUpdate.hi
ghc/compiler/codeGen/CgUsages.hi
ghc/compiler/codeGen/ClosureInfo.hi
ghc/compiler/codeGen/ClosureInfo.lhs
ghc/compiler/codeGen/CodeGen.hi
ghc/compiler/codeGen/CodeGen.lhs
ghc/compiler/codeGen/SMRep.hi
ghc/compiler/codeGen/SMRep.lhs
ghc/compiler/coreSyn/AnnCoreSyn.hi
ghc/compiler/coreSyn/CoreFuns.hi
ghc/compiler/coreSyn/CoreLift.hi
ghc/compiler/coreSyn/CoreLint.hi
ghc/compiler/coreSyn/CoreSyn.hi
ghc/compiler/coreSyn/CoreUnfold.hi
ghc/compiler/coreSyn/FreeVars.hi
ghc/compiler/coreSyn/PlainCore.hi
ghc/compiler/coreSyn/TaggedCore.hi
ghc/compiler/deSugar/Desugar.hi
ghc/compiler/deSugar/DsBinds.hi
ghc/compiler/deSugar/DsCCall.hi
ghc/compiler/deSugar/DsExpr.hi
ghc/compiler/deSugar/DsGRHSs.hi
ghc/compiler/deSugar/DsListComp.hi
ghc/compiler/deSugar/DsMonad.hi
ghc/compiler/deSugar/DsUtils.hi
ghc/compiler/deSugar/Match.hi
ghc/compiler/deSugar/MatchCon.hi
ghc/compiler/deSugar/MatchLit.hi
ghc/compiler/deforest/Core2Def.hi
ghc/compiler/deforest/Cyclic.hi
ghc/compiler/deforest/Def2Core.hi
ghc/compiler/deforest/DefExpr.hi
ghc/compiler/deforest/DefSyn.hi
ghc/compiler/deforest/DefUtils.hi
ghc/compiler/deforest/Deforest.hi
ghc/compiler/deforest/TreelessForm.hi
ghc/compiler/envs/CE.hi
ghc/compiler/envs/E.hi
ghc/compiler/envs/IdEnv.hi
ghc/compiler/envs/InstEnv.hi
ghc/compiler/envs/LIE.hi
ghc/compiler/envs/TCE.hi
ghc/compiler/envs/TVE.hi
ghc/compiler/envs/TyVarEnv.hi
ghc/compiler/main/CmdLineOpts.hi
ghc/compiler/main/CmdLineOpts.lhs
ghc/compiler/main/ErrUtils.hi
ghc/compiler/main/Errors.hi
ghc/compiler/main/Errors.lhs
ghc/compiler/main/ErrsRn.hi
ghc/compiler/main/ErrsTc.hi
ghc/compiler/main/ErrsTc.lhs
ghc/compiler/main/Main.hi
ghc/compiler/main/Main.lhs
ghc/compiler/main/MainMonad.hi
ghc/compiler/main/MkIface.hi
ghc/compiler/nativeGen/AbsCStixGen.hi
ghc/compiler/nativeGen/AbsCStixGen.lhs
ghc/compiler/nativeGen/AlphaCode.hi
ghc/compiler/nativeGen/AlphaCode.lhs
ghc/compiler/nativeGen/AlphaDesc.hi
ghc/compiler/nativeGen/AlphaDesc.lhs
ghc/compiler/nativeGen/AlphaGen.hi
ghc/compiler/nativeGen/AlphaGen.lhs
ghc/compiler/nativeGen/AsmCodeGen.hi
ghc/compiler/nativeGen/AsmCodeGen.lhs
ghc/compiler/nativeGen/AsmRegAlloc.hi
ghc/compiler/nativeGen/AsmRegAlloc.lhs
ghc/compiler/nativeGen/I386Code.hi [new file with mode: 0644]
ghc/compiler/nativeGen/I386Code.lhs [new file with mode: 0644]
ghc/compiler/nativeGen/I386Desc.hi [new file with mode: 0644]
ghc/compiler/nativeGen/I386Desc.lhs [new file with mode: 0644]
ghc/compiler/nativeGen/I386Gen.hi [new file with mode: 0644]
ghc/compiler/nativeGen/I386Gen.lhs [new file with mode: 0644]
ghc/compiler/nativeGen/MachDesc.hi
ghc/compiler/nativeGen/MachDesc.lhs
ghc/compiler/nativeGen/SparcCode.hi
ghc/compiler/nativeGen/SparcCode.lhs
ghc/compiler/nativeGen/SparcDesc.hi
ghc/compiler/nativeGen/SparcDesc.lhs
ghc/compiler/nativeGen/SparcGen.hi
ghc/compiler/nativeGen/SparcGen.lhs
ghc/compiler/nativeGen/Stix.hi
ghc/compiler/nativeGen/Stix.lhs
ghc/compiler/nativeGen/StixInfo.hi
ghc/compiler/nativeGen/StixInfo.lhs
ghc/compiler/nativeGen/StixInteger.hi
ghc/compiler/nativeGen/StixInteger.lhs
ghc/compiler/nativeGen/StixMacro.hi
ghc/compiler/nativeGen/StixMacro.lhs
ghc/compiler/nativeGen/StixPrim.hi
ghc/compiler/nativeGen/StixPrim.lhs
ghc/compiler/prelude/AbsPrel.hi
ghc/compiler/prelude/AbsPrel.lhs
ghc/compiler/prelude/PrelFuns.hi
ghc/compiler/prelude/PrelVals.hi
ghc/compiler/prelude/PrelVals.lhs
ghc/compiler/prelude/PrimKind.hi
ghc/compiler/prelude/PrimOps.hi
ghc/compiler/prelude/PrimOps.lhs
ghc/compiler/prelude/TysPrim.hi
ghc/compiler/prelude/TysWiredIn.hi
ghc/compiler/prelude/TysWiredIn.lhs
ghc/compiler/profiling/CostCentre.hi
ghc/compiler/profiling/SCCauto.hi
ghc/compiler/profiling/SCCfinal.hi
ghc/compiler/reader/PrefixSyn.hi
ghc/compiler/reader/PrefixToHs.hi
ghc/compiler/reader/ReadPragmas2.hi
ghc/compiler/reader/ReadPrefix2.hi
ghc/compiler/rename/Rename.hi
ghc/compiler/rename/Rename1.hi
ghc/compiler/rename/Rename1.lhs
ghc/compiler/rename/Rename2.hi
ghc/compiler/rename/Rename3.hi
ghc/compiler/rename/Rename4.hi
ghc/compiler/rename/RenameAuxFuns.hi
ghc/compiler/rename/RenameBinds4.hi
ghc/compiler/rename/RenameBinds4.lhs
ghc/compiler/rename/RenameExpr4.hi
ghc/compiler/rename/RenameMonad12.hi
ghc/compiler/rename/RenameMonad3.hi
ghc/compiler/rename/RenameMonad4.hi
ghc/compiler/rename/RenameMonad4.lhs
ghc/compiler/simplCore/AnalFBWW.hi
ghc/compiler/simplCore/BinderInfo.hi
ghc/compiler/simplCore/ConFold.hi
ghc/compiler/simplCore/ConFold.lhs
ghc/compiler/simplCore/FloatIn.hi
ghc/compiler/simplCore/FloatOut.hi
ghc/compiler/simplCore/FloatOut.lhs
ghc/compiler/simplCore/FoldrBuildWW.hi
ghc/compiler/simplCore/LiberateCase.hi
ghc/compiler/simplCore/MagicUFs.hi
ghc/compiler/simplCore/NewOccurAnal.hi
ghc/compiler/simplCore/OccurAnal.hi
ghc/compiler/simplCore/SAT.hi
ghc/compiler/simplCore/SATMonad.hi
ghc/compiler/simplCore/SetLevels.hi
ghc/compiler/simplCore/SimplCase.hi
ghc/compiler/simplCore/SimplCase.lhs
ghc/compiler/simplCore/SimplCore.hi
ghc/compiler/simplCore/SimplEnv.hi
ghc/compiler/simplCore/SimplMonad.hi
ghc/compiler/simplCore/SimplPgm.hi
ghc/compiler/simplCore/SimplUtils.hi
ghc/compiler/simplCore/SimplVar.hi
ghc/compiler/simplCore/Simplify.hi
ghc/compiler/simplCore/Simplify.lhs
ghc/compiler/simplStg/LambdaLift.hi
ghc/compiler/simplStg/SatStgRhs.hi
ghc/compiler/simplStg/SimplStg.hi
ghc/compiler/simplStg/StgSAT.hi
ghc/compiler/simplStg/StgSATMonad.hi
ghc/compiler/simplStg/StgStats.hi
ghc/compiler/simplStg/StgStats.lhs
ghc/compiler/simplStg/StgVarInfo.hi
ghc/compiler/simplStg/UpdAnal.hi
ghc/compiler/specialise/SpecTyFuns.hi
ghc/compiler/specialise/Specialise.hi
ghc/compiler/stgSyn/CoreToStg.hi
ghc/compiler/stgSyn/CoreToStg.lhs
ghc/compiler/stgSyn/StgFuns.hi
ghc/compiler/stgSyn/StgLint.hi
ghc/compiler/stgSyn/StgSyn.hi
ghc/compiler/stranal/SaAbsInt.hi
ghc/compiler/stranal/SaAbsInt.lhs
ghc/compiler/stranal/SaLib.hi
ghc/compiler/stranal/SaLib.lhs
ghc/compiler/stranal/StrictAnal.hi
ghc/compiler/stranal/StrictAnal.lhs
ghc/compiler/stranal/WorkWrap.hi
ghc/compiler/stranal/WwLib.hi
ghc/compiler/typecheck/BackSubst.hi
ghc/compiler/typecheck/Disambig.hi
ghc/compiler/typecheck/GenSpecEtc.hi
ghc/compiler/typecheck/Spec.hi
ghc/compiler/typecheck/Subst.hi
ghc/compiler/typecheck/TcBinds.hi
ghc/compiler/typecheck/TcClassDcl.hi
ghc/compiler/typecheck/TcClassSig.hi
ghc/compiler/typecheck/TcConDecls.hi
ghc/compiler/typecheck/TcContext.hi
ghc/compiler/typecheck/TcDefaults.hi
ghc/compiler/typecheck/TcDeriv.hi
ghc/compiler/typecheck/TcDeriv.lhs
ghc/compiler/typecheck/TcExpr.hi
ghc/compiler/typecheck/TcExpr.lhs
ghc/compiler/typecheck/TcGRHSs.hi
ghc/compiler/typecheck/TcGenDeriv.hi
ghc/compiler/typecheck/TcGenDeriv.lhs
ghc/compiler/typecheck/TcIfaceSig.hi
ghc/compiler/typecheck/TcInstDcls.hi
ghc/compiler/typecheck/TcMatches.hi
ghc/compiler/typecheck/TcModule.hi
ghc/compiler/typecheck/TcMonad.hi
ghc/compiler/typecheck/TcMonad.lhs
ghc/compiler/typecheck/TcMonadFns.hi
ghc/compiler/typecheck/TcMonadFns.lhs
ghc/compiler/typecheck/TcMonoBnds.hi
ghc/compiler/typecheck/TcMonoType.hi
ghc/compiler/typecheck/TcPat.hi
ghc/compiler/typecheck/TcPolyType.hi
ghc/compiler/typecheck/TcPragmas.hi
ghc/compiler/typecheck/TcQuals.hi
ghc/compiler/typecheck/TcSimplify.hi
ghc/compiler/typecheck/TcTyDecls.hi
ghc/compiler/typecheck/Typecheck.hi
ghc/compiler/typecheck/Unify.hi
ghc/compiler/uniType/AbsUniType.hi
ghc/compiler/uniType/Class.hi
ghc/compiler/uniType/TyCon.hi
ghc/compiler/uniType/TyCon.lhs
ghc/compiler/uniType/TyVar.hi
ghc/compiler/uniType/UniTyFuns.hi
ghc/compiler/uniType/UniType.hi
ghc/compiler/utils/Bag.hi
ghc/compiler/utils/BitSet.hi
ghc/compiler/utils/CharSeq.hi
ghc/compiler/utils/Digraph.hi
ghc/compiler/utils/FiniteMap.hi
ghc/compiler/utils/FiniteMap.lhs
ghc/compiler/utils/LiftMonad.hi
ghc/compiler/utils/ListSetOps.hi
ghc/compiler/utils/Maybes.hi
ghc/compiler/utils/Outputable.hi
ghc/compiler/utils/Pretty.hi
ghc/compiler/utils/UniqFM.hi
ghc/compiler/utils/UniqSet.hi
ghc/compiler/utils/Unpretty.hi
ghc/compiler/utils/Util.hi
ghc/compiler/utils/Util.lhs
ghc/compiler/yaccParser/U_atype.hi
ghc/compiler/yaccParser/U_binding.hi
ghc/compiler/yaccParser/U_coresyn.hi
ghc/compiler/yaccParser/U_entidt.hi
ghc/compiler/yaccParser/U_finfot.hi
ghc/compiler/yaccParser/U_hpragma.hi
ghc/compiler/yaccParser/U_list.hi
ghc/compiler/yaccParser/U_literal.hi
ghc/compiler/yaccParser/U_pbinding.hi
ghc/compiler/yaccParser/U_treeHACK.hi
ghc/compiler/yaccParser/U_ttype.hi
ghc/compiler/yaccParser/UgenAll.hi
ghc/compiler/yaccParser/UgenUtil.hi
ghc/compiler/yaccParser/binding.ugn
ghc/compiler/yaccParser/finfot.ugn
ghc/compiler/yaccParser/hschooks.c
ghc/compiler/yaccParser/hslexer.flex
ghc/compiler/yaccParser/hsparser.y
ghc/compiler/yaccParser/id.c
ghc/compiler/yaccParser/import_dirlist.c
ghc/compiler/yaccParser/infix.c
ghc/compiler/yaccParser/main.c
ghc/compiler/yaccParser/printtree.c
ghc/compiler/yaccParser/syntax.c
ghc/compiler/yaccParser/tree.ugn
ghc/compiler/yaccParser/type2context.c
ghc/compiler/yaccParser/util.c
ghc/compiler/yaccParser/utils.h
ghc/docs/ANNOUNCE-0.26 [moved from ANNOUNCE-0.26 with 100% similarity]
ghc/docs/ANNOUNCE-0.27 [new file with mode: 0644]
ghc/docs/Jmakefile
ghc/docs/add_to_compiler/back-end.verb
ghc/docs/add_to_compiler/core-syntax.verb
ghc/docs/add_to_compiler/front-end.verb
ghc/docs/add_to_compiler/howto-add.verb
ghc/docs/add_to_compiler/overview.verb
ghc/docs/add_to_compiler/paper.verb
ghc/docs/grasp.sty
ghc/docs/state_interface/Jmakefile [new file with mode: 0644]
ghc/docs/state_interface/state-interface.verb [new file with mode: 0644]
ghc/docs/users_guide/how_to_run.lit
ghc/docs/users_guide/parallel.lit
ghc/docs/users_guide/prof-output.lit [new file with mode: 0644]
ghc/docs/users_guide/profiling.lit
ghc/docs/users_guide/runtime_control.lit
ghc/docs/users_guide/sooner.lit
ghc/driver/Jmakefile
ghc/driver/ghc-asm-alpha.lprl
ghc/driver/ghc-asm-hppa.lprl
ghc/driver/ghc-asm-iX86.lprl [deleted file]
ghc/driver/ghc-asm-m68k.lprl
ghc/driver/ghc-asm-mips.lprl
ghc/driver/ghc-asm-solaris.lprl
ghc/driver/ghc-asm-sparc.lprl
ghc/driver/ghc-asm.lprl [new file with mode: 0644]
ghc/driver/ghc-split.lprl
ghc/driver/ghc.lprl
ghc/includes/AgeProfile.lh [deleted file]
ghc/includes/COptJumps.lh
ghc/includes/COptRegs.lh
ghc/includes/COptWraps.lh
ghc/includes/CostCentre.lh
ghc/includes/Force_GC.lh [deleted file]
ghc/includes/GhcConstants.lh
ghc/includes/Jmakefile
ghc/includes/MachRegs.lh
ghc/includes/Parallel.lh
ghc/includes/RtsFlags.lh [new file with mode: 0644]
ghc/includes/RtsTypes.lh [moved from ghc/includes/rtsTypes.lh with 96% similarity]
ghc/includes/SMClosures.lh
ghc/includes/SMInfoTables.lh
ghc/includes/SMcompact.lh
ghc/includes/SMcopying.lh
ghc/includes/SMinterface.lh
ghc/includes/SMmark.lh
ghc/includes/SMupdate.lh
ghc/includes/StgMacros.lh
ghc/includes/StgRegs.lh
ghc/includes/StgTypes.lh
ghc/includes/Threads.lh
ghc/includes/Ticky.lh [moved from ghc/includes/RednCounts.lh with 71% similarity]
ghc/includes/ghcReadline.h
ghc/includes/mkNativeHdr.lc
ghc/includes/stgdefs.h
ghc/includes/stgio.h
ghc/includes/timezone.h
ghc/lib/Jmakefile
ghc/lib/ghc/BSD.hi
ghc/lib/ghc/BSD.lhs
ghc/lib/ghc/BSD_mc.hi
ghc/lib/ghc/BSD_mg.hi
ghc/lib/ghc/BSD_mp.hi
ghc/lib/ghc/BSD_p.hi
ghc/lib/ghc/BSD_t.hi
ghc/lib/ghc/CError.hi
ghc/lib/ghc/CError_mc.hi
ghc/lib/ghc/CError_mg.hi
ghc/lib/ghc/CError_mp.hi
ghc/lib/ghc/CError_p.hi
ghc/lib/ghc/CError_t.hi
ghc/lib/ghc/FiniteMap.hi
ghc/lib/ghc/FiniteMap.lhs
ghc/lib/ghc/FiniteMap_mc.hi
ghc/lib/ghc/FiniteMap_mg.hi
ghc/lib/ghc/FiniteMap_mp.hi
ghc/lib/ghc/FiniteMap_p.hi
ghc/lib/ghc/FiniteMap_t.hi
ghc/lib/ghc/MatchPS.lhs
ghc/lib/ghc/PackedString.hi
ghc/lib/ghc/PackedString.lhs
ghc/lib/ghc/PackedString_mc.hi
ghc/lib/ghc/PackedString_mp.hi
ghc/lib/ghc/PackedString_p.hi
ghc/lib/ghc/PackedString_t.hi
ghc/lib/ghc/Readline.lhs
ghc/lib/ghc/Set.hi
ghc/lib/ghc/Set.lhs
ghc/lib/ghc/Set_mc.hi
ghc/lib/ghc/Set_mg.hi
ghc/lib/ghc/Set_mp.hi
ghc/lib/ghc/Set_p.hi
ghc/lib/ghc/Set_t.hi
ghc/lib/ghc/Socket.lhs
ghc/lib/ghc/SocketPrim.hi
ghc/lib/ghc/SocketPrim.lhs
ghc/lib/ghc/SocketPrim_mc.hi
ghc/lib/ghc/SocketPrim_mg.hi
ghc/lib/ghc/SocketPrim_mp.hi
ghc/lib/ghc/SocketPrim_p.hi
ghc/lib/ghc/SocketPrim_t.hi
ghc/lib/glaExts/PreludeGlaST.hi
ghc/lib/glaExts/PreludeGlaST.lhs
ghc/lib/glaExts/PreludeGlaST_mc.hi
ghc/lib/glaExts/PreludeGlaST_mg.hi
ghc/lib/glaExts/PreludeGlaST_mp.hi
ghc/lib/glaExts/PreludeGlaST_p.hi
ghc/lib/glaExts/PreludeGlaST_t.hi
ghc/lib/haskell-1.3/LibCPUTime.lhs
ghc/lib/haskell-1.3/LibPosix.hi
ghc/lib/haskell-1.3/LibPosix.lhs
ghc/lib/haskell-1.3/LibPosixFiles.hi
ghc/lib/haskell-1.3/LibPosixFiles.lhs
ghc/lib/haskell-1.3/LibPosixFiles_mc.hi
ghc/lib/haskell-1.3/LibPosixFiles_mg.hi
ghc/lib/haskell-1.3/LibPosixFiles_mp.hi
ghc/lib/haskell-1.3/LibPosixFiles_p.hi
ghc/lib/haskell-1.3/LibPosixFiles_t.hi
ghc/lib/haskell-1.3/LibPosixProcPrim.hi
ghc/lib/haskell-1.3/LibPosixProcPrim_mc.hi
ghc/lib/haskell-1.3/LibPosixProcPrim_mp.hi
ghc/lib/haskell-1.3/LibPosixProcPrim_p.hi
ghc/lib/haskell-1.3/LibPosixProcPrim_t.hi
ghc/lib/haskell-1.3/LibPosix_mc.hi
ghc/lib/haskell-1.3/LibPosix_mg.hi
ghc/lib/haskell-1.3/LibPosix_mp.hi
ghc/lib/haskell-1.3/LibPosix_p.hi
ghc/lib/haskell-1.3/LibPosix_t.hi
ghc/lib/haskell-1.3/LibSystem.hi
ghc/lib/haskell-1.3/LibSystem_mc.hi
ghc/lib/haskell-1.3/LibSystem_mp.hi
ghc/lib/haskell-1.3/LibSystem_p.hi
ghc/lib/haskell-1.3/LibSystem_t.hi
ghc/lib/haskell-1.3/LibTime.lhs
ghc/lib/hbc/Time.hi
ghc/lib/hbc/Time_mc.hi
ghc/lib/hbc/Time_mp.hi
ghc/lib/hbc/Time_p.hi
ghc/lib/hbc/Time_t.hi
ghc/lib/make_extra_deps
ghc/lib/prelude/Builtin.hi
ghc/lib/prelude/Builtin.hs
ghc/lib/prelude/Builtin_mc.hi
ghc/lib/prelude/Builtin_mg.hi
ghc/lib/prelude/Builtin_mp.hi
ghc/lib/prelude/Builtin_p.hi
ghc/lib/prelude/Builtin_t.hi
ghc/lib/prelude/Channel.hi
ghc/lib/prelude/Channel.lhs
ghc/lib/prelude/Channel_mc.hi
ghc/lib/prelude/Channel_mp.hi
ghc/lib/prelude/Channel_p.hi
ghc/lib/prelude/Channel_t.hi
ghc/lib/prelude/Concurrent.hi
ghc/lib/prelude/Concurrent_mc.hi
ghc/lib/prelude/Concurrent_mp.hi
ghc/lib/prelude/Concurrent_p.hi
ghc/lib/prelude/Concurrent_t.hi
ghc/lib/prelude/IBool.hi
ghc/lib/prelude/IBool.hs
ghc/lib/prelude/IBool_mc.hi
ghc/lib/prelude/IBool_mp.hi
ghc/lib/prelude/IBool_p.hi
ghc/lib/prelude/IBool_t.hi
ghc/lib/prelude/IInt.hs
ghc/lib/prelude/IList.hs
ghc/lib/prelude/List.hs
ghc/lib/prelude/PS.hi
ghc/lib/prelude/PS.lhs
ghc/lib/prelude/PS_mc.hi
ghc/lib/prelude/PS_mg.hi
ghc/lib/prelude/PS_mp.hi
ghc/lib/prelude/PS_p.hi
ghc/lib/prelude/PS_t.hi
ghc/lib/prelude/PrelCore13.hi
ghc/lib/prelude/PrelCore13_mc.hi
ghc/lib/prelude/PrelCore13_mp.hi
ghc/lib/prelude/PrelCore13_p.hi
ghc/lib/prelude/PrelCore13_t.hi
ghc/lib/prelude/PreludeCore.hi
ghc/lib/prelude/PreludeCore_mc.hi
ghc/lib/prelude/PreludeCore_mp.hi
ghc/lib/prelude/PreludeCore_p.hi
ghc/lib/prelude/PreludeCore_t.hi
ghc/lib/prelude/PreludeStdIO.lhs
ghc/lib/unix-libs.lit [new file with mode: 0644]
ghc/misc/examples/nfib/nfib.c [new file with mode: 0644]
ghc/misc/examples/nfib/nfib.pl [new file with mode: 0644]
ghc/mkworld/GHC_OPTS
ghc/mkworld/only4-ghc.jm
ghc/mkworld/only4-ghc.ljm
ghc/mkworld/site-ghc.jm.in
ghc/runtime/Jmakefile
ghc/runtime/c-as-asm/CallWrap_C.lc
ghc/runtime/c-as-asm/HpOverflow.lc
ghc/runtime/c-as-asm/PerformIO.lhc
ghc/runtime/c-as-asm/StablePtrOps.lc
ghc/runtime/c-as-asm/StgDebug.lc
ghc/runtime/c-as-asm/StgMiniInt.lc
ghc/runtime/gum/FetchMe.lhc
ghc/runtime/gum/GlobAddr.lc
ghc/runtime/gum/HLComms.lc
ghc/runtime/gum/Hash.lc
ghc/runtime/gum/LLComms.lc
ghc/runtime/gum/Pack.lc
ghc/runtime/gum/ParInit.lc
ghc/runtime/gum/RBH.lc
ghc/runtime/gum/SysMan.lc
ghc/runtime/gum/Unpack.lc
ghc/runtime/hooks/OutOfHeap.lc
ghc/runtime/hooks/OutOfVM.lc
ghc/runtime/hooks/SizeHooks.lc
ghc/runtime/io/env.lc
ghc/runtime/io/getCPUTime.lc
ghc/runtime/io/getDirectoryContents.lc
ghc/runtime/io/ghcReadline.lc
ghc/runtime/io/showTime.lc
ghc/runtime/io/toClockSec.lc
ghc/runtime/io/toLocalTime.lc
ghc/runtime/io/toUTCTime.lc
ghc/runtime/main/GranSim.lc
ghc/runtime/main/Itimer.lc
ghc/runtime/main/Mallocs.lc [new file with mode: 0644]
ghc/runtime/main/RednCounts.lc [deleted file]
ghc/runtime/main/RtsFlags.lc [new file with mode: 0644]
ghc/runtime/main/Select.lc
ghc/runtime/main/Signals.lc
ghc/runtime/main/StgOverflow.lc
ghc/runtime/main/StgStartup.lhc
ghc/runtime/main/StgThreads.lhc
ghc/runtime/main/StgTrace.lc [deleted file]
ghc/runtime/main/StgUpdate.lhc
ghc/runtime/main/Threads.lc
ghc/runtime/main/Ticky.lc [new file with mode: 0644]
ghc/runtime/main/main.lc
ghc/runtime/prims/ByteOps.lc
ghc/runtime/prims/PrimArith.lc
ghc/runtime/profiling/CostCentre.lc
ghc/runtime/profiling/HeapProfile.lc
ghc/runtime/profiling/Indexing.lc
ghc/runtime/profiling/LifeProfile.lc [deleted file]
ghc/runtime/profiling/Timer.lc
ghc/runtime/storage/Force_GC.lc [deleted file]
ghc/runtime/storage/SM1s.lc
ghc/runtime/storage/SM2s.lc
ghc/runtime/storage/SMalloc.lc [deleted file]
ghc/runtime/storage/SMap.lc
ghc/runtime/storage/SMcheck.lc
ghc/runtime/storage/SMcompacting.lc
ghc/runtime/storage/SMcompacting.lh
ghc/runtime/storage/SMcopying.lc
ghc/runtime/storage/SMcopying.lh
ghc/runtime/storage/SMdu.lc
ghc/runtime/storage/SMevac.lc
ghc/runtime/storage/SMextn.lc
ghc/runtime/storage/SMextn.lh
ghc/runtime/storage/SMgen.lc
ghc/runtime/storage/SMinit.lc
ghc/runtime/storage/SMinternal.lh
ghc/runtime/storage/SMmark.lhc
ghc/runtime/storage/SMmarkDefs.lh
ghc/runtime/storage/SMmarking.lc
ghc/runtime/storage/SMscan.lc
ghc/runtime/storage/SMscav.lc
ghc/runtime/storage/SMstacks.lc
ghc/runtime/storage/SMstatic.lc
ghc/runtime/storage/SMstats.lc
ghc/runtime/storage/mprotect.lc
ghc/utils/Jmakefile
ghc/utils/heap-view/Graph.lhs [new file with mode: 0644]
ghc/utils/heap-view/HaskXLib.c [new file with mode: 0644]
ghc/utils/heap-view/HpView.lhs [new file with mode: 0644]
ghc/utils/heap-view/HpView2.lhs [new file with mode: 0644]
ghc/utils/heap-view/Jmakefile [new file with mode: 0644]
ghc/utils/heap-view/MAIL [new file with mode: 0644]
ghc/utils/heap-view/Makefile.original [new file with mode: 0644]
ghc/utils/heap-view/Parse.lhs [new file with mode: 0644]
ghc/utils/heap-view/README [new file with mode: 0644]
ghc/utils/heap-view/common-bits [new file with mode: 0644]
ghc/utils/mkdependHS/mkdependHS.prl
ghc/utils/ugen/gen.c
glafp-utils/scripts/runstdtest.prl

index d8b9171..814426a 100644 (file)
@@ -65,26 +65,35 @@ done
 
 # OK, now make the \`real' Makefiles
 
 
 # OK, now make the \`real' Makefiles
 
-for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ ; do
+passed_in_setup="-S @MkWorldSetup@"
+
+for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ EndOfList ; do
+  if [ $i = nofib ] ; then
+     setup=$passed_in_setup
+  else
+     setup=''
+  fi
   if [ -d $i ] ; then
     ( set -e;                                                                  \
       cd $i ;                                                                  \
       echo '' ;                                                                        \
       echo "*** configuring $i ..." ;                                          \
   if [ -d $i ] ; then
     ( set -e;                                                                  \
       cd $i ;                                                                  \
       echo '' ;                                                                        \
       echo "*** configuring $i ..." ;                                          \
-      make -f Makefile.BOOT BOOT_DEFINES="-P $i -S @MkWorldSetup@ -C mkworld -DTopDirPwd=$hardtop";    \
+      make -f Makefile.BOOT BOOT_DEFINES="-P $i $setup -C mkworld -DTopDirPwd=$hardtop"; \
       echo '' ;                                                                        \
       echo "*** making Makefiles in $i ..." ;                                  \
       make Makefile ;                                                          \
       make Makefiles                                                           \
     )
   else
       echo '' ;                                                                        \
       echo "*** making Makefiles in $i ..." ;                                  \
       make Makefile ;                                                          \
       make Makefiles                                                           \
     )
   else
-    echo warning: $i is not a directory -- doing nothing for it
+    if [ $i != EndOfList ] ; then
+       echo warning: $i is not a directory -- doing nothing for it
+    fi
   fi
 done
 
 # Finally, the dependencies
 
   fi
 done
 
 # Finally, the dependencies
 
-for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ ; do
+for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ EndOfList ; do
   if [ -d $i ] ; then
     ( set -e;                                                                  \
       cd $i ;                                                                  \
   if [ -d $i ] ; then
     ( set -e;                                                                  \
       cd $i ;                                                                  \
@@ -93,7 +102,9 @@ for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ ; do
       make depend                                                              \
     )
   else
       make depend                                                              \
     )
   else
-    echo warning: $i is not a directory -- doing nothing for it
+    if [ $i != EndOfList ] ; then
+       echo warning: $i is not a directory -- doing nothing for it
+    fi
   fi
 done
 
   fi
 done
 
@@ -101,14 +112,16 @@ echo ''
 echo '*******************************************************************'
 echo "* Looking good! All you should need to do now is...               *"
 echo '*                                                                 *'
 echo '*******************************************************************'
 echo "* Looking good! All you should need to do now is...               *"
 echo '*                                                                 *'
-for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ ; do
-    echo "        cd $i"
-    if [ $i = nofib ] ; then
-       echo '        make all        # or...'
-       echo '        make runtests'
-    else
-       echo '        make all'
-       echo '        make install   # if you are so inclined...'
+for i in @DoingGHC@ @DoingHappy@ @DoingHaggis@ @DoingNoFib@ EndOfList ; do
+    if [ $i != EndOfList ] ; then
+       echo "        cd $i"
+       if [ $i = nofib ] ; then
+           echo '        make all        # or...'
+           echo '        make runtests'
+       else
+           echo '        make all'
+           echo '        make install   # if you are so inclined...'
+       fi
     fi
 done
 echo '*                                                                 *'
     fi
 done
 echo '*                                                                 *'
index 4958303..cfadc77 100644 (file)
@@ -386,9 +386,12 @@ mips-sgi-irix*)
         HostVendor_CPP='sgi'
         HostOS_CPP='irix'
         ;;
         HostVendor_CPP='sgi'
         HostOS_CPP='irix'
         ;;
-rs6000-ibm-aix*)
-        HostPlatform_CPP='rs6000_ibm_aix'
-        HostArch_CPP='rs6000'
+powerpc-ibm-aix*)
+       HostPlatform=powerpc-ibm-aix
+       TargetPlatform=powerpc-ibm-aix #hack
+       BuildPlatform=powerpc-ibm-aix #hack
+        HostPlatform_CPP='powerpc_ibm_aix'
+        HostArch_CPP='powerpc'
         HostVendor_CPP='ibm'
         HostOS_CPP='aix'
         ;;
         HostVendor_CPP='ibm'
         HostOS_CPP='aix'
         ;;
@@ -502,8 +505,12 @@ glafp-utils/perl-4.035-fixes to your 4.035 perl.
 "
         fi
     else
 "
         fi
     else
-        echo "I'm not sure if your version of perl will work,"
-        echo "but it's worth a shot, eh?"
+       if egrep "version 5" conftest.out >/dev/null 2>&1; then
+           :
+       else
+           echo "I'm not sure if your version of perl will work,"
+           echo "but it's worth a shot, eh?"
+       fi
     fi
     rm -fr conftest*
 fi
     fi
     rm -fr conftest*
 fi
@@ -898,6 +905,9 @@ GhcBuild_l='NO'
 GhcBuild_m='NO'
 GhcBuild_n='NO'
 GhcBuild_o='NO'
 GhcBuild_m='NO'
 GhcBuild_n='NO'
 GhcBuild_o='NO'
+GhcBuild_A='NO'
+GhcBuild_B='NO'
+# More could be added here...
 
 AC_ARG_ENABLE(normal-build,
    [
 
 AC_ARG_ENABLE(normal-build,
    [
@@ -1219,6 +1229,30 @@ dnl              exit 1
 dnl              ;;
 dnl     esac])
 dnl 
 dnl              ;;
 dnl     esac])
 dnl 
+dnl AC_ARG_ENABLE(user-way-A,
+dnl    [--enable-user-way-A    build for \`user way A' (mostly for implementors)],
+dnl    [case "$enableval" in
+dnl         yes) GhcBuild_A='YES'
+dnl              ;;
+dnl         no)  GhcBuild_A='NO'
+dnl              ;;
+dnl         *)   echo "I don't understand this option: --enable-user-way-A=$enableval"
+dnl              exit 1
+dnl              ;;
+dnl     esac])
+dnl 
+dnl AC_ARG_ENABLE(user-way-B,
+dnl    [--enable-user-way-B    build for \`user way B' (mostly for implementors)],
+dnl    [case "$enableval" in
+dnl         yes) GhcBuild_B='YES'
+dnl              ;;
+dnl         no)  GhcBuild_B='NO'
+dnl              ;;
+dnl         *)   echo "I don't understand this option: --enable-user-way-B=$enableval"
+dnl              exit 1
+dnl              ;;
+dnl     esac])
+dnl 
 AC_SUBST(GhcBuild_normal)
 AC_SUBST(GhcBuild_p)
 AC_SUBST(GhcBuild_t)
 AC_SUBST(GhcBuild_normal)
 AC_SUBST(GhcBuild_p)
 AC_SUBST(GhcBuild_t)
@@ -1246,6 +1280,8 @@ dnl AC_SUBST(GhcBuild_l)
 dnl AC_SUBST(GhcBuild_m)
 dnl AC_SUBST(GhcBuild_n)
 dnl AC_SUBST(GhcBuild_o)
 dnl AC_SUBST(GhcBuild_m)
 dnl AC_SUBST(GhcBuild_n)
 dnl AC_SUBST(GhcBuild_o)
+dnl AC_SUBST(GhcBuild_A)
+dnl AC_SUBST(GhcBuild_B)
 
 #---------------------------------------------------------------
 #
 
 #---------------------------------------------------------------
 #
@@ -1336,7 +1372,7 @@ AC_ARG_ENABLE(portable-C,
 
 if test $GhcWithRegisterised = 'YES'; then
     case $HostPlatform in
 
 if test $GhcWithRegisterised = 'YES'; then
     case $HostPlatform in
-    alpha-* | hppa1.1-* | i386-* | m68k-* | mips-* | sparc-* )
+    alpha-* | hppa1.1-* | i386-* | m68k-* | mips-* | powerpc-* | sparc-* )
        ;;
     *)
        echo "Don't know non-portable C tricks for this platform: $HostPlatform"
        ;;
     *)
        echo "Don't know non-portable C tricks for this platform: $HostPlatform"
@@ -1428,7 +1464,7 @@ AC_ARG_ENABLE(native-code-generator,
     esac])
 if test $GhcWithNativeCodeGen = 'YES'; then
     case $TargetPlatform in
     esac])
 if test $GhcWithNativeCodeGen = 'YES'; then
     case $TargetPlatform in
-    sparc-sun-sunos4 | sparc-sun-solaris2 | alpha-dec-osf1 )
+    i386-* | alpha-* | sparc-* )
        ;;
     *)
        echo "Don't have a native-code generator for this platform: $TargetPlatform"
        ;;
     *)
        echo "Don't have a native-code generator for this platform: $TargetPlatform"
@@ -1645,6 +1681,34 @@ fi
 #
 # -------------------------------------------------------------------------
 dnl
 #
 # -------------------------------------------------------------------------
 dnl
+dnl * `Literate' CONFIGURATION STUFF
+
+if test "xxx$DoingLiterate" = 'xxxliterate' ; then
+# a very big "if"!
+
+BuildInfoUtils='NO'
+AC_ARG_ENABLE(info-utils,
+   [
+*******************************************************************
+** Literate programming system OPTIONS:
+
+--enable-info-utils       build GNU info/makeinfo utilities],
+   [case "$enableval" in
+        yes) BuildInfoUtils='YES'
+             ;;
+        no)  BuildInfoUtils='NO'
+             ;;
+        *)   echo "I don't understand this option: --enable-info-utils=$enableval"
+             exit 1
+             ;;
+    esac])
+AC_SUBST(BuildInfoUtils)
+
+# here ends a very big if DoingLiterate = 'literate' ...
+fi
+#
+# -------------------------------------------------------------------------
+dnl
 dnl * `NoFib' CONFIGURATION STUFF
 
 if test "xxx$DoingNoFib" = 'xxxnofib' ; then
 dnl * `NoFib' CONFIGURATION STUFF
 
 if test "xxx$DoingNoFib" = 'xxxnofib' ; then
@@ -1726,8 +1790,8 @@ AC_SUBST(WithNoFibHcType)
 dnl ** what mkworld \`setup' should be used?
 AC_ARG_WITH(setup,
    [
 dnl ** what mkworld \`setup' should be used?
 AC_ARG_WITH(setup,
    [
-What mkworld \`setup' should be used?
-Choices: ghc, hbc, nhc
+--with-setup=<setup> : What mkworld \`setup' should be used?
+                       Choices: ghc, hbc, nhc
 ],
    [case "$withval" in
         ghc )   MkWorldSetup='ghc'
 ],
    [case "$withval" in
         ghc )   MkWorldSetup='ghc'
@@ -1736,7 +1800,7 @@ Choices: ghc, hbc, nhc
                 ;;
         nhc )   MkWorldSetup='nhc'
                ;;
                 ;;
         nhc )   MkWorldSetup='nhc'
                ;;
-        *)      echo "I don't understand this option: --with-hc-for-nofib=$withval"
+        *)      echo "I don't understand this option: --with-setup=$withval"
                 exit 1
                 ;;
     esac])
                 exit 1
                 ;;
     esac])
diff --git a/ghc/CONTRIB/haskell-modes/README b/ghc/CONTRIB/haskell-modes/README
new file mode 100644 (file)
index 0000000..248460d
--- /dev/null
@@ -0,0 +1,55 @@
+I've collected all the Haskell modes for GNU Emacs that I could lay my
+hands on -- there are billions.  A list is attached, grouped by
+"family".
+
+I don't like "mode junk" myself, so I don't use any of them.  I will
+include advertising or testimonials from happy users if they send them
+along...
+
+Will Partain
+partain@dcs.glasgow.ac.uk
+95/12/05
+
+=======================================================================
+
+* "Chalmers Haskell mode family" -- "Major mode for editing Haskell",
+  by Lars Bo Nielsen and Lennart Augustsson.
+
+  chalmers/original -- the original -- version 0.1.
+
+  chalmers/thiemann -- Peter Thiemann added "indentation stuff"
+       and fontification -- version 0.2.
+
+  chalmers/sof -- Sigbjorn Finne's <sof@dcs.glasgow.ac.uk> hacked
+       version of Thiemann's.
+
+.......................................................................
+
+* "Glasgow Haskell mode family" -- originally written by Richard McPhee
+  et al., at Glasgow University, as a student project, for Kevin
+  Hammond.
+
+  glasgow/original : version 1.0, now maintained by
+       gem@minster.york.ac.uk
+
+.......................................................................
+
+* "Simon Marlow Haskell mode family" -- This is the one that comes
+  with GHC, versions 0.16 up to at least 0.26.
+
+  simonm/real : the real thing
+
+  simonm/ghc : the one distributed with GHC 0.16-0.26; no particular
+       reason to prefer this one...
+
+.......................................................................
+
+* "Yale Haskell mode family" -- Especially good for chatting to a
+  Yale-Haskell inferior process :-)
+
+  yale/original : the real thing
+
+  yale/chak : "extended by Manuel M.T. Chakravarty with rudimentary
+       editing features (including better syntax table) and support
+       for the font-lock-mode."  Via Hans Wolfgang Loidl
+       <hwloidl@dcs.glasgow.ac.uk>
diff --git a/ghc/CONTRIB/haskell-modes/chalmers/original/haskell-mode.el b/ghc/CONTRIB/haskell-modes/chalmers/original/haskell-mode.el
new file mode 100644 (file)
index 0000000..167956d
--- /dev/null
@@ -0,0 +1,543 @@
+;; haskell-mode.el. Major mode for editing Haskell.
+;; Copyright (C) 1989, Free Software Foundation, Inc., Lars Bo Nielsen
+;; and Lennart Augustsson
+
+;; This file is not officially part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Haskell Mode. A major mode for editing and running Haskell. (Version 0.0)
+;; =================================================================
+;;
+;; This is a mode for editing and running Haskell.
+;; It is very much based on the sml mode for GNU Emacs. It
+;; features:
+;;
+;;      - Inferior shell running Haskell. No need to leave emacs, just
+;;        keep right on editing while Haskell runs in another window.
+;;
+;;      - Automatic "load file" in inferior shell. Send regions of code
+;;        to the Haskell program.
+;;
+;;
+;; 1. HOW TO USE THE Haskell-MODE
+;; ==========================
+;;
+;; Here is a short introduction to the mode.
+;;
+;; 1.1 GETTING STARTED
+;; -------------------
+;;
+;; If you are an experienced user of Emacs, just skip this section.
+;;
+;; To use the haskell-mode, insert this in your "~/.emacs" file (Or ask your
+;; emacs-administrator to help you.):
+;;
+;;    (setq auto-mode-alist (cons '("\\.hs$" . haskell-mode) (cons '("\\.lhs$" . haskell-mode)
+;;                           auto-mode-alist)))
+;;    (autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t)
+;;
+;; Now every time a file with the extension `.hs' or `.lhs' is found, it is
+;; automatically started up in haskell-mode.
+;;
+;; You will also have to specify the path to this file, so you will have
+;; to add this as well:
+;;
+;;    (setq load-path (cons "/usr/me/emacs" load-path))
+;;
+;; where "/usr/me/emacs" is the directory where this file is.
+;;
+;; You may also want to compile the this file (M-x byte-compile-file)
+;; for speed.
+;;
+;; You are now ready to start using haskell-mode. If you have tried other
+;; language modes (like lisp-mode or C-mode), you should have no
+;; problems. There are only a few extra functions in this mode.
+;;
+;; 1.2. EDITING COMMANDS.
+;; ----------------------
+;;
+;; The following editing and inferior-shell commands can ONLY be issued
+;; from within a buffer in haskell-mode.
+;;
+;; LFD (reindent-then-newline-and-indent).  
+;;     This is probably the function you will be using the most (press
+;;     CTRL while you press Return, press C-j or press Newline). It
+;;     will reindent the line, then make a new line and perform a new
+;;     indentation.
+;;
+;; M-; (indent-for-comment).
+;;     Like in other language modes, this command will give you a comment
+;;     at the of the current line. The column where the comment starts is
+;;     determined by the variable comment-column (default: 40).
+;;    
+;; C-c C-v (haskell-mode-version). 
+;;     Get the version of the haskell-mode.
+;;
+;;
+;; 1.3. COMMANDS RELATED TO THE INFERIOR SHELL
+;; -------------------------------------------
+;;
+;; C-c C-s (haskell-pop-to-shell).
+;;     This command starts up an inferior shell running haskell. If the shell
+;;     is running, it will just pop up the shell window.
+;;
+;; C-c C-u (haskell-save-buffer-use-file).
+;;     This command will save the current buffer and send a "load file",
+;;     where file is the file visited by the current buffer, to the
+;;     inferior shell running haskell.
+;;
+;; C-c C-f (haskell-run-on-file).
+;;     Will send a "load file" to the inferior shell running haskell,
+;;     prompting you for the file name.
+;;    
+;; C-c C-r (haskell-send-region). 
+;;     Will send region, from point to mark, to the inferior shell
+;;     running haskell.
+;;
+;; C-c C-b (haskell-send-buffer). 
+;;     Will send whole buffer to inferior shell running haskell.
+;;
+;; 2. INDENTATION
+;; ================
+;; Not yet.
+;;
+;; 3. INFERIOR SHELL.
+;; ==================
+;;
+;; The mode for Standard ML also contains a mode for an inferior shell
+;; running haskell. The mode is the same as the shell-mode, with just one
+;; extra command.
+;;
+;; 3.1. INFERIOR SHELL COMMANDS
+;; ----------------------------
+;;
+;; C-c C-f (haskell-run-on-file).  Send a `load file' to the process running
+;; haskell.
+;;
+;; 3.2. CONSTANTS CONTROLLING THE INFERIOR SHELL MODE
+;; --------------------------------------------------
+;;
+;; Because haskell is called differently on various machines, and the
+;; haskell-systems have their own command for reading in a file, a set of
+;; constants controls the behavior of the inferior shell running haskell (to
+;; change these constants: See CUSTOMIZING YOUR Haskell-MODE below).
+;;
+;; haskell-prog-name (default "hbi").
+;;     This constant is a string, containing the command to invoke
+;;     Standard ML on your system. 
+;;
+;; haskell-use-right-delim (default "\"")
+;; haskell-use-left-delim  (default "\"")
+;;     The left and right delimiter used by your version of haskell, for
+;;     `use file-name'.
+;;
+;; haskell-process-name (default "Haskell"). 
+;;     The name of the process running haskell. (This will be the name
+;;     appearing on the mode line of the buffer)
+;;
+;; NOTE: The haskell-mode functions: haskell-send-buffer, haskell-send-function and
+;; haskell-send-region, creates temporary files (I could not figure out how
+;; to send large amounts of data to a process). These files will be
+;; removed when you leave emacs.
+;;
+;;
+;; 4. CUSTOMIZING YOUR Haskell-MODE
+;; ============================
+;;
+;; If you have to change some of the constants, you will have to add a
+;; `hook' to the haskell-mode. Insert this in your "~/.emacs" file.
+;;
+;;    (setq haskell-mode-hook 'my-haskell-constants)
+;;
+;; Your function "my-haskell-constants" will then be executed every time
+;; "haskell-mode" is invoked.  Now you only have to write the emacs-lisp
+;; function "my-haskell-constants", and put it in your "~/.emacs" file.
+;;
+;; Say you are running a version of haskell that uses the syntax `load
+;; ["file"]', is invoked by the command "OurHaskell" and you don't want the
+;; indentation algorithm to indent according to open parenthesis, your
+;; function should look like this:
+;;
+;;    (defun my-haskell-constants ()
+;;       (setq haskell-prog-name "OurHaskell")
+;;       (setq haskell-use-left-delim "[\"")
+;;       (setq haskell-use-right-delim "\"]")
+;;       (setq haskell-paren-lookback nil))
+;;
+;; The haskell-shell also runs a `hook' (haskell-shell-hook) when it is invoked.
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; ORIGINAL AUTHOR
+;;         Lars Bo Nielsen
+;;         Aalborg University
+;;         Computer Science Dept.
+;;         9000 Aalborg
+;;         Denmark
+;;
+;;         lbn@iesd.dk
+;;         or: ...!mcvax!diku!iesd!lbn
+;;         or: mcvax!diku!iesd!lbn@uunet.uu.net
+;;
+;; MODIFIED FOR Haskell BY
+;;        Lennart Augustsson
+;;
+;;
+;; Please let me know if you come up with any ideas, bugs, or fixes.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst haskell-mode-version-string
+  "HASKELL-MODE, Version 0.1")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; CONSTANTS CONTROLLING THE MODE.
+;;;
+;;; These are the constants you might want to change
+;;; 
+
+;; The command used to start up the haskell-program.
+(defconst haskell-prog-name "hbi" "*Name of program to run as haskell.")
+
+;; The left delimmitter for `load file'
+(defconst haskell-use-left-delim "\""
+  "*The left delimiter for the filename when using \"load\".")
+
+;; The right delimmitter for `load file'
+(defconst haskell-use-right-delim "\""
+  "*The right delimiter for the filename when using \"load\".")
+
+;; A regular expression matching the prompt pattern in the inferior
+;; shell
+(defconst haskell-shell-prompt-pattern "^> *"
+  "*The prompt pattern for the inferion shell running haskell.")
+
+;; The template used for temporary files, created when a region is
+;; send to the inferior process running haskell.
+(defconst haskell-tmp-template "/tmp/haskell.tmp."
+  "*Template for the temporary file, created by haskell-simulate-send-region.")
+
+;; The name of the process running haskell (This will also be the name of
+;; the buffer).
+(defconst haskell-process-name "Haskell" "*The name of the Haskell-process")
+
+;;;
+;;; END OF CONSTANTS CONTROLLING THE MODE.
+;;;
+;;; If you change anything below, you are on your own.
+;;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defvar haskell-mode-syntax-table nil "The syntax table used in haskell-mode.")
+
+(defvar haskell-mode-map nil "The mode map used in haskell-mode.")
+
+(defun haskell-mode ()
+  "Major mode for editing Haskell code.
+Tab indents for Haskell code.
+Comments are delimited with --
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+
+Key bindings:
+=============
+
+\\[haskell-pop-to-shell]\t  Pop to the haskell window.
+\\[haskell-save-buffer-use-file]\t  Save the buffer, and send a \"load file\".
+\\[haskell-send-region]\t  Send region (point and mark) to haskell.
+\\[haskell-run-on-file]\t  Send a \"load file\" to haskell.
+\\[haskell-send-buffer]\t  Send whole buffer to haskell.
+\\[haskell-mode-version]\t  Get the version of haskell-mode.
+\\[haskell-evaluate-expression]\t  Prompt for an expression and evalute it.
+
+
+Mode map
+========
+\\{haskell-mode-map}
+Runs haskell-mode-hook if non nil."
+  (interactive)
+  (kill-all-local-variables)
+  (if haskell-mode-map
+      ()
+    (setq haskell-mode-map (make-sparse-keymap))
+    (define-key haskell-mode-map "\C-c\C-v" 'haskell-mode-version)
+    (define-key haskell-mode-map "\C-c\C-u" 'haskell-save-buffer-use-file)
+    (define-key haskell-mode-map "\C-c\C-s" 'haskell-pop-to-shell)
+    (define-key haskell-mode-map "\C-c\C-r" 'haskell-send-region)
+    (define-key haskell-mode-map "\C-c\C-m" 'haskell-region)
+    (define-key haskell-mode-map "\C-c\C-f" 'haskell-run-on-file)
+    (define-key haskell-mode-map "\C-c\C-b" 'haskell-send-buffer)
+    (define-key haskell-mode-map "\C-ce"    'haskell-evaluate-expression)
+    (define-key haskell-mode-map "\C-j" 'reindent-then-newline-and-indent)
+    (define-key haskell-mode-map "\177" 'backward-delete-char-untabify))
+  (use-local-map haskell-mode-map)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell")
+  (define-abbrev-table 'haskell-mode-abbrev-table ())
+  (setq local-abbrev-table haskell-mode-abbrev-table)
+  (if haskell-mode-syntax-table
+      ()
+    (setq haskell-mode-syntax-table (make-syntax-table))
+    (modify-syntax-entry ?\( "()1" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\) ")(4" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\\ "." haskell-mode-syntax-table)
+    (modify-syntax-entry ?* ". 23" haskell-mode-syntax-table)
+        ;; Special characters in haskell-mode to be treated as normal
+    ;; characters:
+    (modify-syntax-entry ?_ "w" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\' "w" haskell-mode-syntax-table)
+    )
+  (set-syntax-table haskell-mode-syntax-table)
+  (make-local-variable 'require-final-newline) ; Always put a new-line
+  (setq require-final-newline t)       ; in the end of file
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'haskell-indent-line)
+  (make-local-variable 'comment-start)
+  (setq comment-start "-- ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-column)
+  (setq comment-column 39)             ; Start of comment in this column
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "(\\*+[ \t]?") ; This matches a start of comment
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'haskell-comment-indent)
+  ;;
+  ;; Adding these will fool the matching of parens. I really don't
+  ;; know why. It would be nice to have comments treated as
+  ;; white-space
+  ;; 
+  ;; (make-local-variable 'parse-sexp-ignore-comments)
+  ;; (setq parse-sexp-ignore-comments t)
+  ;; 
+  (run-hooks 'haskell-mode-hook))              ; Run the hook
+
+(defun haskell-mode-version ()
+  (interactive)
+  (message haskell-mode-version-string))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; INDENTATION
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun haskell-indent-line ()
+  "Indent current line of Haskell code."
+  (interactive)
+  (let ((indent (haskell-calculate-indentation)))
+    (if (/= (current-indentation) indent)
+       (let ((beg (progn (beginning-of-line) (point))))
+         (skip-chars-forward "\t ")
+         (delete-region beg (point))
+         (indent-to indent))
+      ;; If point is before indentation, move point to indentation
+      (if (< (current-column) (current-indentation))
+         (skip-chars-forward "\t ")))))
+
+(defun haskell-calculate-indentation ()
+  (save-excursion
+    (previous-line 1)
+    (beginning-of-line)                        ; Go to first non whitespace
+    (skip-chars-forward "\t ")         ; on the line.
+    (current-column)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; INFERIOR SHELL
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar haskell-shell-map nil "The mode map for haskell-shell.")
+
+(defun haskell-shell ()
+  "Inferior shell invoking Haskell.
+It is not possible to have more than one shell running Haskell.
+Like the shell mode with the additional command:
+
+\\[haskell-run-on-file]\t Runs haskell on the file.
+\\{haskell-shell-map}
+Variables controlling the mode:
+
+haskell-prog-name (default \"hbi\")
+    The string used to invoke the haskell program.
+
+haskell-use-right-delim (default \"\\\"\")
+haskell-use-left-delim  (default \"\\\"\")
+    The left and right delimiter used by your version of haskell, for
+    \"load file-name\".
+
+haskell-process-name (default \"Haskell\")
+    The name of the process running haskell.
+
+haskell-shell-prompt-pattern (default \"^> *\")
+    The prompt pattern.
+
+Runs haskell-shell-hook if not nil."
+  (interactive)
+  (if (not (process-status haskell-process-name))
+      (save-excursion                  ; Process is not running
+       (message "Starting Haskell...") ; start up a new process
+       (require 'shell)
+       (set-buffer (make-shell haskell-process-name haskell-prog-name))
+       (erase-buffer)                  ; Erase the buffer if a previous
+       (if haskell-shell-map           ; process died in there
+           ()
+         (setq haskell-shell-map (copy-sequence shell-mode-map))
+         (define-key haskell-shell-map "\C-c\C-f" 'haskell-run-on-file))
+       (use-local-map haskell-shell-map)
+       (make-local-variable 'shell-prompt-pattern)
+       (setq shell-prompt-pattern haskell-shell-prompt-pattern)
+       (setq major-mode 'haskell-shell)
+       (setq mode-name "Haskell Shell")
+       (setq mode-line-format 
+             "-----Emacs: %17b   %M   %[(%m: %s)%]----%3p--%-")
+       (set-process-filter (get-process haskell-process-name) 'haskell-process-filter)
+       (message "Starting Haskell...done.")
+       (run-hooks 'haskell-shell-hook))))
+
+(defun haskell-process-filter (proc str)
+  (let ((cur (current-buffer))
+       (pop-up-windows t))
+    (pop-to-buffer (concat "*" haskell-process-name "*"))
+    (goto-char (point-max))
+    (if (string= str "\b\b\b  \b\b\b")
+       (backward-delete-char 4)
+      (insert str))
+    (set-marker (process-mark proc) (point-max))
+    (pop-to-buffer cur)))
+
+(defun haskell-pop-to-shell ()
+  (interactive)
+  (haskell-shell)
+  (pop-to-buffer (concat "*" haskell-process-name "*")))
+
+(defun haskell-run-on-file (fil)
+  (interactive "FRun Haskell on : ")
+  (haskell-shell)
+  (save-some-buffers)
+  (send-string haskell-process-name
+              (concat "load " haskell-use-left-delim (expand-file-name fil)
+                      haskell-use-right-delim ";\n")))
+
+(defun haskell-save-buffer-use-file ()
+  "Save the buffer, and send a `use file' to the inferior shell
+running Haskell."
+  (interactive)
+  (let (file)
+    (if (setq file (buffer-file-name)) ; Is the buffer associated
+       (progn                          ; with file ?
+         (save-buffer)
+         (haskell-shell)
+         (send-string haskell-process-name
+                      (concat "load " haskell-use-left-delim
+                              (expand-file-name file)
+                              haskell-use-right-delim ";\n")))
+      (error "Buffer not associated with file."))))
+
+(defvar haskell-tmp-files-list nil
+  "List of all temporary files created by haskell-simulate-send-region.
+Each element in the list is a list with the format:
+
+      (\"tmp-filename\"  buffer  start-line)")
+
+(defvar haskell-simulate-send-region-called-p nil
+  "Has haskell-simulate-send-region been called previously.")
+
+(defun haskell-make-temp-name (pre)
+  (concat (make-temp-name pre) ".m"))
+
+(defun haskell-simulate-send-region (point1 point2)
+  "Simulate send region. As send-region only can handle what ever the
+system sets as the default, we have to make a temporary file.
+Updates the list of temporary files (haskell-tmp-files-list)."
+  (let ((file (expand-file-name (haskell-make-temp-name haskell-tmp-template))))
+    ;; Remove temporary files when we leave emacs
+    (if (not haskell-simulate-send-region-called-p)
+       (progn
+         (setq haskell-old-kill-emacs-hook kill-emacs-hook)
+         (setq kill-emacs-hook 'haskell-remove-tmp-files)
+         (setq haskell-simulate-send-region-called-p t)))
+    (save-excursion
+      (goto-char point1)
+      (setq haskell-tmp-files-list
+           (cons (list file
+                       (current-buffer)
+                       (save-excursion ; Calculate line no.
+                         (beginning-of-line)
+                         (1+ (count-lines 1 (point)))))
+                 haskell-tmp-files-list)))
+    (write-region point1 point2 file nil 'dummy)
+    (haskell-shell)
+    (message "Using temporary file: %s" file)
+    (send-string
+     haskell-process-name
+     ;; string to send: load file;
+     (concat "load " haskell-use-left-delim file haskell-use-right-delim ";\n"))))
+
+(defvar haskell-old-kill-emacs-hook nil
+  "Old value of kill-emacs-hook")
+
+(defun haskell-remove-tmp-files ()
+  "Remove the temporary files, created by haskell-simulate-send-region, if
+they still exist. Only files recorded in haskell-tmp-files-list are removed."
+  (message "Removing temporary files created by haskell-mode...")
+  (while haskell-tmp-files-list
+    (condition-case ()
+       (delete-file (car (car haskell-tmp-files-list)))
+      (error ()))
+    (setq haskell-tmp-files-list (cdr haskell-tmp-files-list)))
+  (message "Removing temporary files created by haskell-mode...done.")
+  (run-hooks 'haskell-old-kill-emacs-hook))
+
+(defun haskell-send-region ()
+  "Send region."
+  (interactive)
+  (let (start end)
+    (save-excursion
+      (setq end (point))
+      (exchange-point-and-mark)
+      (setq start (point)))
+    (haskell-simulate-send-region start end)))
+
+(defun haskell-send-buffer ()
+  "Send the buffer."
+  (interactive)
+  (haskell-simulate-send-region (point-min) (point-max)))
+
+(defun haskell-evaluate-expression (h-expr)
+  "Prompt for and evaluate an expression"
+  (interactive "sExpression: ")
+  (let ((str (concat h-expr ";\n"))
+       (buf (current-buffer)))
+    (haskell-pop-to-shell)
+    (insert str)
+    (send-string haskell-process-name str)
+    (pop-to-buffer buf)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; END OF Haskell-MODE
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/ghc/CONTRIB/haskell-modes/chalmers/sof/haskell-mode.el b/ghc/CONTRIB/haskell-modes/chalmers/sof/haskell-mode.el
new file mode 100644 (file)
index 0000000..25a4324
--- /dev/null
@@ -0,0 +1,825 @@
+;; haskell-mode.el. Major mode for editing Haskell.
+;; Copyright (C) 1989, Free Software Foundation, Inc., Lars Bo Nielsen
+;; and Lennart Augustsson
+;; modified by Peter Thiemann, March 1994
+
+;; This file is not officially part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Haskell Mode. A major mode for editing and running Haskell. (Version 0.0)
+;; =================================================================
+;;
+;; This is a mode for editing and running Haskell.
+;; It is very much based on the sml mode for GNU Emacs. It
+;; features:
+;;
+;;      - Inferior shell running Haskell. No need to leave emacs, just
+;;        keep right on editing while Haskell runs in another window.
+;;
+;;      - Automatic "load file" in inferior shell. Send regions of code
+;;        to the Haskell program.
+;;
+;;
+;; 1. HOW TO USE THE Haskell-MODE
+;; ==========================
+;;
+;; Here is a short introduction to the mode.
+;;
+;; 1.1 GETTING STARTED
+;; -------------------
+;;
+;; If you are an experienced user of Emacs, just skip this section.
+;;
+;; To use the haskell-mode, insert this in your "~/.emacs" file (Or ask your
+;; emacs-administrator to help you.):
+;;
+;;    (setq auto-mode-alist (cons '("\\.hs$" . haskell-mode) (cons '("\\.lhs$" . haskell-mode)
+;;                           auto-mode-alist)))
+;;    (autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t)
+;;
+;; Now every time a file with the extension `.hs' or `.lhs' is found, it is
+;; automatically started up in haskell-mode.
+;;
+;; You will also have to specify the path to this file, so you will have
+;; to add this as well:
+;;
+;;    (setq load-path (cons "/usr/me/emacs" load-path))
+;;
+;; where "/usr/me/emacs" is the directory where this file is.
+;;
+;; You may also want to compile the this file (M-x byte-compile-file)
+;; for speed.
+;;
+;; You are now ready to start using haskell-mode. If you have tried other
+;; language modes (like lisp-mode or C-mode), you should have no
+;; problems. There are only a few extra functions in this mode.
+;;
+;; 1.2. EDITING COMMANDS.
+;; ----------------------
+;;
+;; The following editing and inferior-shell commands can ONLY be issued
+;; from within a buffer in haskell-mode.
+;;
+;; LFD (haskell-newline-and-indent).  
+;;     This is probably the function you will be using the most (press
+;;     CTRL while you press Return, press C-j or press Newline). It
+;;     makes a new line and performs indentation based on the last 
+;;     preceding non-comment line.
+;;
+;; M-; (indent-for-comment).
+;;     Like in other language modes, this command will give you a comment
+;;     at the of the current line. The column where the comment starts is
+;;     determined by the variable comment-column (default: 40).
+;;    
+;; C-c C-v (haskell-mode-version). 
+;;     Get the version of the haskell-mode.
+;;
+;;
+;; 1.3. COMMANDS RELATED TO THE INFERIOR SHELL
+;; -------------------------------------------
+;;
+;; C-c C-s (haskell-pop-to-shell).
+;;     This command starts up an inferior shell running haskell. If the shell
+;;     is running, it will just pop up the shell window.
+;;
+;; C-c C-u (haskell-save-buffer-use-file).
+;;     This command will save the current buffer and send a "load file",
+;;     where file is the file visited by the current buffer, to the
+;;     inferior shell running haskell.
+;;
+;; C-c C-f (haskell-run-on-file).
+;;     Will send a "load file" to the inferior shell running haskell,
+;;     prompting you for the file name.
+;;    
+;; C-c C-r (haskell-send-region). 
+;;     Will send region, from point to mark, to the inferior shell
+;;     running haskell.
+;;
+;; C-c C-b (haskell-send-buffer). 
+;;     Will send whole buffer to inferior shell running haskell.
+;;
+;; 2. INDENTATION
+;; ================
+;; 
+;; The first indentation command (using C-j or TAB) on a given line
+;; indents like the last preceding non-comment line. The next TAB
+;; indents to the indentation of the innermost enclosing scope. Further
+;; TABs get you to further enclosing scopes. After indentation has
+;; reached the first column, the process restarts using the indentation
+;; of the preceding non-comment line, again.
+;;
+;; 3. INFERIOR SHELL.
+;; ==================
+;;
+;; The mode for Standard ML also contains a mode for an inferior shell
+;; running haskell. The mode is the same as the shell-mode, with just one
+;; extra command.
+;;
+;; 3.1. INFERIOR SHELL COMMANDS
+;; ----------------------------
+;;
+;; C-c C-f (haskell-run-on-file).  Send a `load file' to the process running
+;; haskell.
+;;
+;; 3.2. CONSTANTS CONTROLLING THE INFERIOR SHELL MODE
+;; --------------------------------------------------
+;;
+;; Because haskell is called differently on various machines, and the
+;; haskell-systems have their own command for reading in a file, a set of
+;; constants controls the behavior of the inferior shell running haskell (to
+;; change these constants: See CUSTOMIZING YOUR Haskell-MODE below).
+;;
+;; haskell-prog-name (default "hbi").
+;;     This constant is a string, containing the command to invoke
+;;     Standard ML on your system. 
+;;
+;; haskell-use-right-delim (default "\"")
+;; haskell-use-left-delim  (default "\"")
+;;     The left and right delimiter used by your version of haskell, for
+;;     `use file-name'.
+;;
+;; haskell-process-name (default "Haskell"). 
+;;     The name of the process running haskell. (This will be the name
+;;     appearing on the mode line of the buffer)
+;;
+;; NOTE: The haskell-mode functions: haskell-send-buffer, haskell-send-function and
+;; haskell-send-region, creates temporary files (I could not figure out how
+;; to send large amounts of data to a process). These files will be
+;; removed when you leave emacs.
+;;
+;; 4. FONTIFICATION
+;;
+;; There is support for Jamie Zawinski's font-lock-mode through the
+;; variable "haskell-font-lock-keywords".
+;;
+;; 5. CUSTOMIZING YOUR Haskell-MODE
+;; ============================
+;;
+;; If you have to change some of the constants, you will have to add a
+;; `hook' to the haskell-mode. Insert this in your "~/.emacs" file.
+;;
+;;    (setq haskell-mode-hook 'my-haskell-constants)
+;;
+;; Your function "my-haskell-constants" will then be executed every time
+;; "haskell-mode" is invoked.  Now you only have to write the emacs-lisp
+;; function "my-haskell-constants", and put it in your "~/.emacs" file.
+;;
+;; Say you are running a version of haskell that uses the syntax `load
+;; ["file"]', is invoked by the command "OurHaskell" and you don't want the
+;; indentation algorithm to indent according to open parenthesis, your
+;; function should look like this:
+;;
+;;    (defun my-haskell-constants ()
+;;       (setq haskell-prog-name "OurHaskell")
+;;       (setq haskell-use-left-delim "[\"")
+;;       (setq haskell-use-right-delim "\"]")
+;;       (setq haskell-paren-lookback nil))
+;;
+;; The haskell-shell also runs a `hook' (haskell-shell-hook) when it is invoked.
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; ORIGINAL AUTHOR
+;;         Lars Bo Nielsen
+;;         Aalborg University
+;;         Computer Science Dept.
+;;         9000 Aalborg
+;;         Denmark
+;;
+;;         lbn@iesd.dk
+;;         or: ...!mcvax!diku!iesd!lbn
+;;         or: mcvax!diku!iesd!lbn@uunet.uu.net
+;;
+;; MODIFIED FOR Haskell BY
+;;        Lennart Augustsson
+;;        indentation stuff by Peter Thiemann
+;;
+;;
+;; Please let me know if you come up with any ideas, bugs, or fixes.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst haskell-mode-version-string
+  "HASKELL-MODE, Version 0.2, PJT indentation")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; CONSTANTS CONTROLLING THE MODE.
+;;;
+;;; These are the constants you might want to change
+;;; 
+
+;; The command used to start up the haskell-program.
+(defconst haskell-prog-name "hbi" "*Name of program to run as haskell.")
+
+;; The left delimmitter for `load file'
+(defconst haskell-use-left-delim "\""
+  "*The left delimiter for the filename when using \"load\".")
+
+;; The right delimmitter for `load file'
+(defconst haskell-use-right-delim "\""
+  "*The right delimiter for the filename when using \"load\".")
+
+;; A regular expression matching the prompt pattern in the inferior
+;; shell
+(defconst haskell-shell-prompt-pattern "^> *"
+  "*The prompt pattern for the inferion shell running haskell.")
+
+;; The template used for temporary files, created when a region is
+;; send to the inferior process running haskell.
+(defconst haskell-tmp-template "/tmp/haskell.tmp."
+  "*Template for the temporary file, created by haskell-simulate-send-region.")
+
+;; The name of the process running haskell (This will also be the name of
+;; the buffer).
+(defconst haskell-process-name "Haskell" "*The name of the Haskell-process")
+
+;;;
+;;; END OF CONSTANTS CONTROLLING THE MODE.
+;;;
+;;; If you change anything below, you are on your own.
+;;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defvar haskell-mode-syntax-table nil "The syntax table used in haskell-mode.")
+
+(defvar haskell-mode-map nil "The mode map used in haskell-mode.")
+
+(defvar haskell-mode-abbrev-table nil "The abbrev-table used in haskell-mode.")
+
+(defvar haskell-old-kill-emacs-hook nil "Old value of kill-emacs-hook")
+
+(defun haskell-mode ()
+  "Major mode for editing Haskell code.
+Tab indents for Haskell code.
+Comments are delimited with --
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+
+Key bindings:
+=============
+
+\\[haskell-pop-to-shell]\t  Pop to the haskell window.
+\\[haskell-save-buffer-use-file]\t  Save the buffer, and send a \"load file\".
+\\[haskell-send-region]\t  Send region (point and mark) to haskell.
+\\[haskell-run-on-file]\t  Send a \"load file\" to haskell.
+\\[haskell-send-buffer]\t  Send whole buffer to haskell.
+\\[haskell-mode-version]\t  Get the version of haskell-mode.
+\\[haskell-evaluate-expression]\t  Prompt for an expression and evalute it.
+
+
+Mode map
+========
+\\{haskell-mode-map}
+Runs haskell-mode-hook if non nil."
+  (interactive)
+  (kill-all-local-variables)
+  (if haskell-mode-map
+      ()
+    (setq haskell-mode-map (make-sparse-keymap))
+    (define-key haskell-mode-map "\C-c\C-v" 'haskell-mode-version)
+    (define-key haskell-mode-map "\C-c\C-u" 'haskell-save-buffer-use-file)
+    (define-key haskell-mode-map "\C-c\C-s" 'haskell-pop-to-shell)
+    (define-key haskell-mode-map "\C-c\C-r" 'haskell-send-region)
+    (define-key haskell-mode-map "\C-c\C-m" 'haskell-region)
+    (define-key haskell-mode-map "\C-c\C-f" 'haskell-run-on-file)
+    (define-key haskell-mode-map "\C-c\C-b" 'haskell-send-buffer)
+    (define-key haskell-mode-map "\C-c\C-l" 'comment-line)
+    (define-key haskell-mode-map "\C-ce"    'haskell-evaluate-expression)
+;    (define-key haskell-mode-map "\C-j"     'haskell-newline-and-indent)
+    (define-key haskell-mode-map [S-tab]    'tab-to-tab-stop)
+    (define-key haskell-mode-map "\177"     'backward-delete-char-untabify))
+  (use-local-map haskell-mode-map)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell")
+  (define-abbrev-table 'haskell-mode-abbrev-table ())
+  (setq local-abbrev-table haskell-mode-abbrev-table)
+  (if haskell-mode-syntax-table
+      ()
+    (setq haskell-mode-syntax-table (make-syntax-table))
+    (modify-syntax-entry ?{  "(}1"    haskell-mode-syntax-table)
+    (modify-syntax-entry ?}  "){4"    haskell-mode-syntax-table)
+; partain: out
+;    (modify-syntax-entry ?-  "_ 2356" haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\f "> b"    haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\n "> b"    haskell-mode-syntax-table)
+; partain: end out
+; partain: in
+    (modify-syntax-entry ?-  "_ 23" haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\f "> b"    haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\n "> b"    haskell-mode-syntax-table)
+; partain: end in
+    (modify-syntax-entry ?\\ "\\"     haskell-mode-syntax-table)
+    (modify-syntax-entry ?*  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?_  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?'  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?:  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?|  "."      haskell-mode-syntax-table)
+    )
+  (set-syntax-table haskell-mode-syntax-table)
+  (make-local-variable 'require-final-newline) ; Always put a new-line
+  (setq require-final-newline t)       ; in the end of file
+;  (make-local-variable 'change-major-mode-hook)
+;  (setq change-major-mode-hook nil)
+;  (make-local-variable 'indent-line-function)
+;  (setq indent-line-function 'haskell-indent-line)
+  (make-local-variable 'comment-start)
+  (setq comment-start "-- ")
+;  (setq comment-start "{- ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+;  (setq comment-end " -}")
+  (make-local-variable 'comment-column)
+  (setq comment-column 60)             ; Start of comment in this column
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "{-+ *\\|--+ *") ; This matches a start of comment
+  (make-local-variable 'comment-multi-line)
+  (setq comment-multi-line nil)
+;  (make-local-variable 'comment-indent-function)
+;  (setq comment-indent-function 'haskell-comment-indent)
+  ;;
+  ;; Adding these will fool the matching of parens. I really don't
+  ;; know why. It would be nice to have comments treated as
+  ;; white-space
+  ;; 
+  ;; (make-local-variable 'parse-sexp-ignore-comments)
+  ;; (setq parse-sexp-ignore-comments t)
+  ;; 
+  (run-hooks 'haskell-mode-hook))              ; Run the hook
+
+(defun haskell-mode-version ()
+  (interactive)
+  (message haskell-mode-version-string))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; INDENTATION
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; some variables for later use
+
+(defvar haskell-open-comment "{-")
+(defvar haskell-close-comment "-}")
+(defvar haskell-indentation-counter 0
+  "count repeated invocations of indent-for-tab-command")
+(defvar haskell-literate-flag nil
+  "used to guide literate/illiterate behavior, set automagically")
+
+(defun haskell-newline-and-indent ()
+  (interactive)
+  (setq haskell-literate-flag
+       (save-excursion
+         (beginning-of-line)
+         (= (following-char) ?>)))
+  (newline)
+  (if haskell-literate-flag (insert ">"))
+  (haskell-indent-line))
+
+(defun haskell-indent-line ()
+  "Indent current line of ordinary or literate Haskell code."
+  (interactive)
+  (let ((indent (haskell-calculate-indentation-pjt-2)))
+    (if (/= (current-indentation) indent)
+       (let ((beg (progn
+                    (beginning-of-line)
+                    (if (= (following-char) ?>) (forward-char 1)) ;LITERATE
+                    (point))))
+         (skip-chars-forward "\t ")
+         (delete-region beg (point))
+         (indent-to indent))
+      ;; If point is before indentation, move point to indentation
+      (if (< (current-column) (current-indentation))
+         (skip-chars-forward "\t ")))))
+
+(defun haskell-calculate-indentation ()
+  (save-excursion
+    (let ((col (current-column)))
+      (while (and (not (bobp))                 ;skip over empty and comment-only lines
+                 (= col (current-column)))
+       (previous-line 1)
+       (beginning-of-line)                     ; Go to first non whitespace
+       (if (= (following-char) ?>)             ;LITERATE
+           (forward-char 1)
+         (if haskell-literate-flag             ;ignore illiterate lines
+             (end-of-line)))
+       (skip-chars-forward "\t ")              ; on the line.
+       (setq col (current-column))
+       (search-forward-regexp (concat haskell-open-comment "\\|--\\|\n") nil 0)
+       (goto-char (match-beginning 0)))
+      (search-backward-regexp "\\b\\(where\\|let\\|of\\|in\\)\\b\\|\n" nil 0)
+      (if (looking-at "\n")
+         ()
+       (setq col (current-column))
+       (forward-word 1)
+       (skip-chars-forward "\t ")
+       (if (looking-at "\\w")
+           (setq col (current-column))
+         (setq col (+ 2 col))))
+      col)))
+
+(defun haskell-calculate-indentation-pjt-2 ()
+  "Calculate indentation for Haskell program code, versatile version"
+  (save-excursion
+    (if (eq last-command 'haskell-indentation)
+       (setq haskell-indentation-counter (1+ haskell-indentation-counter))
+      (setq haskell-indentation-counter -1))
+    (setq this-command 'haskell-indentation)
+    (let* ((simple-indent (haskell-calculate-indentation))
+          (count haskell-indentation-counter)
+          (min-indent simple-indent)   ; minimum indentation found in a non-comment line
+          (last-indent simple-indent)  ; indentation of the following non-comment line
+          (return-indent nil)          ; computed indentation
+          (comment-depth 0))
+      (previous-line 1)
+      (if (< haskell-indentation-counter 0) ; 1st tab gives simple indentation
+         (setq return-indent simple-indent))
+      (while (not return-indent)
+       (if (search-backward-regexp "\\b\\(where\\|let\\|of\\)\\b\\|\n\\|{-\\|-}" nil t 1)
+           (cond
+            ((looking-at haskell-open-comment)
+             (setq comment-depth (1- comment-depth)))
+            ((looking-at haskell-close-comment)
+             (setq comment-depth (1+ comment-depth)))
+            ((= 0 comment-depth)
+             (cond
+              ((looking-at "\n")
+               (save-excursion
+                 (forward-char 1)
+                 (if (= (following-char) ?>)
+                     (forward-char 1)
+                   (if haskell-literate-flag
+                       (end-of-line))) ;LITERATE: ignore lines w/o >
+                 (skip-chars-forward "\t ")
+                 (if (looking-at (concat haskell-open-comment "\\|--\\|\n"))
+                     ()
+                   (setq last-indent (current-column))
+                   (if (< last-indent min-indent)
+                       (setq min-indent last-indent)))))
+              (t                       ; looking at a keyword
+               (save-excursion
+                 (forward-word 1)
+                 (skip-chars-forward " \t")
+                 (if (and haskell-literate-flag ;LITERATE: ignore lines w/o >
+                          (save-excursion
+                            (beginning-of-line)
+                            (/= (following-char) ?>)))
+                     (end-of-line))
+                 (if (looking-at (concat haskell-open-comment "\\|--\\|\n"))
+                     ()
+                   (setq last-indent (current-column)))
+                 (if (<= last-indent min-indent)
+                     (if (> count 0)
+                         (setq count (1- count))
+                       (setq return-indent last-indent)))
+                 (if (< last-indent min-indent)
+                     (setq min-indent last-indent)))))))
+         (setq return-indent simple-indent)
+         (setq haskell-indentation-counter -1)))
+      return-indent)))
+
+(defun haskell-skip-nested-comment ()
+  ;; point looks at opening {-, move over closing -}
+  ;; todo: specify what happens on failure, bounds check ...
+  (forward-char 2)
+  (let ((comment-depth 1))
+    (while (> comment-depth 0)
+      (search-forward-regexp "{-\\|-}")
+      (goto-char (match-beginning 0))
+      (setq comment-depth
+           (if (= (following-char) 123) ; code for opening brace
+               (1+ comment-depth)
+             (1- comment-depth)))
+      (goto-char (match-end 0)))))
+
+
+;;;seemingly obsolete functions
+(defun haskell-inside-of-inline-comment ()
+  (let ((bolp (save-excursion
+              (beginning-of-line)
+              (point))))
+    (search-backward comment-start bolp t 1)))
+
+(defun haskell-inside-of-nested-comment ()
+  (save-excursion
+    (let ((count 0))
+      (while
+         (search-backward-regexp "\\({-\\|-}\\)" 0 t 1)
+       (if (haskell-inside-of-inline-comment)
+           ()
+         (if (looking-at haskell-open-comment)
+             (setq count (1+ count))
+           (setq count (1- count)))))
+      (> count 0))))
+
+(defun haskell-inside-of-comment ()
+  (or (haskell-inside-of-inline-comment)
+      (haskell-inside-of-nested-comment)))
+
+;;;stolen from sml-mode.el
+(defun haskell-comment-indent ()
+  "Compute indentation for Haskell comments"
+  (if (looking-at "^--")
+      0
+    (save-excursion
+      (skip-chars-backward " \t")
+      (max (1+ (current-column))
+          comment-column))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; INFERIOR SHELL
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar haskell-shell-map nil "The mode map for haskell-shell.")
+
+(defun haskell-shell ()
+  "Inferior shell invoking Haskell.
+It is not possible to have more than one shell running Haskell.
+Like the shell mode with the additional command:
+
+\\[haskell-run-on-file]\t Runs haskell on the file.
+\\{haskell-shell-map}
+Variables controlling the mode:
+
+haskell-prog-name (default \"hbi\")
+    The string used to invoke the haskell program.
+
+haskell-use-right-delim (default \"\\\"\")
+haskell-use-left-delim  (default \"\\\"\")
+    The left and right delimiter used by your version of haskell, for
+    \"load file-name\".
+
+haskell-process-name (default \"Haskell\")
+    The name of the process running haskell.
+
+haskell-shell-prompt-pattern (default \"^> *\")
+    The prompt pattern.
+
+Runs haskell-shell-hook if not nil."
+  (interactive)
+  (if (not (process-status haskell-process-name))
+      (save-excursion                  ; Process is not running
+       (message "Starting Haskell...") ; start up a new process
+       (require 'shell)
+       (set-buffer (make-comint haskell-process-name haskell-prog-name))
+       (erase-buffer)                  ; Erase the buffer if a previous
+       (if haskell-shell-map           ; process died in there
+           ()
+         (setq haskell-shell-map (copy-keymap shell-mode-map))
+         (define-key haskell-shell-map "\C-c\C-f" 'haskell-run-on-file))
+       (use-local-map haskell-shell-map)
+       (make-local-variable 'shell-prompt-pattern)
+       (setq shell-prompt-pattern haskell-shell-prompt-pattern)
+       (setq major-mode 'haskell-shell)
+       (setq mode-name "Haskell Shell")
+       (setq mode-line-format 
+             "-----Emacs: %17b   %M   %[(%m: %s)%]----%3p--%-")
+       (set-process-filter (get-process haskell-process-name) 'haskell-process-filter)
+       (message "Starting Haskell...done.")
+       (run-hooks 'haskell-shell-hook))))
+
+(defun haskell-process-filter (proc str)
+  (let ((cur (current-buffer))
+       (pop-up-windows t))
+    (pop-to-buffer (concat "*" haskell-process-name "*"))
+    (goto-char (point-max))
+    (if (string= str "\b\b\b  \b\b\b")
+       (backward-delete-char 4)
+      (insert str))
+    (set-marker (process-mark proc) (point-max))
+    (pop-to-buffer cur)))
+
+(defun haskell-pop-to-shell ()
+  (interactive)
+  (haskell-shell)
+  (pop-to-buffer (concat "*" haskell-process-name "*")))
+
+(defun haskell-run-on-file (fil)
+  (interactive "FRun Haskell on : ")
+  (haskell-shell)
+  (save-some-buffers)
+  (process-send-string haskell-process-name
+              (concat "load " haskell-use-left-delim (expand-file-name fil)
+                      haskell-use-right-delim ";\n")))
+
+(defun haskell-save-buffer-use-file ()
+  "Save the buffer, and send a `use file' to the inferior shell
+running Haskell."
+  (interactive)
+  (let (file)
+    (if (setq file (buffer-file-name)) ; Is the buffer associated
+       (progn                          ; with file ?
+         (save-buffer)
+         (haskell-shell)
+         (process-send-string haskell-process-name
+                      (concat "load " haskell-use-left-delim
+                              (expand-file-name file)
+                              haskell-use-right-delim ";\n")))
+      (error "Buffer not associated with file."))))
+
+(defvar haskell-tmp-files-list nil
+  "List of all temporary files created by haskell-simulate-send-region.
+Each element in the list is a list with the format:
+
+      (\"tmp-filename\"  buffer  start-line)")
+
+(defvar haskell-simulate-send-region-called-p nil
+  "Has haskell-simulate-send-region been called previously.")
+
+(defun haskell-make-temp-name (pre)
+  (concat (make-temp-name pre) ".m"))
+
+(defun haskell-simulate-send-region (point1 point2)
+  "Simulate send region. As send-region only can handle what ever the
+system sets as the default, we have to make a temporary file.
+Updates the list of temporary files (haskell-tmp-files-list)."
+  (let ((file (expand-file-name (haskell-make-temp-name haskell-tmp-template))))
+    ;; Remove temporary files when we leave emacs
+    (if (not haskell-simulate-send-region-called-p)
+       (progn
+         (setq haskell-old-kill-emacs-hook kill-emacs-hook)
+         (setq kill-emacs-hook 'haskell-remove-tmp-files)
+         (setq haskell-simulate-send-region-called-p t)))
+    (save-excursion
+      (goto-char point1)
+      (setq haskell-tmp-files-list
+           (cons (list file
+                       (current-buffer)
+                       (save-excursion ; Calculate line no.
+                         (beginning-of-line)
+                         (1+ (count-lines 1 (point)))))
+                 haskell-tmp-files-list)))
+    (write-region point1 point2 file nil 'dummy)
+    (haskell-shell)
+    (message "Using temporary file: %s" file)
+    (process-send-string
+     haskell-process-name
+     ;; string to send: load file;
+     (concat "load " haskell-use-left-delim file haskell-use-right-delim ";\n"))))
+
+(defun haskell-remove-tmp-files ()
+  "Remove the temporary files, created by haskell-simulate-send-region, if
+they still exist. Only files recorded in haskell-tmp-files-list are removed."
+  (message "Removing temporary files created by haskell-mode...")
+  (while haskell-tmp-files-list
+    (condition-case ()
+       (delete-file (car (car haskell-tmp-files-list)))
+      (error ()))
+    (setq haskell-tmp-files-list (cdr haskell-tmp-files-list)))
+  (message "Removing temporary files created by haskell-mode...done.")
+  (run-hooks 'haskell-old-kill-emacs-hook))
+
+(defun haskell-send-region ()
+  "Send region."
+  (interactive)
+  (let (start end)
+    (save-excursion
+      (setq end (point))
+      (exchange-point-and-mark)
+      (setq start (point)))
+    (haskell-simulate-send-region start end)))
+
+(defun haskell-send-buffer ()
+  "Send the buffer."
+  (interactive)
+  (haskell-simulate-send-region (point-min) (point-max)))
+
+(defun haskell-evaluate-expression (h-expr)
+  "Prompt for and evaluate an expression"
+  (interactive "sExpression: ")
+  (let ((str (concat h-expr ";\n"))
+       (buf (current-buffer)))
+    (haskell-pop-to-shell)
+    (insert str)
+    (process-send-string haskell-process-name str)
+    (pop-to-buffer buf)))
+
+
+;;
+;; font-lock-mode patterns, based on specs. in an earlier version
+;; of haskell-mode.el
+;; (these patterns have only been tested with 19.30)
+
+(defconst haskell-font-lock-keywords nil
+ "Conservative highlighting of a Haskell buffer
+(using font-lock.)")
+
+(let ((haskell-id "[a-z_][a-zA-Z0-9_'#]+")
+      (haskell-reserved-ids
+          (concat "\\b\\(" 
+                   (mapconcat 
+                      'identity
+                      '("case"    "class"     "data"
+                        "default" "deriving"  "else"
+                        "hiding"  "if" "import"   "in"
+                        "instance" "interface" "let"
+                        "module" "of"   "renaming"
+                        "then"  "to" "type" "where" "infix[rl]?")
+                       "\\|")
+                  "\\)[ \t\n:,]"))
+       (haskell-basic-types 
+          (concat "\\b\\("
+                   (mapconcat 'identity
+                             '("Bool" "()" "String" "Char" "Int"
+                               "Integer" "Float" "Double" "Ratio"
+                               "Assoc" "Rational" "Array")
+                             "\\|")
+                  "\\)\\b"))
+       (haskell-prelude-classes
+          (concat "\\b\\("
+                   (mapconcat 'identity
+                             '("Eq" "Ord" "Text" "Num" "Real" "Fractional" 
+                                 "Integral"   "RealFrac" "Floating" "RealFloat"
+                                "Complex" "Ix" "Enum"
+                                ;; ghc-isms
+                                "_CCallable" "_CReturnable")
+                             "\\|")
+                  "\\)\\b"))
+       (haskell-reserved-ops 
+          (mapconcat 'identity
+                     '("\\.\\."  "::"
+                       "=>" "/=" "@"
+                       "<-" "->")
+                     "\\|"))
+       (glasgow-haskell-ops
+          (concat "\\b\\(" 
+                   (mapconcat 
+                     'identity
+                     '(">>"    ">>="  "thenPrimIO"
+                       "seqPrimIO" "returnPrimIO" 
+                       "return" "_ccall_" "_casm_"
+                       "thenST" "seqST" "returnST"
+                       "thenStrictlyST" "seqStrictlyST" "returnStrictlyST"
+                       "unsafeInterleavePrimIO" "unsafePerformIO")
+                     "\\|")
+                  "\\)\\b"))
+       (glasgow-haskell-types
+          (concat "\\b\\(" 
+                   (mapconcat 
+                     'identity
+                     '("IO"    "PrimIO"  "_?ST"
+                       "_Word" "_Addr"   "_?MVar"
+                       "_?IVar" "_RealWorld"
+                       "_?MutableByteArray"
+                       "_?ByteArray")
+                     "\\|")
+                  "\\)\\b")))
+      (setq haskell-font-lock-keywords
+       (list
+         '("--.*$" . font-lock-comment-face)
+        (list "[ \t\n]*\\([A-Za-z[(_][]A-Za-z0-9_$', ~@|:[)(#]*[ \t\n]*\\)=" 1 font-lock-function-name-face)
+        (list (concat "^>?[ \t\n]*\\(" haskell-id "\\)[ \t]*::") 1 'font-lock-function-name-face)
+         (list haskell-reserved-ids    0 'font-lock-function-name-face)
+         (list glasgow-haskell-ops     0 'font-lock-function-name-face)
+         (list glasgow-haskell-types   0 'font-lock-type-face)
+        (list haskell-basic-types     0 'font-lock-type-face)
+        (list haskell-prelude-classes 0 'font-lock-type-face)
+        (list "^[ \t\n]*\\([A-Za-z[(_][]A-Za-z0-9_$', @:[)(#]*[ \t\n]*\\)->" 1 font-lock-variable-name-face)
+        )))
+
+;;
+;; To enable font-lock-mode for Haskell buffers, add something
+;; like this to your ~/.emacs
+
+;(cond (window-system
+;  (require 'font-lock)
+;  (add-hook 'haskell-mode-hook
+;    '(lambda () (make-local-variable 'font-lock-defaults)
+;              (make-local-variable 'font-lock-mode-hook) ; don't affect other buffers      
+;              (setq font-lock-mode-hook nil)
+;              (add-hook 'font-lock-mode-hook 
+;                   '(lambda ()
+;                        (setq font-lock-keywords haskell-font-lock-keywords)))
+;              (font-lock-mode 1))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; END OF Haskell-MODE
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(provide 'haskell-mode)
diff --git a/ghc/CONTRIB/haskell-modes/chalmers/thiemann/haskell-mode.el b/ghc/CONTRIB/haskell-modes/chalmers/thiemann/haskell-mode.el
new file mode 100644 (file)
index 0000000..e900f01
--- /dev/null
@@ -0,0 +1,764 @@
+;; haskell-mode.el. Major mode for editing Haskell.
+;; Copyright (C) 1989, Free Software Foundation, Inc., Lars Bo Nielsen
+;; and Lennart Augustsson
+;; modified by Peter Thiemann, March 1994
+
+;; This file is not officially part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Haskell Mode. A major mode for editing and running Haskell. (Version 0.0)
+;; =================================================================
+;;
+;; This is a mode for editing and running Haskell.
+;; It is very much based on the sml mode for GNU Emacs. It
+;; features:
+;;
+;;      - Inferior shell running Haskell. No need to leave emacs, just
+;;        keep right on editing while Haskell runs in another window.
+;;
+;;      - Automatic "load file" in inferior shell. Send regions of code
+;;        to the Haskell program.
+;;
+;;
+;; 1. HOW TO USE THE Haskell-MODE
+;; ==========================
+;;
+;; Here is a short introduction to the mode.
+;;
+;; 1.1 GETTING STARTED
+;; -------------------
+;;
+;; If you are an experienced user of Emacs, just skip this section.
+;;
+;; To use the haskell-mode, insert this in your "~/.emacs" file (Or ask your
+;; emacs-administrator to help you.):
+;;
+;;    (setq auto-mode-alist (cons '("\\.hs$" . haskell-mode) (cons '("\\.lhs$" . haskell-mode)
+;;                           auto-mode-alist)))
+;;    (autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t)
+;;
+;; Now every time a file with the extension `.hs' or `.lhs' is found, it is
+;; automatically started up in haskell-mode.
+;;
+;; You will also have to specify the path to this file, so you will have
+;; to add this as well:
+;;
+;;    (setq load-path (cons "/usr/me/emacs" load-path))
+;;
+;; where "/usr/me/emacs" is the directory where this file is.
+;;
+;; You may also want to compile the this file (M-x byte-compile-file)
+;; for speed.
+;;
+;; You are now ready to start using haskell-mode. If you have tried other
+;; language modes (like lisp-mode or C-mode), you should have no
+;; problems. There are only a few extra functions in this mode.
+;;
+;; 1.2. EDITING COMMANDS.
+;; ----------------------
+;;
+;; The following editing and inferior-shell commands can ONLY be issued
+;; from within a buffer in haskell-mode.
+;;
+;; LFD (haskell-newline-and-indent).  
+;;     This is probably the function you will be using the most (press
+;;     CTRL while you press Return, press C-j or press Newline). It
+;;     makes a new line and performs indentation based on the last 
+;;     preceding non-comment line.
+;;
+;; M-; (indent-for-comment).
+;;     Like in other language modes, this command will give you a comment
+;;     at the of the current line. The column where the comment starts is
+;;     determined by the variable comment-column (default: 40).
+;;    
+;; C-c C-v (haskell-mode-version). 
+;;     Get the version of the haskell-mode.
+;;
+;;
+;; 1.3. COMMANDS RELATED TO THE INFERIOR SHELL
+;; -------------------------------------------
+;;
+;; C-c C-s (haskell-pop-to-shell).
+;;     This command starts up an inferior shell running haskell. If the shell
+;;     is running, it will just pop up the shell window.
+;;
+;; C-c C-u (haskell-save-buffer-use-file).
+;;     This command will save the current buffer and send a "load file",
+;;     where file is the file visited by the current buffer, to the
+;;     inferior shell running haskell.
+;;
+;; C-c C-f (haskell-run-on-file).
+;;     Will send a "load file" to the inferior shell running haskell,
+;;     prompting you for the file name.
+;;    
+;; C-c C-r (haskell-send-region). 
+;;     Will send region, from point to mark, to the inferior shell
+;;     running haskell.
+;;
+;; C-c C-b (haskell-send-buffer). 
+;;     Will send whole buffer to inferior shell running haskell.
+;;
+;; 2. INDENTATION
+;; ================
+;; 
+;; The first indentation command (using C-j or TAB) on a given line
+;; indents like the last preceding non-comment line. The next TAB
+;; indents to the indentation of the innermost enclosing scope. Further
+;; TABs get you to further enclosing scopes. After indentation has
+;; reached the first column, the process restarts using the indentation
+;; of the preceding non-comment line, again.
+;;
+;; 3. INFERIOR SHELL.
+;; ==================
+;;
+;; The mode for Standard ML also contains a mode for an inferior shell
+;; running haskell. The mode is the same as the shell-mode, with just one
+;; extra command.
+;;
+;; 3.1. INFERIOR SHELL COMMANDS
+;; ----------------------------
+;;
+;; C-c C-f (haskell-run-on-file).  Send a `load file' to the process running
+;; haskell.
+;;
+;; 3.2. CONSTANTS CONTROLLING THE INFERIOR SHELL MODE
+;; --------------------------------------------------
+;;
+;; Because haskell is called differently on various machines, and the
+;; haskell-systems have their own command for reading in a file, a set of
+;; constants controls the behavior of the inferior shell running haskell (to
+;; change these constants: See CUSTOMIZING YOUR Haskell-MODE below).
+;;
+;; haskell-prog-name (default "hbi").
+;;     This constant is a string, containing the command to invoke
+;;     Standard ML on your system. 
+;;
+;; haskell-use-right-delim (default "\"")
+;; haskell-use-left-delim  (default "\"")
+;;     The left and right delimiter used by your version of haskell, for
+;;     `use file-name'.
+;;
+;; haskell-process-name (default "Haskell"). 
+;;     The name of the process running haskell. (This will be the name
+;;     appearing on the mode line of the buffer)
+;;
+;; NOTE: The haskell-mode functions: haskell-send-buffer, haskell-send-function and
+;; haskell-send-region, creates temporary files (I could not figure out how
+;; to send large amounts of data to a process). These files will be
+;; removed when you leave emacs.
+;;
+;; 4. FONTIFICATION
+;;
+;; There is support for Jamie Zawinski's font-lock-mode through the
+;; variable "haskell-font-lock-keywords".
+;;
+;; 5. CUSTOMIZING YOUR Haskell-MODE
+;; ============================
+;;
+;; If you have to change some of the constants, you will have to add a
+;; `hook' to the haskell-mode. Insert this in your "~/.emacs" file.
+;;
+;;    (setq haskell-mode-hook 'my-haskell-constants)
+;;
+;; Your function "my-haskell-constants" will then be executed every time
+;; "haskell-mode" is invoked.  Now you only have to write the emacs-lisp
+;; function "my-haskell-constants", and put it in your "~/.emacs" file.
+;;
+;; Say you are running a version of haskell that uses the syntax `load
+;; ["file"]', is invoked by the command "OurHaskell" and you don't want the
+;; indentation algorithm to indent according to open parenthesis, your
+;; function should look like this:
+;;
+;;    (defun my-haskell-constants ()
+;;       (setq haskell-prog-name "OurHaskell")
+;;       (setq haskell-use-left-delim "[\"")
+;;       (setq haskell-use-right-delim "\"]")
+;;       (setq haskell-paren-lookback nil))
+;;
+;; The haskell-shell also runs a `hook' (haskell-shell-hook) when it is invoked.
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; ORIGINAL AUTHOR
+;;         Lars Bo Nielsen
+;;         Aalborg University
+;;         Computer Science Dept.
+;;         9000 Aalborg
+;;         Denmark
+;;
+;;         lbn@iesd.dk
+;;         or: ...!mcvax!diku!iesd!lbn
+;;         or: mcvax!diku!iesd!lbn@uunet.uu.net
+;;
+;; MODIFIED FOR Haskell BY
+;;        Lennart Augustsson
+;;        indentation stuff by Peter Thiemann
+;;
+;;
+;; Please let me know if you come up with any ideas, bugs, or fixes.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst haskell-mode-version-string
+  "HASKELL-MODE, Version 0.2, PJT indentation")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; CONSTANTS CONTROLLING THE MODE.
+;;;
+;;; These are the constants you might want to change
+;;; 
+
+;; The command used to start up the haskell-program.
+(defconst haskell-prog-name "hbi" "*Name of program to run as haskell.")
+
+;; The left delimmitter for `load file'
+(defconst haskell-use-left-delim "\""
+  "*The left delimiter for the filename when using \"load\".")
+
+;; The right delimmitter for `load file'
+(defconst haskell-use-right-delim "\""
+  "*The right delimiter for the filename when using \"load\".")
+
+;; A regular expression matching the prompt pattern in the inferior
+;; shell
+(defconst haskell-shell-prompt-pattern "^> *"
+  "*The prompt pattern for the inferion shell running haskell.")
+
+;; The template used for temporary files, created when a region is
+;; send to the inferior process running haskell.
+(defconst haskell-tmp-template "/tmp/haskell.tmp."
+  "*Template for the temporary file, created by haskell-simulate-send-region.")
+
+;; The name of the process running haskell (This will also be the name of
+;; the buffer).
+(defconst haskell-process-name "Haskell" "*The name of the Haskell-process")
+
+;;;
+;;; END OF CONSTANTS CONTROLLING THE MODE.
+;;;
+;;; If you change anything below, you are on your own.
+;;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defvar haskell-mode-syntax-table nil "The syntax table used in haskell-mode.")
+
+(defvar haskell-mode-map nil "The mode map used in haskell-mode.")
+
+(defvar haskell-mode-abbrev-table nil "The abbrev-table used in haskell-mode.")
+
+(defvar haskell-old-kill-emacs-hook nil "Old value of kill-emacs-hook")
+
+(defun haskell-mode ()
+  "Major mode for editing Haskell code.
+Tab indents for Haskell code.
+Comments are delimited with --
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+
+Key bindings:
+=============
+
+\\[haskell-pop-to-shell]\t  Pop to the haskell window.
+\\[haskell-save-buffer-use-file]\t  Save the buffer, and send a \"load file\".
+\\[haskell-send-region]\t  Send region (point and mark) to haskell.
+\\[haskell-run-on-file]\t  Send a \"load file\" to haskell.
+\\[haskell-send-buffer]\t  Send whole buffer to haskell.
+\\[haskell-mode-version]\t  Get the version of haskell-mode.
+\\[haskell-evaluate-expression]\t  Prompt for an expression and evalute it.
+
+
+Mode map
+========
+\\{haskell-mode-map}
+Runs haskell-mode-hook if non nil."
+  (interactive)
+  (kill-all-local-variables)
+  (if haskell-mode-map
+      ()
+    (setq haskell-mode-map (make-sparse-keymap))
+    (define-key haskell-mode-map "\C-c\C-v" 'haskell-mode-version)
+    (define-key haskell-mode-map "\C-c\C-u" 'haskell-save-buffer-use-file)
+    (define-key haskell-mode-map "\C-c\C-s" 'haskell-pop-to-shell)
+    (define-key haskell-mode-map "\C-c\C-r" 'haskell-send-region)
+    (define-key haskell-mode-map "\C-c\C-m" 'haskell-region)
+    (define-key haskell-mode-map "\C-c\C-f" 'haskell-run-on-file)
+    (define-key haskell-mode-map "\C-c\C-b" 'haskell-send-buffer)
+    (define-key haskell-mode-map "\C-ce"    'haskell-evaluate-expression)
+    (define-key haskell-mode-map "\C-j"     'haskell-newline-and-indent)
+    (define-key haskell-mode-map "\177"     'backward-delete-char-untabify))
+  (use-local-map haskell-mode-map)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell")
+  (define-abbrev-table 'haskell-mode-abbrev-table ())
+  (setq local-abbrev-table haskell-mode-abbrev-table)
+  (if haskell-mode-syntax-table
+      ()
+    (setq haskell-mode-syntax-table (make-syntax-table))
+    (modify-syntax-entry ?{  "(}1"    haskell-mode-syntax-table)
+    (modify-syntax-entry ?}  "){4"    haskell-mode-syntax-table)
+; partain: out
+;    (modify-syntax-entry ?-  "_ 2356" haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\f "> b"    haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\n "> b"    haskell-mode-syntax-table)
+; partain: end out
+; partain: in
+    (modify-syntax-entry ?-  "_ 23" haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\f "> b"    haskell-mode-syntax-table)
+;    (modify-syntax-entry ?\n "> b"    haskell-mode-syntax-table)
+; partain: end in
+    (modify-syntax-entry ?\\ "\\"     haskell-mode-syntax-table)
+    (modify-syntax-entry ?*  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?_  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?'  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?:  "_"      haskell-mode-syntax-table)
+    (modify-syntax-entry ?|  "."      haskell-mode-syntax-table)
+    )
+  (set-syntax-table haskell-mode-syntax-table)
+  (make-local-variable 'require-final-newline) ; Always put a new-line
+  (setq require-final-newline t)       ; in the end of file
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'haskell-indent-line)
+  (make-local-variable 'comment-start)
+  (setq comment-start "-- ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-column)
+  (setq comment-column 60)             ; Start of comment in this column
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "--[^a-zA-Z0-9]*") ; This matches a start of comment
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'haskell-comment-indent)
+  ;;
+  ;; Adding these will fool the matching of parens. I really don't
+  ;; know why. It would be nice to have comments treated as
+  ;; white-space
+  ;; 
+  ;; (make-local-variable 'parse-sexp-ignore-comments)
+  ;; (setq parse-sexp-ignore-comments t)
+  ;; 
+  (run-hooks 'haskell-mode-hook))              ; Run the hook
+
+(defun haskell-mode-version ()
+  (interactive)
+  (message haskell-mode-version-string))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; INDENTATION
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; some variables for later use
+
+(defvar haskell-open-comment "{-")
+(defvar haskell-close-comment "-}")
+(defvar haskell-indentation-counter 0
+  "count repeated invocations of indent-for-tab-command")
+(defvar haskell-literate-flag nil
+  "used to guide literate/illiterate behavior, set automagically")
+
+(defun haskell-newline-and-indent ()
+  (interactive)
+  (setq haskell-literate-flag
+       (save-excursion
+         (beginning-of-line)
+         (= (following-char) ?>)))
+  (newline)
+  (if haskell-literate-flag (insert ">"))
+  (haskell-indent-line))
+
+(defun haskell-indent-line ()
+  "Indent current line of ordinary or literate Haskell code."
+  (interactive)
+  (let ((indent (haskell-calculate-indentation-pjt-2)))
+    (if (/= (current-indentation) indent)
+       (let ((beg (progn
+                    (beginning-of-line)
+                    (if (= (following-char) ?>) (forward-char 1)) ;LITERATE
+                    (point))))
+         (skip-chars-forward "\t ")
+         (delete-region beg (point))
+         (indent-to indent))
+      ;; If point is before indentation, move point to indentation
+      (if (< (current-column) (current-indentation))
+         (skip-chars-forward "\t ")))))
+
+(defun haskell-calculate-indentation ()
+  (save-excursion
+    (let ((col (current-column)))
+      (while (and (not (bobp))         ;skip over empty and comment-only lines
+                 (= col (current-column)))
+       (previous-line 1)
+       (beginning-of-line)                     ; Go to first non whitespace
+       (if (= (following-char) ?>)     ;LITERATE
+           (forward-char 1)
+         (if haskell-literate-flag     ;ignore illiterate lines
+             (end-of-line)))
+       (skip-chars-forward "\t ")              ; on the line.
+       (setq col (current-column))
+       (search-forward-regexp (concat haskell-open-comment "\\|--\\|\n") nil 0)
+       (goto-char (match-beginning 0)))
+      (search-backward-regexp "\\b\\(where\\|let\\|of\\|in\\)\\b\\|\n" nil 0)
+      (if (looking-at "\n")
+         ()
+       (setq col (current-column))
+       (forward-word 1)
+       (skip-chars-forward "\t ")
+       (if (looking-at "\\w")
+           (setq col (current-column))
+         (setq col (+ 2 col))))
+      col)))
+
+(defun haskell-calculate-indentation-pjt-2 ()
+  "Calculate indentation for Haskell program code, versatile version"
+  (save-excursion
+    (if (eq last-command 'haskell-indentation)
+       (setq haskell-indentation-counter (1+ haskell-indentation-counter))
+      (setq haskell-indentation-counter -1))
+    (setq this-command 'haskell-indentation)
+    (let* ((simple-indent (haskell-calculate-indentation))
+          (count haskell-indentation-counter)
+          (min-indent simple-indent)   ; minimum indentation found in a non-comment line
+          (last-indent simple-indent)  ; indentation of the following non-comment line
+          (return-indent nil)          ; computed indentation
+          (comment-depth 0))
+      (previous-line 1)
+      (if (< haskell-indentation-counter 0) ; 1st tab gives simple indentation
+         (setq return-indent simple-indent))
+      (while (not return-indent)
+       (if (search-backward-regexp "\\b\\(where\\|let\\|of\\)\\b\\|\n\\|{-\\|-}" nil t 1)
+           (cond
+            ((looking-at haskell-open-comment)
+             (setq comment-depth (1- comment-depth)))
+            ((looking-at haskell-close-comment)
+             (setq comment-depth (1+ comment-depth)))
+            ((= 0 comment-depth)
+             (cond
+              ((looking-at "\n")
+               (save-excursion
+                 (forward-char 1)
+                 (if (= (following-char) ?>)
+                     (forward-char 1)
+                   (if haskell-literate-flag
+                       (end-of-line))) ;LITERATE: ignore lines w/o >
+                 (skip-chars-forward "\t ")
+                 (if (looking-at (concat haskell-open-comment "\\|--\\|\n"))
+                     ()
+                   (setq last-indent (current-column))
+                   (if (< last-indent min-indent)
+                       (setq min-indent last-indent)))))
+              (t                       ; looking at a keyword
+               (save-excursion
+                 (forward-word 1)
+                 (skip-chars-forward " \t")
+                 (if (and haskell-literate-flag ;LITERATE: ignore lines w/o >
+                          (save-excursion
+                            (beginning-of-line)
+                            (/= (following-char) ?>)))
+                     (end-of-line))
+                 (if (looking-at (concat haskell-open-comment "\\|--\\|\n"))
+                     ()
+                   (setq last-indent (current-column)))
+                 (if (<= last-indent min-indent)
+                     (if (> count 0)
+                         (setq count (1- count))
+                       (setq return-indent last-indent)))
+                 (if (< last-indent min-indent)
+                     (setq min-indent last-indent)))))))
+         (setq return-indent simple-indent)
+         (setq haskell-indentation-counter -1)))
+      return-indent)))
+
+(defun haskell-skip-nested-comment ()
+  ;; point looks at opening {-, move over closing -}
+  ;; todo: specify what happens on failure, bounds check ...
+  (forward-char 2)
+  (let ((comment-depth 1))
+    (while (> comment-depth 0)
+      (search-forward-regexp "{-\\|-}")
+      (goto-char (match-beginning 0))
+      (setq comment-depth
+           (if (= (following-char) 123) ; code for opening brace
+               (1+ comment-depth)
+             (1- comment-depth)))
+      (goto-char (match-end 0)))))
+
+
+;;;seemingly obsolete functions
+(defun haskell-inside-of-inline-comment ()
+  (let ((bolp (save-excursion
+              (beginning-of-line)
+              (point))))
+    (search-backward comment-start bolp t 1)))
+
+(defun haskell-inside-of-nested-comment ()
+  (save-excursion
+    (let ((count 0))
+      (while
+         (search-backward-regexp "\\({-\\|-}\\)" 0 t 1)
+       (if (haskell-inside-of-inline-comment)
+           ()
+         (if (looking-at haskell-open-comment)
+             (setq count (1+ count))
+           (setq count (1- count)))))
+      (> count 0))))
+
+(defun haskell-inside-of-comment ()
+  (or (haskell-inside-of-inline-comment)
+      (haskell-inside-of-nested-comment)))
+
+;;;stolen from sml-mode.el
+(defun haskell-comment-indent ()
+  "Compute indentation for Haskell comments"
+  (if (looking-at "^--")
+      0
+    (save-excursion
+      (skip-chars-backward " \t")
+      (max (1+ (current-column))
+          comment-column))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; INFERIOR SHELL
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar haskell-shell-map nil "The mode map for haskell-shell.")
+
+(defun haskell-shell ()
+  "Inferior shell invoking Haskell.
+It is not possible to have more than one shell running Haskell.
+Like the shell mode with the additional command:
+
+\\[haskell-run-on-file]\t Runs haskell on the file.
+\\{haskell-shell-map}
+Variables controlling the mode:
+
+haskell-prog-name (default \"hbi\")
+    The string used to invoke the haskell program.
+
+haskell-use-right-delim (default \"\\\"\")
+haskell-use-left-delim  (default \"\\\"\")
+    The left and right delimiter used by your version of haskell, for
+    \"load file-name\".
+
+haskell-process-name (default \"Haskell\")
+    The name of the process running haskell.
+
+haskell-shell-prompt-pattern (default \"^> *\")
+    The prompt pattern.
+
+Runs haskell-shell-hook if not nil."
+  (interactive)
+  (if (not (process-status haskell-process-name))
+      (save-excursion                  ; Process is not running
+       (message "Starting Haskell...") ; start up a new process
+       (require 'shell)
+       (set-buffer (make-comint haskell-process-name haskell-prog-name))
+       (erase-buffer)                  ; Erase the buffer if a previous
+       (if haskell-shell-map           ; process died in there
+           ()
+         (setq haskell-shell-map (copy-keymap shell-mode-map))
+         (define-key haskell-shell-map "\C-c\C-f" 'haskell-run-on-file))
+       (use-local-map haskell-shell-map)
+       (make-local-variable 'shell-prompt-pattern)
+       (setq shell-prompt-pattern haskell-shell-prompt-pattern)
+       (setq major-mode 'haskell-shell)
+       (setq mode-name "Haskell Shell")
+       (setq mode-line-format 
+             "-----Emacs: %17b   %M   %[(%m: %s)%]----%3p--%-")
+       (set-process-filter (get-process haskell-process-name) 'haskell-process-filter)
+       (message "Starting Haskell...done.")
+       (run-hooks 'haskell-shell-hook))))
+
+(defun haskell-process-filter (proc str)
+  (let ((cur (current-buffer))
+       (pop-up-windows t))
+    (pop-to-buffer (concat "*" haskell-process-name "*"))
+    (goto-char (point-max))
+    (if (string= str "\b\b\b  \b\b\b")
+       (backward-delete-char 4)
+      (insert str))
+    (set-marker (process-mark proc) (point-max))
+    (pop-to-buffer cur)))
+
+(defun haskell-pop-to-shell ()
+  (interactive)
+  (haskell-shell)
+  (pop-to-buffer (concat "*" haskell-process-name "*")))
+
+(defun haskell-run-on-file (fil)
+  (interactive "FRun Haskell on : ")
+  (haskell-shell)
+  (save-some-buffers)
+  (process-send-string haskell-process-name
+              (concat "load " haskell-use-left-delim (expand-file-name fil)
+                      haskell-use-right-delim ";\n")))
+
+(defun haskell-save-buffer-use-file ()
+  "Save the buffer, and send a `use file' to the inferior shell
+running Haskell."
+  (interactive)
+  (let (file)
+    (if (setq file (buffer-file-name)) ; Is the buffer associated
+       (progn                          ; with file ?
+         (save-buffer)
+         (haskell-shell)
+         (process-send-string haskell-process-name
+                      (concat "load " haskell-use-left-delim
+                              (expand-file-name file)
+                              haskell-use-right-delim ";\n")))
+      (error "Buffer not associated with file."))))
+
+(defvar haskell-tmp-files-list nil
+  "List of all temporary files created by haskell-simulate-send-region.
+Each element in the list is a list with the format:
+
+      (\"tmp-filename\"  buffer  start-line)")
+
+(defvar haskell-simulate-send-region-called-p nil
+  "Has haskell-simulate-send-region been called previously.")
+
+(defun haskell-make-temp-name (pre)
+  (concat (make-temp-name pre) ".m"))
+
+(defun haskell-simulate-send-region (point1 point2)
+  "Simulate send region. As send-region only can handle what ever the
+system sets as the default, we have to make a temporary file.
+Updates the list of temporary files (haskell-tmp-files-list)."
+  (let ((file (expand-file-name (haskell-make-temp-name haskell-tmp-template))))
+    ;; Remove temporary files when we leave emacs
+    (if (not haskell-simulate-send-region-called-p)
+       (progn
+         (setq haskell-old-kill-emacs-hook kill-emacs-hook)
+         (setq kill-emacs-hook 'haskell-remove-tmp-files)
+         (setq haskell-simulate-send-region-called-p t)))
+    (save-excursion
+      (goto-char point1)
+      (setq haskell-tmp-files-list
+           (cons (list file
+                       (current-buffer)
+                       (save-excursion ; Calculate line no.
+                         (beginning-of-line)
+                         (1+ (count-lines 1 (point)))))
+                 haskell-tmp-files-list)))
+    (write-region point1 point2 file nil 'dummy)
+    (haskell-shell)
+    (message "Using temporary file: %s" file)
+    (process-send-string
+     haskell-process-name
+     ;; string to send: load file;
+     (concat "load " haskell-use-left-delim file haskell-use-right-delim ";\n"))))
+
+(defun haskell-remove-tmp-files ()
+  "Remove the temporary files, created by haskell-simulate-send-region, if
+they still exist. Only files recorded in haskell-tmp-files-list are removed."
+  (message "Removing temporary files created by haskell-mode...")
+  (while haskell-tmp-files-list
+    (condition-case ()
+       (delete-file (car (car haskell-tmp-files-list)))
+      (error ()))
+    (setq haskell-tmp-files-list (cdr haskell-tmp-files-list)))
+  (message "Removing temporary files created by haskell-mode...done.")
+  (run-hooks 'haskell-old-kill-emacs-hook))
+
+(defun haskell-send-region ()
+  "Send region."
+  (interactive)
+  (let (start end)
+    (save-excursion
+      (setq end (point))
+      (exchange-point-and-mark)
+      (setq start (point)))
+    (haskell-simulate-send-region start end)))
+
+(defun haskell-send-buffer ()
+  "Send the buffer."
+  (interactive)
+  (haskell-simulate-send-region (point-min) (point-max)))
+
+(defun haskell-evaluate-expression (h-expr)
+  "Prompt for and evaluate an expression"
+  (interactive "sExpression: ")
+  (let ((str (concat h-expr ";\n"))
+       (buf (current-buffer)))
+    (haskell-pop-to-shell)
+    (insert str)
+    (process-send-string haskell-process-name str)
+    (pop-to-buffer buf)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; keywords for jwz's font-look-mode (lemacs 19)
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(setq haskell-font-lock-keywords
+      (list (concat "\\b\\("
+                   (mapconcat 'identity 
+                              '("case" "class" "data" "default" "deriving" "else" "hiding"
+                                "if" "import" "in" "infix" "infixl" "infixr" "instance"
+                                "interface" "let" "module" "of" "renaming" "then" "to"
+                                "type" "where")
+                              "\\|")
+                   "\\)\\b")
+           (list "^\\(#[ \t]*\\(if\\|ifdef\\|ifndef\\|else\\|endif\\|include\\)\\)")
+           (list "\\(^>?\\|\\bwhere\\b\\|\\blet\\b\\)[ \t]*\\(\\(\\w\\|\\s_\\)+\\)\\(\\([^=\n]*\\S.\\)?=\\(\\S.\\|$\\)\\|[ \t]*::\\S.\\).*$"
+                   2 'font-lock-function-name-face)
+           (list "\\b\\(data\\|type\\)\\b[ \t]+\\(\\(\\w\\|\\s_\\)+\\)"
+                    2 'font-lock-type-face)
+           (list (concat "'\\([^\\]\\|\\\\\\([0-9]+\\|"
+                         (mapconcat 'identity
+                                    '("a" "b" "f" "n" "r" "t" "v" "\\\\" "\"" "'" "&")
+                                    "\\|")
+                         "\\|\\^\\([][_^A-Z@\\\\]\\)"
+                         "\\)\\)'") 1 'font-lock-string-face)))
+
+;;; font-lock-keywords for literate style files
+
+(setq haskell-font-lock-keywords-2
+      (list (concat "^>.*\\b\\("
+                   (mapconcat 'identity 
+                              '("case" "class" "data" "default" "deriving" "else" "hiding"
+                                "if" "import" "in" "infix" "infixl" "infixr" "instance"
+                                "interface" "let" "module" "of" "renaming" "then" "to"
+                                "type" "where")
+                              "\\|")
+                   "\\)\\b")
+           (list "^>\\(.*\\(\\bwhere\\b\\|\\blet\\b\\)\\|\\)[ \t]*\\(\\(\\w\\|\\s_\\)+\\)\\(\\([^=\n]*\\S.\\)?=\\(\\S.\\|$\\)\\|[ \t]*::\\S.\\).*$"
+                   3 'font-lock-function-name-face)
+           (list "^>.*\\b\\(data\\|type\\)\\b[ \t]+\\(\\(\\w\\|\\s_\\)+\\)"
+                    2 'font-lock-type-face)
+           (list (concat "^>.*'\\([^\\]\\|\\\\\\([0-9]+\\|"
+                         (mapconcat 'identity
+                                    '("a" "b" "f" "n" "r" "t" "v" "\\\\" "\"" "'" "&")
+                                    "\\|")
+                         "\\|\\^\\([][_^A-Z@\\\\]\\)"
+                         "\\)\\)'") 1 'font-lock-string-face)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; END OF Haskell-MODE
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(provide 'haskell-mode)
diff --git a/ghc/CONTRIB/haskell-modes/glasgow/original/haskell-mode.el b/ghc/CONTRIB/haskell-modes/glasgow/original/haskell-mode.el
new file mode 100644 (file)
index 0000000..b9a490f
--- /dev/null
@@ -0,0 +1,1935 @@
+;; Haskell major mode
+;; (c) Copyright, Richard McPhee et al. 
+;; University of Glasgow, February 1993
+
+
+
+;; if .hs is not recognised then put the extension in auto-mode-list
+
+(if (assoc "\\.hs" auto-mode-alist)
+    nil
+  (nconc auto-mode-alist '(("\\.hs". haskell-mode))))
+
+(if (assoc "\\.hi" auto-mode-alist)
+    nil
+  (nconc auto-mode-alist '(("\\.hi". haskell-mode))))
+
+(if (assoc "\\.gs" auto-mode-alist)
+    nil
+  (nconc auto-mode-alist '(("\\.gs". haskell-mode))))
+
+(defvar haskell-mode-syntax-table nil
+  "Syntax table for haskell-mode buffers.")
+
+(defvar haskell-mode-abbrev-table nil
+  "Abbrev table for haskell-mode buffers.")
+
+(defvar haskell-mode-map (make-sparse-keymap)
+  "Keymap for haskell-mode-buffers.")
+
+
+
+;;; Here are the keymaps used in haskell-mode
+
+(define-key haskell-mode-map "\M-;"  'haskell-insert-comment)
+(define-key haskell-mode-map "\C-c=" 'haskell-insert-concat)
+(define-key haskell-mode-map "\C-c;" 'set-haskell-comment-column)
+(define-key haskell-mode-map "\C-c+" 'set-haskell-concat-column)
+(define-key haskell-mode-map "\C-cn" 'set-haskell-indent-offset)
+(define-key haskell-mode-map "\C-cl" 'set-haskell-list-offset)
+(define-key haskell-mode-map "\C-ci" 'set-haskell-if-offset)
+(define-key haskell-mode-map "\C-ce" 'set-haskell-let-offset)
+(define-key haskell-mode-map "\C-cc" 'set-haskell-case-offset)
+(define-key haskell-mode-map "\C-ct" 'set-haskell-then-offset)
+(define-key haskell-mode-map "\C-co" 'set-haskell-comp-offset)
+(define-key haskell-mode-map "\C-cw" 'set-haskell-where-offset)
+(define-key haskell-mode-map "\C-cg" 'goto-line)
+(define-key haskell-mode-map "\C-j"  'haskell-reindent-then-newline-and-indent)
+(define-key haskell-mode-map "\t"    'haskell-indent-line)
+(define-key haskell-mode-map "}"     'electric-haskell-brace)
+(define-key haskell-mode-map "]"     'electric-haskell-brace)
+(define-key haskell-mode-map ")"     'haskell-insert-round-paren)
+(define-key haskell-mode-map "\C-cr" 'haskell-indent-region)
+(define-key haskell-mode-map "\C-cf" 'haskell-further-indent)
+(define-key haskell-mode-map "\C-cb" 'haskell-lesser-indent)
+(define-key haskell-mode-map "\177"  'backward-delete-char-untabify)
+(define-key haskell-mode-map "\M-\C-\177" 'delete-horizontal-space)
+                                       
+(defun haskell-set-local-vars ()
+  "Set the local variables for haskell-mode."
+  (kill-all-local-variables)
+
+  (setq indent-line-function 'haskell-indent-line)
+
+  (make-local-variable 'haskell-std-list-indent)
+  ;;Non-nil means indent to the offset, 'haskell-list-offset' in a bracket rather than
+  ;; moving to the next word afer a function name
+  (setq haskell-std-list-indent t)
+
+  (make-local-variable 'haskell-nest-ifs)
+  ;;Non-nil means that 'if' statements are nested ie. lined up with `if' not `else'.
+  (setq haskell-nest-ifs nil)
+
+  (make-local-variable 'haskell-align-else-with-then)
+  ;;Non-nil means align an `else' under it's corresponding `then'
+  (setq haskell-align-else-with-then nil)
+
+
+  ;;The local vars for 'where' indentation
+
+  (make-local-variable 'haskell-align-where-with-eq)
+  ;;Non-nil means align a 'where' under it's corresponding equals sign
+  (setq haskell-align-where-with-eq t)
+
+  (make-local-variable 'haskell-align-where-after-eq)
+  ;;Non-nil means align a 'where' after it's corresponding equals sign
+  (setq haskell-align-where-after-eq nil)
+
+  (make-local-variable 'haskell-std-indent-where)
+  ;;put the 'where' the standard offset ie. 'haskell-indent-offset'
+  (setq haskell-std-indent-where nil)  
+
+
+  (make-local-variable 'haskell-always-fixup-comment-space)
+  ;;Non-nil means always insert a (single) space after a comment, even
+  ;; if there is more or less than one.
+  (setq haskell-always-fixup-comment-space t)
+
+  
+  (make-local-variable 'haskell-indent-offset)
+  ;;Extra indentation for a line continued after a keyword.
+  (setq haskell-indent-offset 4)
+
+  (make-local-variable 'haskell-list-offset)
+  ;;Extra indentation for continuing a list.
+  (setq haskell-list-offset 4)
+  
+  (make-local-variable 'haskell-comp-offset)
+  ;;Extra indentation for a list comprehension.
+  (setq haskell-comp-offset 4)
+  
+  (make-local-variable 'haskell-case-offset)
+  (setq haskell-case-offset 4)
+
+  (make-local-variable 'haskell-where-offset)
+  (setq haskell-where-offset 4)
+
+  (make-local-variable 'haskell-let-offset)
+  (setq haskell-let-offset 4)
+
+  (make-local-variable 'haskell-then-offset)
+  (setq haskell-then-offset 0)
+
+  (make-local-variable 'haskell-if-offset)
+  (setq haskell-if-offset 4)
+
+  (make-local-variable 'haskell-comment-column)
+  (setq haskell-comment-column 35)
+  
+  (make-local-variable 'haskell-concat-column)
+  (setq haskell-concat-column 69)
+  
+  (make-local-variable 'haskell-where-threshold)
+  (setq haskell-where-threshold 35)
+  
+  (make-local-variable 'line-comment)
+  (setq line-comment "-- ")
+
+  (make-local-variable 'haskell-indent-style)
+  (setq haskell-indent-style "none"))
+
+
+(defun haskell-set-syntax-table ()
+  "Set the syntax table for Haskell-mode."
+  (setq haskell-mode-syntax-table (make-syntax-table))
+  (set-syntax-table haskell-mode-syntax-table)
+  (modify-syntax-entry ?\" "\"")
+  (modify-syntax-entry ?\\ "\\")
+  (modify-syntax-entry ?\' "w")
+  (modify-syntax-entry ?_  "w")
+  (modify-syntax-entry ?#  "_")
+  (modify-syntax-entry ?$  "_")
+  (modify-syntax-entry ?%  "_")
+  (modify-syntax-entry ?:  "_")
+  (modify-syntax-entry ??  "_")
+  (modify-syntax-entry ?@  "_")
+  (modify-syntax-entry ?!  "_")
+  (modify-syntax-entry ?^  "_")
+  (modify-syntax-entry ?~  "_")
+  (modify-syntax-entry ?-  "_ 12")
+  (modify-syntax-entry ?\n ">")
+  (modify-syntax-entry ?{  "(}")
+  (modify-syntax-entry ?}  "){")
+  (set-syntax-table haskell-mode-syntax-table))
+
+
+
+(defun haskell-mode ()
+  "Major mode for editing Haskell code.
+Linefeed reindents current line, takes newline and indents.
+Tab indents current line for Haskell code.
+Functions are seperated by blank lines.
+Delete converts tabs to spaces as it moves back.
+\\{haskell-mode-map}
+Variables controlling indentation style:
+ haskell-indent-offset
+    Standard extra indentation for continuing Haskell
+    code under the scope of an expression.  The default is 4.
+
+ haskell-list-offset
+    Extra indentation for indenting in a list.  Used if variable
+    haskell-std-list-indent is non-nil.  The default is 4.
+
+ haskell-comp-offset
+    Extra indentation for continuing a list comprehension.  
+    The default is 4.
+
+ haskell-case-offset
+    Standard extra indentation for continuing Haskell
+    code under the scope of an expression.  The default is 4.
+
+ haskell-where-offset
+    Standard extra indentation for continuing Haskell
+    code under the scope of a `where'.  The default is 4.
+
+ haskell-let-offset
+    Standard extra indentation for continuing Haskell
+    code under the scope of a `let'.  The default is 4.
+
+ haskell-then-offset
+    Standard extra indentation for a `then' beyond
+    its corresponding `if'.  The default is 0.
+
+ haskell-if-offset
+    Standard extra indentation for continuing Haskell
+    code under the scope of an `if'.  The default is 4.
+
+ haskell-comment-column
+    Column to which line comments `--' will be inserted.
+    The default is 35.
+
+ haskell-concat-column
+    Column to which concatenation operator `++' will be inserted.
+    The default is 69.
+
+ haskell-where-threshold
+    Column beyond which a `where' will be indented to the
+    start of a line (to avoid spilling over lines).
+    The default is 35.
+
+ set-haskell-indent-offset (C-c i)
+    Changes the default value of the local variable,
+    haskell-indent-offset.  May be a number from 0-10.
+
+ set-haskell-list-indent (C-c l)
+    Change the value of the local variable, 
+    haskell-list-offset.  May be a number from 0-100.
+
+ set-haskell-comment-column (C-x ;)
+    Changes the value of the local variable,
+    haskell-comment-column.  May be any number from 0-100."
+
+  (interactive)
+  (haskell-set-local-vars)
+  (haskell-set-syntax-table)
+  (use-local-map haskell-mode-map)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell") 
+  (define-abbrev-table 'haskell-mode-abbrev-table ()))
+
+
+
+
+;;; Returns the indentation column for a comment on this line.
+;;; The point is positioned at the last char of any code on the line.
+
+(defun haskell-comment-indent ()
+  "Returns the indentation for a comment on the given line.
+If the line has code on it or the point is not at the beginning of the line,
+then indent to indent-column.
+Otherwise, don't indent."
+  (cond ((or (haskell-code-on-linep)   
+            (not (bolp)))               
+        ;;There is code before the haskell-comment-column
+        ;; or not at the beginning of the line
+        ;;Return the largest of
+        ;; the current column +1 and the haskell-comment-column
+        (max (1+ (current-column))     
+             haskell-comment-column))          
+       (t
+        ;;Otherwise, return 0
+        0)))
+
+
+
+;;; Returns whether a comment is on the current line
+;;; Search from bol, and beware of "--", {-- etc!
+;;; DOES NOT RECOGNISE {- COMMENTS YET or -- within a string
+
+(defun haskell-comment-on-linep ()
+  "Returns the truth value of whether there is a '--' comment on the current line."
+  (save-excursion
+    (beginning-of-line)                
+    (looking-at ".*--")))
+
+
+;;; This doesn't account for comments '{-'.  Test explicitly if you use this function!
+
+(defun haskell-code-on-linep ()
+  "Returns a truth value as to whether there is code on the current line."
+  (save-excursion
+    (beginning-of-line)
+    (not
+     ;; Code on line if not looking at a comment directly
+     ;; and the line is not blank
+     (or
+         (looking-at "^[ \t]*--")      
+         (looking-at "^[ \t]*$")))))   
+
+
+;;; Insert a Haskell "--" comment on the current line.
+;;; Move to the comment position if there's already a comment here.
+;;; Otherwise, the comment is inserted either at the comment column
+;;; or one column after the last non-space character, whichever is further
+;;; to the right.
+;;; This function is executed by M-;
+
+(defun haskell-insert-comment ()
+  "Inserts a '--' comment on the given line."
+  (interactive)
+  (cond ((haskell-comment-on-linep)
+        ;;There is a comment on the line
+        ;;Just reindent existing comment
+        (haskell-reindent-comment))    
+       (t
+        (if (haskell-code-on-linep)
+            ;;There is code on the line
+            ;; and guarenteed that a comment
+            ;; does not already exist.
+            ;;Move to the last nonspace char
+            ;; (there may be spaces after the last char)
+            (progn
+              (end-of-line)                    
+              (skip-chars-backward " \t")))
+        ;;Indent to required level
+        ;; and insert the line comment '--'
+        (indent-to (haskell-comment-indent)) 
+        (insert line-comment))))               
+
+
+;;; Reindents a comment.
+;;; The comment is indented according to the normal rules.
+;;; Skips over ---- and following spaces or tabs
+
+(defun haskell-reindent-comment ()
+  "Indents a comment on a line to keep it at haskell-comment-column,
+if possible.
+It is guaranteed that a comment exists on the current line."
+    (beginning-of-line)
+    ;;Go back to beginning of comment 
+    (re-search-forward "--")           
+    (forward-char -2)
+    ;;Delete all spaces and reindent to
+    ;; the correct location.
+    (delete-horizontal-space)          
+    (indent-to (haskell-comment-indent)) 
+    ;;Move past the comment and insert
+    ;; only one space between it and the text.
+    ;;Leave point just after comment.
+    (skip-chars-forward "- \t")
+    (if haskell-always-fixup-comment-space
+       (progn
+       (fixup-whitespace)                      
+       (forward-char 1))))
+
+
+
+;;; Inserts a haskell concatenation operator, `++', at the
+;;; column dictated by haskell-concat-column
+
+(defun haskell-insert-concat()
+  "Inserts a `++' operator on the given line."
+  (interactive)
+  (end-of-line)                        
+  (skip-chars-backward " \t")
+  ;;Indent to required level
+  ;; and insert the concat operator `++'
+  (indent-to (haskell-concat-indent)) 
+  (insert "++"))
+
+
+
+;;; Returns the indentation column for a concatenation operator on this line.
+;;; The point is positioned at the last char of any code on the line.
+
+(defun haskell-concat-indent ()
+  "Returns the indentation for a concat operator on the given line."
+  (max (1+ (current-column))   
+       haskell-concat-column)) 
+
+
+
+;;; Returns the indentation of the current line of haskell code.
+;;; A blank line has ZERO indentation
+
+(defun haskell-current-indentation ()
+  "Returns the indentation for the current haskell line. A blank line has 
+indentation zero."
+  (save-excursion
+    (beginning-of-line)
+    (if (looking-at "^[ \t]*$")
+       ;;The line is empty
+       ;; so the indentation is zero
+       0
+      ;;Otherwise find the normal value of indentation
+      (current-indentation))))         
+
+
+
+;;; Returns the indentation of the previous line of haskell code.
+;;; A blank line has ZERO indentation
+
+(defun haskell-previous-indentation ()
+  "Returns the previous line's indentation as Haskell indentation."
+  (save-excursion
+    (if (not (bobp))
+       ;;Not at the start of the buffer
+       ;; so get the previous lines indentation
+       (progn
+         (forward-line -1)
+         (haskell-current-indentation))
+      ;;We are at the start of buffer
+      ;;There is no previous line; Indent is zero
+      0)))                             
+
+
+
+;;; Move back to the last line which is aligned in the left column.
+;;; Ignores comments and blank lines.
+;;; The point is left at the beginning of the line.
+
+(defun haskell-back-to-zero-indent ()
+  "Moves point to last line which has zero as indentation."
+  ;;Not at the beginning of buffer.
+  ;;Continue to go to the previous line until
+  ;; we find a line whose indentation is non-zero.
+  ;;Blank lines and lines containing only comments
+  ;; are ignored.
+  (beginning-of-line)
+  (while (and
+         (or (not (zerop (haskell-current-indentation)))       
+             (looking-at "^[ \t]*\\($\\|--\\)"))
+           (not (bobp)))
+    (haskell-backward-to-noncomment)
+    (beginning-of-line)))
+
+
+
+;;; Find the last symbol, usually an equality.
+
+;;; Note: we check for "=" as a complete WORD (and ignore
+;;; comments) when searching for this.  Ie. an `=' may be
+;;; surrounded only by a letter, digit, or whitespace .
+;;; Strings are not considered.
+;;; Don't go beyond the first character in the (possibly narrowed) buffer.
+;;;   From the beginning of the line,
+;;;     find the comment position (or end-of-line)
+;;;     search forward to this position, looking for a "where"
+;;;     If one's found, then search forward for "\b=\b"
+;;;        If there's no equality sign then
+;;;            search forward from the start of the line for an equals
+;;;       Otherwise we found it.
+;;;    If there's no where then search forward for an equals, as above.
+                                
+(defun haskell-back-to-symbol (exp)
+  "Goes backward from point until a symbol, EXP, is found.
+The point is left at the first symbol matching the context 
+of the haskell code."
+  (let* ((found nil)
+        (symbol (concat "[ \ta-z0-9A-Z]" exp "[ \t\na-z0-9A-Z]"))
+        eol-limit
+        bol-limit
+        (zero-indent (save-excursion
+                       (haskell-back-to-zero-indent)
+                       (point)))
+        (initial-depth (car (parse-partial-sexp
+                             (point)
+                             zero-indent))))
+       
+    (while (and (not found)
+               (> (point) zero-indent))
+      ;;Not found and point > point min
+      ;;Record the limit of search for the beginning and
+      ;; end of the line.
+      (setq eol-limit (point)) 
+      (beginning-of-line)
+      (setq bol-limit (point)) 
+      (goto-char eol-limit)            
+      (re-search-backward "\\bwhere\\b" bol-limit 't)
+      ;;Search back from the end of the line
+      ;; to find the most recent 'where'.
+
+      (cond ((and (re-search-backward symbol bol-limit 't)
+                 (= initial-depth
+                    (car (parse-partial-sexp
+                          (point)
+                          zero-indent))))
+            ;;Found a symbol sign surrounded by
+            ;; a letter, digit or space only, or at the
+            ;; beginning of the buffer and they are at
+            ;; the same depth level
+            (setq found 't))
+           ((and (re-search-backward symbol bol-limit 't)
+                 (zerop
+                  (car (parse-partial-sexp
+                        (point)
+                        zero-indent))))
+            ;; Found a symbol and it is not in any parens
+            (setq found 't))
+           ;;Otherwise, go back a line.
+           (t (haskell-backward-to-noncomment))))
+    (if found
+       (forward-char 1))))
+
+
+;;; Goes back to the last keyword.  The point is left at the
+;;; beginning of the keyword.
+;;; The words recognised are:
+;;;   `case',`of',`where',`let',`in',`if',`then',`else'
+
+(defun haskell-back-to-keyword ()
+  "Goes backward from point until a keyword is found.
+The point is left after the first keyword."
+  (let* ((found nil)
+        eol-limit
+        bol-limit
+        (zero-indent (save-excursion
+                       (haskell-back-to-zero-indent)
+                       (point)))
+        (initial-depth (car (parse-partial-sexp
+                             (point)
+                             zero-indent))))
+
+    (while (and (not found)
+               (>= (point) zero-indent))
+      ;;Not found and point > point min
+      ;;Go back past any comment.
+      ;;Record the limit of search for the beginning and
+      ;; end of the line.
+      (setq eol-limit (point)) 
+      (beginning-of-line)
+      (setq bol-limit (point)) 
+      (goto-char eol-limit)            
+      (if (and (re-search-backward
+               "\\b\\(case\\|of\\|where\\|let\\|in\\|if\\|then\\|else\\)\\b"
+               bol-limit 't)
+              (= initial-depth
+                 (car (parse-partial-sexp
+                       (point)
+                       zero-indent))))
+         ;;Found a keyword and it is at the same level as the initial position
+         (progn
+           (setq found 't)
+           (forward-word 1))
+       ;;Otherwise, go back a line.
+       (haskell-backward-to-noncomment)))))
+
+
+
+;;; Returns the end of line (point) of the current line, excluding any
+;;; line comments on it.
+
+(defun haskell-eol ()
+  "Returns the end (point) of the current line, excluding any line comments."
+  (save-excursion
+    (end-of-line)
+    (let ((eol-limit (point))) 
+      (beginning-of-line)
+      (if (search-forward "--" eol-limit 'move-to-eol)
+         ;;Found a '--' 
+         ;;So move to the beginning of the comment
+         ;;If fail then move to end of line
+         (forward-char -2)))
+    (point)))
+
+
+
+;;; Returns whether or not the current line contains an equality outwith a
+;;; comment.  The equality may only be surrounded by a letter, digit or
+;;; whitespace. 
+
+(defun haskell-looking-at-eqp ()
+  "Returns whether or not the current line contains an equality outwith a
+comment."
+  (save-excursion
+    (beginning-of-line)
+    (re-search-forward "[ \ta-z0-9A-Z]=[ \t\na-z0-9A-Z]" (1+ (haskell-eol)) 't)))
+         
+         
+;;; This function does not require all keywords, just those which
+;;; may have a bracket before them.
+(defun haskell-looking-at-keywordp ()
+  "Returns whether or not there is a keyword after the point outwith a
+comment."
+  (save-excursion
+    (re-search-forward 
+     "\\(\\(=>\\|=\\|++\\|->\\|<-\\|::\\)\\|\\b\\(case\\|of\\|if\\|then\\|else\\|let\\|in\\)\\b\\)"
+     (haskell-eol) 't)))
+         
+         
+;;; This function returns whether or not there is a keyword contained in
+;;; the region START END.  START < END.
+
+(defun haskell-keyword-in-regionp (start end)
+  "Returns whether or not there is a keyword between START and END."
+  (save-excursion
+    (goto-char start)
+    (let ((found nil)
+         (eol-limit (haskell-eol)))
+      (while (and (not found) (< (point) end))
+       (if (> eol-limit end)
+           (setq eol-limit end))
+       (if (re-search-forward
+            "\\b\\(case\\|of\\|if\\|then\\|else\\|let\\|in\\)\\b"
+            eol-limit 'move)
+           (setq found t)
+         ;;Otherwise, have not found a keyword.  Now at haskell-eol.
+         (if (< (point) end)
+             ;;We still have an area to search
+             ;; so go forward one line
+             (progn
+               (beginning-of-line)
+               (forward-line 1)
+               (setq eol-limit (haskell-eol))))))
+      ;;found is `t' or point >= end
+      found)))
+        
+
+;;;  Goes back to the last line which is not entirely commented out.
+;;;  The point is left just before the comment.  
+         
+(defun haskell-backward-to-noncomment ()
+  "Sets the point to the last char on the line of Haskell code before a comment."
+  (let ((comment 't)
+       (limit (point-min)))
+      (while (and comment (> (point) limit))
+       ;; comment is true and point > limit
+       (beginning-of-line)
+       (if (< (forward-line -1) 0)
+           ;;This was the first line in the buffer
+           (setq comment nil)
+         ;;Otherwise, this was not the first line
+         (if (not (looking-at "^[ \t]*\\($\\|--\\)"))
+             ;;There is not a comment at the beginning of the line
+             ;; and the line is not blank
+             (progn
+               ;;The line is either blank or has code on it.
+               (setq comment nil)
+               (goto-char (haskell-eol))))))
+
+      ;;return point
+      (point)))
+
+
+
+;;; Indents a region (by applying "tab" to each line).
+;;; The marker upper-marker is set to the end of the region.
+;;; We indent from the beginning of the region to this marker.
+;;; Implements C-c r.
+                     
+(defun haskell-indent-region ()
+  "Indents the region between the point and mark."
+  (interactive)
+  (let ((lower-limit (min (point) (mark)))
+       (upper-limit (max (point) (mark))))
+    (indent-region lower-limit upper-limit 'nil)))
+      
+
+
+;;; Implements TAB.
+;;; This actually indents a line.
+;;; Eventually it will handle a line split at any point,
+
+(defun haskell-indent-line ()
+  "Indent current line as Haskell code.
+Keeps the point at the same position on the line unless the 
+point is less then the current indentation, in which case the 
+point is moved to the first char."
+  (interactive)
+  (save-excursion
+    (let ((indent (haskell-calculate-indentation)))
+      (beginning-of-line)
+      (delete-horizontal-space)
+      ;;Kill any spaces that may preceed the code
+      ;; and reindent to the correct level.
+      (indent-to indent)))
+  (if (< (current-column) (current-indentation))
+      ;;The point is in the indentation
+      ;; so move to the first char on the line
+      (move-to-column (current-indentation))))
+
+
+
+;;; This is the haskell version of the Emacs function
+;;; reindent-then-newline-and-indent.  It was necessary
+;;; to write this because the Emacs version has the 
+;;; terrible property of deleting whitespace BEFORE 
+;;; reindenting the original line.
+
+(defun haskell-reindent-then-newline-and-indent ()
+  "Reidents the current line of Haskell code then takes a
+newline and indents this new line."
+  (interactive)
+  (skip-chars-backward " \t")
+  (haskell-indent-line)
+  (newline)
+  (delete-horizontal-space)
+  (haskell-indent-line))
+
+
+
+;;; Returns whether the first word of the last line with zero indentation 
+;;; is the same as the first word of the current line.
+;;; This function is based on the (reasonable?) assumption that 
+;;; a function definition occurs on the left hand margin.
+;;; This is not quit reasonable since recusive functions are not
+;;; recognised.
+
+(defun haskell-continued-fn-defp ()
+  "Returns whether the first word on the last line with zero indentation
+matches the first word on the current line."
+  (save-excursion
+    (beginning-of-line)
+    (skip-chars-forward " \t")
+    ;;Goto the first non space char 
+    (haskell-word-eq (point)
+                    (save-excursion
+                      (forward-line -1)
+                      (haskell-back-to-zero-indent)
+                      (point)))))
+
+
+;;; Returns whether two words are the same.
+;;; The beginning of both words are given as their
+;;; respective points in the buffer.  
+
+(defun haskell-word-eq (current-pos previous-pos)
+  (let ((OK 't))
+    (goto-char previous-pos)
+    ;;We shall compare the two words starting
+    ;; at previous-pos and current-pos.
+      (while (and OK (looking-at "\\S-"))
+       ;;OK and looking at a word constituent
+       (if (eq (char-after current-pos) 
+               (char-after previous-pos))
+           ;;The two chars are the same
+           (progn
+             ;;Increment the two postions
+             ;; and update location of point
+             (setq current-pos (1+ current-pos))
+             (setq previous-pos (1+ previous-pos))
+             (goto-char previous-pos))
+         ;;The two chars are different
+         ;; so set OK to be false
+         (setq OK 'nil)))
+
+      ;;Return the value of OK
+      OK))                             
+      
+
+
+
+;;; This function returns the column of the last unbalanced
+;;; expression.
+;;; It is called when an keyword is found.  The point is 
+;;; initially placed before the corresponding keyword.
+;;; The function looks at every word to see if it is a
+;;; `let' or `in'.  Each word must be outwith a comment.
+
+(defun haskell-last-unbalanced-key-column (open close)
+  "Returns the column of the last unbalanced keyword, open."
+  (save-excursion
+    (let ((original-pos (point))
+         (bol-limit (save-excursion
+                      (beginning-of-line)
+                      (setq bol-limit (point))))
+         (depth  1))
+      (setq open (concat "\\b" open "\\b"))
+      (setq close (concat "\\b" close "\\b"))
+      (while (and
+             (> depth 0)
+             (> (point) (point-min)))
+       (forward-word -1)
+       (if (< (point) bol-limit)
+           ;;Moved past the beginning of line limit
+           ;; so go back to the previous line past
+           ;; any comments.
+           (progn
+             (goto-char original-pos)
+             (haskell-backward-to-noncomment)
+             (setq original-pos (point))
+             (setq bol-limit (save-excursion
+                               (beginning-of-line)
+                               (point))))
+         ;;Otherwise, still on the same line
+         (if (looking-at open)
+             ;;This word is an open keyword
+             (setq depth (1- depth))
+           ;;Otherwise,
+           (if (looking-at close)
+               ;;This word is a close keyword
+               (setq depth (1+ depth))))))
+
+      (if (string= open "\\bif\\b")
+         ;;The argument is `if'
+         (if (not (save-excursion (skip-chars-backward " \t") (bolp)))
+             ;;There is something before the `if'
+             (if (and (save-excursion
+                        (forward-word -1)
+                        (looking-at "\\belse\\b"))
+                      (not haskell-nest-ifs))
+                 ;;There is an `else' before the 'if'
+                 (forward-word -1))))
+      
+      
+      (current-column))))
+       
+         
+
+;;; Return the indentation for a line given that we expect a `where'.
+;;; The point lies on the corresponding symbol 
+;;; that the `where' scopes over.
+
+(defun haskell-indent-where ()
+  "Return the indentation for a line, given that we expect a `where'
+clause."
+  (let ((symbol (if (looking-at "=")
+                   "="
+                 "->")))
+    
+    (cond ((or haskell-std-indent-where
+              (> (current-column) haskell-where-threshold))
+          ;;Set indentation as the sum of the previous
+          ;; line's layout column and the standard offset
+          ;; (ie. 'haskell-where-offset)
+          (save-excursion
+            (beginning-of-line)
+            (cond ((looking-at (concat "^[ \t]*" symbol))
+                   ;;The line starts with the symbol
+                   (setq indent (current-indentation)))
+                  ((looking-at "^[ \t]*where\\b")
+                   ;;The line starts with a 'where'
+                   (forward-word 1)
+                   (skip-chars-forward " \t")
+                   (setq indent (+ (current-column) haskell-where-offset)))
+                  (t
+                   ;;The line begins on the layout column
+                   (setq indent (+ (current-indentation) 
+                                   haskell-indent-offset))))))
+         ((or haskell-align-where-with-eq
+              haskell-align-where-after-eq)
+          (if (looking-at (concat symbol "[ \t]*$"))
+              ;;The symbol is at the end of the line
+              (setq indent (+ (current-indentation)
+                              haskell-where-offset))
+            (save-excursion
+              ;;Set the indentation as required
+              (if haskell-align-where-after-eq
+                  (skip-chars-forward (concat symbol " \t")))
+              (setq indent (current-column))))))))
+
+
+
+;;; Calculates the indentation for the current line.
+;;; When we come here, we are in a line which we want to indent.
+;;; We should leave the point at the same relative position it
+;;; was in before we called the function, that is, if a line
+;;; is already correctly indented, nothing happens!
+
+;;; The main problems are handling "where" definitions
+;;; and the syntax of expressions when these are continued
+;;; over multiple lines (e.g. tuples, lists, or just plain
+;;; bracketed expressions).  Watch out for let ... in, too!
+
+;;; For example, think about the following tricky cases:
+
+;;;    f x = x + <NL>
+      
+;;;    f x = [  x + y, <NL>
+
+;;;    f x = [  <NL>
+
+;;;    f x = [  -- start of a large list
+;;;             -- which I'm commenting in as I go
+;;;  <TAB>
+
+(defun haskell-calculate-indentation ()
+  "Returns the indentation level for the current line of haskell code."
+  (save-excursion
+    (let ((indent 0)
+         (eol-position (point)))
+      (beginning-of-line)
+      (cond ((bobp)
+            ;;We are at the beginning of the buffer so do nothing at all
+            (setq indent 0))   
+
+           ((looking-at "^[ \t]*--")
+            ;;There is a comment on the line by itself
+            ;;Leave it the way it is
+            (setq indent (current-indentation)))
+
+           ((looking-at "^[ \t]*\\(data\\|type\\|module\\|import\\|instance\\)\\b")
+            ;;There is a 'data', 'type', 'module' or 'import' at start of line
+            (setq indent 0))
+
+           ((haskell-continued-fn-defp)
+            ;;This is clearly same function
+            ;; so set indent to be 0
+            (setq indent 0))
+                 
+           ((looking-at "^[ \t]*[]}]")
+            ;;There is a "]" or "}" at the start of the line
+            (let ((state (parse-partial-sexp (match-end 0)
+                                             (save-excursion
+                                               (haskell-back-to-zero-indent)
+                                               (point)))))
+              (if (>= (car state) 0)
+                  ;;Since the point is just after a parenthesis
+                  ;; it has a match if the depth is >= 0
+                  (save-excursion
+                    (goto-char (nth 2 state))
+                    ;;Move to the match.
+                    (if (not
+                         (save-excursion
+                           (skip-chars-backward " \t")
+                           (bolp)))
+                        ;;There is something before the brace.
+                        (progn
+                          (let ((initial-pos (point)))
+                            (forward-word -1)
+                            (if (not (looking-at
+                                      "\\(let\\|where\\)"))
+                                ;;The word is not `where' or `let'
+                                ;; so go back.
+                                (progn
+                                  (goto-char initial-pos)
+                                  (skip-chars-forward " \t"))))))
+                    (setq indent (current-column)))
+                (setq indent 0))))
+
+           ((looking-at "^[ \t]*\\(->\\|=>\\)")
+            ;; '->' or '=>' at start of line
+            (save-excursion
+              (haskell-backward-to-noncomment)
+              ;;Go back to previous line
+              (let ((eol-limit (point)))
+                (beginning-of-line)
+                (if (re-search-forward "::" eol-limit 't)
+                    ;;There is a '::' on this (previous) line
+                    ;; set indent to be at the start of it
+                    (setq indent (- (current-column) 2))
+                  ;;Otherwise copy this (previous) line's indentation
+                  (setq indent (current-indentation)))))) 
+                            
+           ((looking-at "^[ \t]*where\\b")
+            ;;There is a 'where' at the start of the line
+            ;;Look for the equality (which will not
+            ;; be on this line).
+            (haskell-backward-to-noncomment)
+            (goto-char (max (save-excursion
+                              (haskell-back-to-symbol "=")
+                              (point))
+                             (save-excursion
+                              (haskell-back-to-symbol "->")
+                              (point))))
+            (setq indent (haskell-indent-where)))
+
+           ((looking-at "^[ \t]*then\\b")
+            ;;The first thing on the line is a `then'
+            (setq indent (+ (haskell-last-unbalanced-key-column "if" "then")
+                            haskell-then-offset)))
+
+           ((looking-at "^[ \t]*else\\b")
+            ;;The first thing on the line is a `else'
+            (if haskell-align-else-with-then
+                (setq indent (haskell-last-unbalanced-key-column "then" "else"))
+              (setq indent (haskell-last-unbalanced-key-column "if" "else"))))
+                            
+           ((looking-at "^[ \t]*|")
+            ;;There is a `|' at beginning of line
+            (save-excursion
+              (let ((state
+                    (parse-partial-sexp (save-excursion
+                                          (haskell-back-to-zero-indent)
+                                          (point))
+                                        (point))))
+                (if (not (or (nth 3 state) (nth 4 state)))
+                    ;;Not in a comment or string
+                    (if (> (car state) 0)
+                        ;;In an unbalanced parenthesis.
+                        (progn
+                          (goto-char (nth 1 state))
+                          ;;Move to the beginning of the unbalanced parentheses
+                          (if (and (looking-at "\\[")
+                                   (search-forward "|" (haskell-eol) 't))
+                              ;;It is a list comprehension
+                              (setq indent (1- (current-column)))
+                            (setq indent (+ (current-column)
+                                            haskell-comp-offset))))
+                      ;;Otherwise, not in an unbalanced parenthesis
+                      (setq indent (save-excursion
+                                     (haskell-back-to-symbol "=")
+                                     (cond ((not (looking-at "="))
+                                            ;;Did not find an equals
+                                            (+ (haskell-previous-indentation)
+                                               haskell-indent-offset))
+                                           ((save-excursion
+                                              (beginning-of-line)
+                                              (looking-at "^[ \t]*data\\b"))
+                                            ;;There is a `data' at beginning
+                                            (setq indent (current-column)))
+                                           ((save-excursion
+                                              (beginning-of-line)
+                                              (search-forward
+                                               "|" (haskell-eol) 't))
+                                            ;;There is a `|' on this line
+                                            ;; so set this to be the indent
+                                            (save-excursion
+                                              (goto-char (match-beginning 0))
+                                              (current-column)))
+                                           (t
+                                            ;;Otherwise, set `=' as indent
+                                            (current-column))))))))))
+                  
+           ((looking-at "^[ \t]*=")
+            ;;There is an equals at the start of the line
+            ;;Set the indentation to be the previous line's 
+            ;; indentation plus the standard offset
+            (setq indent (+ haskell-indent-offset
+                            (haskell-previous-indentation))))
+
+           ((looking-at "^[ \t]*in\\b")
+            ;;The line starts with 'in'
+            (beginning-of-line)
+            (setq indent (haskell-last-unbalanced-key-column "let" "in")))
+
+           ((looking-at "^[ \t]*of\\b")
+            ;;The line starts with `of'
+            (beginning-of-line)
+            (setq indent (haskell-last-unbalanced-key-column "case" "of")))
+
+           ((looking-at "^.*::")
+            ;;There is a '::' in the line
+            ;;There are several possibilities for indentation
+            (if (looking-at "[ \t]*::")
+                ;;The '::' is the first thing on the line
+                ;; so set indent to be the previous line's
+                ;; indentation plus the standard offset
+                (setq indent (+ (haskell-previous-indentation)
+                                haskell-indent-offset))
+              (save-excursion
+                ;;Otherwise, the '::' is contained in the line somewhere
+                ;; so use contextual indentation
+                (setq indent (haskell-context-indent)))))
+          
+           (t
+            ;;Do not recognise the first word on the line.
+            (setq indent (haskell-context-indent))))
+      
+      indent)))                                ;return indent as indentation value
+
+
+
+;;; Returns the indentation for the current line by looking at the 
+;;; previous line to give clues to the indentation.
+
+(defun haskell-context-indent ()
+  "Returns the indentation for the current line by looking at 
+the previous line to dictate the indentation."
+  (save-excursion
+    (let ((original-position (point))
+         indent)
+      (beginning-of-line)
+      (if (bobp)
+         ;;At the beginning of the buffer
+         (setq indent 0)
+       ;;Otherwise, we are not at the beginning of the buffer
+       (haskell-backward-to-noncomment)
+       (let ((eol-limit (point))
+             ;;Record the (upper) limit for any search on this line
+             bol-limit
+             (paren-indent 'nil))
+         ;;`paren-indent' flags whether we are indenting a list or not
+         (beginning-of-line)
+         (setq bol-limit (point))
+         ;;Record the (lower) limit for any search on this line
+         (goto-char eol-limit) ;goto the end of the line
+         (flag)
+         (if (save-excursion
+               (goto-char eol-limit)
+               (and (re-search-backward
+                     "[])][^][()]*" bol-limit 't)
+                    (save-excursion
+                      (goto-char (match-beginning 0))
+                      (not (haskell-looking-at-keywordp)))))
+                       
+             ;;There is a close parenthesis at the end of the line
+             ;; followed by anything except "(", ")", "[", "]"
+             ;; or a keyword
+             (progn
+               ;;Search back for the close parenthesis
+               ;; and move to just after it.
+               (re-search-backward "[])]" bol-limit 't)
+               (forward-char 1) 
+               (let ((state
+                      (parse-partial-sexp (save-excursion
+                                            (haskell-back-to-zero-indent)
+                                            (point))
+                                          (point))))
+                 (if (not (or (nth 3 state) (nth 4 state)))
+                     ;;Not in a comment or string
+                     (if (>= (car state) 0)
+                         ;;The parenthesis has a match
+                         (progn
+                           (goto-char (nth 2 state))
+                           ;;Move to the beginning of the parentheses
+                           ;; as this new line will determine
+                           ;; further indentation
+                           (if (zerop (car state))
+                               ;;This paren closes all unbalanced parens
+                               ;; so move to
+                               ;; the eol of last line with an equality.
+                               (progn
+                                 (setq eol-limit (point))
+                                 (goto-char
+                                  (max (save-excursion
+                                         (haskell-back-to-symbol "=")
+                                         (point))
+                                       (save-excursion
+                                         (haskell-back-to-keyword)
+                                         (point))))
+                                 (goto-char eol-limit))
+                             ;;esle just go to the end of the line
+                             (goto-char (haskell-eol)))
+                           (setq paren-indent 't)
+                           ;;Set 'paren-indent' to true to indicate we
+                           ;; are indenting a list.
+                           (setq eol-limit (point))
+                           (beginning-of-line) 
+                           (setq bol-limit (point))
+                           ;;Reduce the scope of any later
+                           ;; indentation to
+                           ;; exclude the balanced parentheses
+                           ;; by making this point
+                           ;; be the eol-limit.  
+                           (goto-char eol-limit)))))))
+         (flag)
+         ;;This cond expression is structured, to an 
+         ;; extent, such that the keywords with highest
+         ;; indentation precedence come first.  Order is important.
+         ;;In each condition, the point of match is noted so
+         ;; that we can see if this point is in a string.
+         (let ((indent-point (point)))
+           (cond ((re-search-backward "\\bof\\b" bol-limit 't)
+                  ;; `of' is contained in previous line
+                  (setq indent-point (point))
+                  (if (looking-at "of[ \t]*$")
+                    ;;`of' at end of line
+                      (setq indent (+ (haskell-last-unbalanced-key-column
+                                       "case" "of")
+                                      haskell-case-offset))
+                    ;;Otherwise, `of' is in line
+                    (forward-word 1)
+                    (skip-chars-forward " \t")
+                    (setq indent (current-column))
+                    (setq indent (list indent))))
+                 
+                 ((re-search-backward
+                   "\\bthen[ \t]*$" bol-limit 't)
+                  ;;There is a `then' at the end of the line.
+                  (setq indent-point (point))
+                  (if haskell-align-else-with-then
+                      ;;We want to align the `else' (to follow) with the `then'
+                      (setq indent (+ (current-column)
+                                      haskell-if-offset))
+                    (setq indent (+ (haskell-last-unbalanced-key-column 
+                                     "if" "then")      
+                                    haskell-if-offset))))
+                 ;; This was here but don't know why (setq indent (list indent))))
+                 
+                 ((save-excursion
+                    (and (re-search-backward "\\bif\\b" bol-limit 't)
+                         (setq indent-point (point))
+                         (not (re-search-forward "\\bthen\\b" eol-limit 't))))
+                  ;;There is an `if' on the (previous) line and the line does
+                  ;; not have a `then' on it.
+                  (setq indent (+ (haskell-last-unbalanced-key-column 
+                                   "if" "then")
+                                  haskell-then-offset)))
+                 
+                 ((save-excursion
+                    (and (re-search-backward "\\bif\\b" bol-limit 't)
+                         (setq indent-point (point))
+                         (not (re-search-forward "\\belse\\b" eol-limit 't))))
+                  ;;There is an `if' on the (previous) line (the line may
+                  ;; have a `then' on it) and does not have an else on it.
+                  (if (re-search-backward "\\bthen\\b" bol-limit 't)
+                      ;;There is a then on the line and it is followed by
+                      ;; some code.
+                      (progn
+                        (forward-word 1)
+                        (skip-chars-forward " \t")
+                        (setq indent (current-column)))
+                    (if haskell-align-else-with-then
+                        ;;We want to align the `else' with the `then'
+                        (setq indent (haskell-last-unbalanced-key-column 
+                                      "then" "else"))  
+                      (setq indent (haskell-last-unbalanced-key-column 
+                                    "if" "else")))))
+                 
+                 ((re-search-backward "\\b\\(let\\|in\\)\\b" bol-limit 't)
+                  ;; 'let' or 'in' is contained in the (previous) line
+                  (setq indent-point (point))
+                  (forward-word 1) ;skip past the word
+                  (skip-chars-forward " \t{")
+                  (if (looking-at "\\($\\|--\\)")
+                      ;;looking-at eol or comment
+                      (progn
+                        (forward-word -1)
+                        (setq indent (+ (current-column)
+                                        haskell-let-offset)))
+                    (setq indent (current-column))))
+                 
+                 ((re-search-backward
+                   "\\belse[ \t]*$" bol-limit 't)
+                  ;;There is a `else' at end of line
+                  (setq indent-point (point))
+                  (save-excursion
+                    (goto-char eol-limit)
+                    (forward-word -1)
+                    (setq indent (+ (current-column)
+                                    haskell-if-offset))))
+                 
+                 ((re-search-backward
+                   "\\belse\\b" bol-limit 't)
+                  ;;There is a `else' on the line with no if or then
+                  (setq indent-point (point))
+                  (save-excursion
+                    (forward-word 1)
+                    (skip-chars-forward " \t")
+                    (setq indent (current-column))))
+                 
+                 ((save-excursion
+                    (beginning-of-line)
+                    (looking-at 
+                     "^[ \t]*then\\b"))
+                  ;;There is a 'then' at beginning of line
+                  (setq indent-point (point))
+                  (setq indent (current-indentation)))
+                 
+                 ((save-excursion
+                    (beginning-of-line)
+                    (looking-at "^[ \t]*else[ \t]*if\\b"))
+                  (setq indent-point (point))
+                  ;;There is an 'else if' at start of (previous) line
+                  (save-excursion
+                    (beginning-of-line)
+                    (if haskell-nest-ifs
+                        (save-excursion
+                          (forward-word 1)
+                          (skip-chars-forward " \t")
+                          (setq indent (current-column)))
+                      (skip-chars-forward " \t")
+                      (setq indent (current-column)))))
+                 
+                 ((re-search-backward "\\bcase\\b" bol-limit 't)
+                  ;;There is a 'case' on the previous line
+                  ;; so copy this line's indentation and add on
+                  ;; the offset unless there is not an of.
+                  (setq indent-point (point))
+                  (setq indent (+ (current-column) 
+                                  haskell-case-offset)))
+                 
+                 ((save-excursion
+                    (beginning-of-line)
+                    (looking-at "^\\(instance\\|class\\)\\b"))
+                  ;;This (previous) line has an 'instance' or 'class' at start
+                  ;; so just set indentation to be this line indentation
+                  ;; plus the standard offset
+                  (setq indent-point (point))
+                  (setq indent (+ (current-indentation)
+                                  haskell-indent-offset)))
+                 
+                 ((re-search-backward "where\\b" bol-limit 't)
+                  ;;There is a 'where' on the (previous) line
+                  (setq indent-point (point))
+                  (if (looking-at "where[ \t]*$")
+                      ;;There is nothing after the 'where'
+                      ;; so set indent to be this column
+                      ;; (ie. the column of the 'w')
+                      ;; plus the standard offset
+                      (if (save-excursion
+                            (skip-chars-backward " \t")
+                            (bolp))
+                          ;;The 'where' is the only thing on the line.
+                          (setq indent (+ (current-column) 
+                                          haskell-where-offset))
+                        ;;Otherwise, the 'where' is at the end
+                        ;; of the line and there is code before it.
+                        ;;Look before the 'where' for the symbol
+                        ;; it scopes over.
+                        (forward-word -1)
+                        (goto-char (max (save-excursion
+                                          (haskell-back-to-symbol "=")
+                                          (point))
+                                        (save-excursion
+                                          (haskell-back-to-symbol "->")
+                                          (point))))
+                        (setq indent (haskell-indent-where)))
+                    
+                    ;;Otherwise, go past the 'where'
+                    ;; and goto the last non space character.
+                    ;;Set this column to be the indentation.
+                    (forward-word 1) 
+                    (skip-chars-forward " \t") 
+                    (setq indent (current-column))))   
+                 
+                 ((re-search-backward
+                   "[ \ta-z0-9A-Z]=[ \t]*$" bol-limit 't)
+                  ;;There is an equals is at the end of line
+                  ;; so make the indentation be this line's indentation
+                  ;; plus the standard offset
+                  (setq indent-point (point))
+                  (setq indent (+ (current-indentation)
+                                  haskell-indent-offset))) 
+                 
+                 ((re-search-backward
+                   "[ \ta-z0-9A-Z]\\+\\+[ \t]*$" bol-limit 't)
+                  ;;There is a concat operator at the end of line
+                  ;; so make the indentation be this line's indentation
+                  (setq indent-point (point))
+                  (setq indent (current-indentation)))
+                 
+                 ((save-excursion
+                    (beginning-of-line)
+                    (looking-at
+                     "^[ \t]*=[ \ta-z0-9A-Z]"))
+                  ;;There is an equals is at the beginning of line
+                  ;; so make the indentation be the previous line's
+                  ;; indentation unless the previous line's
+                  ;; indentation is zero.
+                  (setq indent-point (point))
+                  (save-excursion
+                    (haskell-backward-to-noncomment)
+                    (if (zerop (current-indentation))
+                        (setq indent (+ (current-indentation)
+                                        haskell-indent-offset))
+                      (setq indent (haskell-current-indentation)))))
+                 
+                 ((re-search-backward "|" bol-limit 't)
+                  ;;There is  an `|' on this line.
+                  (setq indent-point (point))
+                  (if (save-excursion
+                        (goto-char original-position)
+                        (looking-at "^[ \t]*\\($\\|--\\||\\)"))
+                      ;;The original line is empty or has a `|' at the 
+                      ;; start.  So set indent to be first `|' on this line
+                      (save-excursion
+                        (goto-char bol-limit)
+                        (re-search-forward "|" eol-limit 't)
+                        (setq indent (1- (current-column))))
+                    ;;Otherwise set indent to be this (previous) line's
+                    (setq indent 0)))
+                 
+                 ((re-search-backward "->" bol-limit 't)
+                  ;;There is a `->' in the line.
+                  ;;This may be from a `case' or a
+                  ;; type declaration.
+                  (setq indent-point (point))
+                  (save-excursion
+                    (if (re-search-backward "::" bol-limit 't)
+                        ;;There is a '::' on this line
+                        (if (looking-at ".*->[ \t]*$")
+                            ;;The '->' is at the end of line.
+                            ;;Move past the '::' and any spaces
+                            ;; and set indent to be this column.
+                            (progn
+                              (skip-chars-forward ": \t") 
+                              (setq indent (current-column)))
+                          ;;Otherwise, the '->' is not at end of line
+                          ;; so copy the indentation
+                          (setq indent (haskell-context-indent)))
+                      
+                      ;;Otherwise, there is not a
+                      ;; `::' on this line so copy this
+                      ;; (previous) indentation.
+                      (setq indent (haskell-context-indent)))))
+                 
+                 ((re-search-backward "::" bol-limit 't)
+                  ;;There is  an '::' on this line.
+                  ;;We know that the line does not end with '->'.
+                  (setq indent-point (point))
+                  (if (looking-at "::[ \t]*$")
+                      ;;The '::' is at the end of the line
+                      ;; so set indent to be this line's
+                      ;; indentation plus the offset.
+                      (setq indent (+ (current-indentation) 
+                                      haskell-indent-offset))
+                    ;;Otherwise the `::' is in the line
+                    (setq indent (current-indentation))))
+                 
+                 ((re-search-backward
+                   "\\b\\(import\\|class\\)\\b"
+                   bol-limit 't)
+                  ;;There is an `import' or `class' on the line.
+                  ;;Copy this indentation.
+                  (setq indent-point (point))
+                  (setq indent (current-indentation)))
+                 
+                 ((or
+                   (haskell-looking-at-eqp)
+                   (save-excursion
+                     (beginning-of-line)
+                     (looking-at "^[ \t]*$")))
+                  ;;There is an '=' on the line
+                  ;; or it is blank
+                  (setq indent-point (point))
+                  (cond ((save-excursion
+                           (beginning-of-line)
+                           (looking-at "^[ \t]*data\\b"))
+                         ;;`data' at start of line
+                         ;; so expect a `|'
+                         (haskell-back-to-symbol "=")
+                         (setq indent (current-column)))
+                        ((zerop (current-indentation))
+                         ;;If the indentation is zero, we expect a `where'
+                         (goto-char eol-limit)
+                         (haskell-back-to-symbol "=")
+                         (setq indent (haskell-indent-where)))
+                        ((looking-at "^[ \t]*=[ \t\na-z0-9A-Z]")
+                         ;;The equality is the first thing on the line
+                         ;; so copy the last lines indentation
+                         (save-excursion
+                           (haskell-backward-to-noncomment)
+                           (setq indent (current-indentation))))
+                        (t
+                         ;;Otherwise, copy the indentation
+                         (setq indent (current-indentation)))))
+                 
+                 ((save-excursion
+                    (beginning-of-line)
+                    (and (zerop (current-indentation))
+                         (not (looking-at "^[ \t]*$"))))
+                  ;;The line is not blank and its indentation is zero
+                  ;;It is a function definition.  We know that 
+                  ;; there is not an equals on the line
+                  (goto-char eol-limit)
+                  ;;We expect a keyword
+                  ;; so set indent to be this line's indentation
+                  ;; plus the offset
+                  (setq indent-point (point))
+                  (setq indent (+ (current-indentation)
+                                  haskell-indent-offset)))
+                 
+                 ((bobp)
+                  ;;At the beginning of buffer
+                  (setq indent 0))
+                 
+                 (paren-indent
+                  ;;We are indenting a list and none
+                  ;; of the above indentations are applicable
+                  ;; so copy the indentation of this line
+                  (setq indent (current-indentation)))
+                 
+                 (t
+                  (save-excursion
+                    (setq indent (haskell-context-indent)))))
+
+           (if (nth 3 (parse-partial-sexp
+                       (save-excursion
+                         (goto-char indent-point)
+                         (haskell-back-to-zero-indent)
+                         (point))
+                       (save-excursion
+                         (goto-char indent-point))))
+               ;;The point we determined indentation at is in a
+               ;; string so go to this point and go back one line to
+               ;; find indentation.
+               (setq indent (haskell-context-indent))))
+         
+         
+         ;;HOWEVER, we may have to override any indentation if we are in
+         ;; an unbalanced parenthesis (on the original line).
+         (flag)
+         (save-excursion
+           (goto-char original-position)
+           (let* ((eq-point (save-excursion
+                              (haskell-back-to-symbol "=")
+                              (point)))
+                  (state (parse-partial-sexp
+                          eq-point
+                          (point))))
+             (if (> (car state) 0)
+                 ;;There is an unbalanced parenthesis between
+                 ;; the function and here.
+                 (if (not (or (nth 3 state) (nth 4 state)))
+                     ;;We are not in a string or comment
+                     ;; so goto the parenthesis
+                     (progn
+                       (goto-char (nth 1 state))
+                       (if (not (haskell-keyword-in-regionp
+                                 (point)
+                                 original-position))
+                           ;;There is not a keyword after the open
+                           ;; bracket so we override the indentation
+                           (progn
+                             (if (not (looking-at "{"))
+                                 ;;The parenthesis is not a `{'
+                                 (if (or (looking-at "\\[")
+                                         (save-excursion
+                                           (goto-char (haskell-eol))
+                                           (skip-chars-backward " \t")
+                                           (and
+                                            (char-equal (preceding-char) ?,)
+                                            (= (car state)
+                                               (car (parse-partial-sexp
+                                                     eq-point
+                                                     (point)))))))
+                                     ;;The paren is a square one
+                                     ;; or it is a tuple.
+                                     ;;Don't ignore what is after it.
+                                     (setq indent (haskell-list-align (haskell-eol)))
+                                   ;;Otherwise, ignore what comes after it.
+                                   (setq indent (haskell-list-align (point))))))))))))
+         ))
+      
+      indent)))
+  
+
+;;; Inserts the close parenthesis and reindents the line.
+;;; We want to reindent the line if the parenthesis is 
+;;; the first character on the line.  The parenthesis
+;;; recognised by this function are `]', `}'.
+
+(defun electric-haskell-brace ()
+  "Inserts the character `]' or `}' and reindents the current line."
+  "Insert character and correct line's indentation."
+  (interactive)
+  (if (save-excursion
+       (skip-chars-backward " \t")
+       (bolp))
+      ;;The parenthesis is at the beginning of the line.
+      (progn
+        (insert last-command-char)
+       (haskell-indent-line))
+    ;;Otherwise it is not at the beginning of line.
+    (insert last-command-char))
+  ;; Match its beginning.
+  (haskell-blink-open))
+
+
+
+
+;;; This function returns the indentation for the next line given
+;;; that it is contained in a bracket or we are extending a functions
+;;; parameters over a line.  For the case of being in an unbalanced
+;;; parenthesis list, the point lies on the unbalanced parenthesis.
+;;; The parameter eol-limit is used to delimit the end of the line.
+
+(defun haskell-list-align (eol-limit)
+  "Returns the indentation for the next line given that
+the point lies on an unbalanced open parenthesis."
+  (save-excursion
+    (let ((indent (1+ (current-column))))
+      ;;Set indent to be the next char (at least).
+
+      (cond ((not 
+             (looking-at ".[ \t]*\\($\\|--\\)"))
+            ;;There is something after the parenthesis
+            ;;ie. the line is not empty and ignore comments
+            (cond ((save-excursion
+                     (goto-char eol-limit)
+                     (skip-chars-backward " \t")
+                     (and (char-equal (preceding-char) ?,)
+                          (save-excursion
+                            (beginning-of-line)
+                            (not (search-forward "|" eol-limit 't)))))
+                   ;;This is a normal list since a `,' at end
+                   ;; and there is no a `|' on the line.
+                   (forward-char 1)
+                   (skip-chars-forward " \t")
+                   (setq indent (current-column)))
+
+                  ((looking-at "\\[")
+                   ;;It is a list comp we are looking at
+                   ;;Goto the bar.
+                   (forward-char 1)    
+                   (search-forward "|" eol-limit 't)
+                   (skip-chars-forward " \t")
+                   (setq indent (current-column)))
+         
+                  ((looking-at ".[ \t]*(")
+                   ;;We are looking at an open parenthesis
+                   ;; after this character.
+                   ;;It must be balanced so 
+                   ;; move to the start of this paren
+                   ;; and set indent to be here
+                   (forward-char 1) 
+                   (skip-chars-forward " \t")
+                   (setq indent (current-column)))
+                  
+                  (t
+                   (forward-word 1)
+                   ;;We are not looking at another open
+                   ;; parenthesis, so move forward past the
+                   ;; (assumed) function name.
+                   (if (or
+                        haskell-std-list-indent
+                        (looking-at"[ \t]*\\($\\|--\\)"))
+                       ;;There is nothing after the name
+                       ;; or haskell-std-list-offset is set
+                       ;; so set indent to be its original
+                       ;; value plus the offset minus 1
+                       ;; since we added one on earlier.
+                       (setq indent
+                             (+ indent
+                                (1- haskell-list-offset)))
+                     
+                     ;;Otherwise there is something after the
+                     ;; name, so skip to the first non space
+                     ;; character.
+                     (skip-chars-forward " \t")
+                     (setq indent (current-column)))))))
+
+
+      indent)))
+
+
+
+(defun haskell-insert-round-paren ()
+  "Inserts a `(' and blinks to its matching parenthesis."
+  (interactive)
+  (insert last-command-char)
+  (haskell-blink-open))
+
+
+
+;;; This function is called when a close parenthesis 
+;;; `)', `]', or `}' is typed.
+;;; Blinks the cursor on the corresponding open parnethesis.
+;;; The point lies just after the close parenthesis.
+
+(defun haskell-blink-open ()
+  "Blinks the cursor to the matching open parenthesis.
+The point lies just after a parenthesis."
+  (let ((state (parse-partial-sexp (point)
+                                  (save-excursion
+                                    (haskell-back-to-zero-indent)
+                                    (point)))))
+    (if (and
+        (>= (car state) 0)
+        (not (or (nth 3 state) (nth 4 state))))
+       ;;The parenthesis just inserted has a match
+       ;; and is not in a string or a comment
+       ;; so blink on its match
+       (save-excursion
+         (goto-char (nth 2 state))
+         (sit-for 1)))))
+
+
+
+;;; This function indents the line expecting the line to be a 
+;;; continued function application.
+
+;;;   foo a = bar a
+;;;               b     {haskell-further-indent applied to this line
+;;;                      indents the line as shown}
+
+;;; The line would look like this if only tab had been applied:
+;;;   foo a = bar a
+;;;         b
+
+(defun haskell-further-indent ()
+  "Indents the line more than the ordinary indentation in order to 
+extend function arguments over multiple lines."
+  (interactive)
+  (let (indent
+       (new-point (max (save-excursion
+                         (haskell-back-to-symbol "=")
+                         (point))
+                       (save-excursion
+                         (haskell-back-to-keyword)
+                         (point)))))
+    (save-excursion
+      ;;This may be a continuation of a function
+      ;; application so go back to the last '='
+      ;; and set indent as designated by the style chosen
+      (goto-char new-point)
+      (skip-chars-forward "= \t")
+      (setq indent (haskell-list-align (haskell-eol))))
+    ;;The argument to haskell-list-align is not important here.
+    (save-excursion
+      (beginning-of-line)
+      (delete-horizontal-space)
+      (indent-to indent))
+    (if (< (current-column) indent)
+       (move-to-column indent))))
+
+
+;;; This function indents the current line to the first previous
+;;; indentation value which is less than the current indentation.
+
+(defun haskell-lesser-indent ()
+  "Indents the current line to the first previous indentation
+value which is less than the current indentation."
+  (interactive)
+  (let ((original-indent
+        (current-indentation))
+       (indent (haskell-context-indent))
+       (done nil))
+    (save-excursion
+      (while (not done)
+       (while (and (not (bobp))
+                   (not (zerop (current-indentation)))
+                   (>= indent original-indent))
+         (haskell-backward-to-noncomment)
+         (setq indent (current-indentation)))
+       ;;bobp or indent < original-indent
+       (if (>=  indent original-indent)
+           ;;indent is still greater than or equal to original indent
+           (progn 
+             (setq indent 0)
+             (setq done t))
+         ;;Otherwise, indent is less than orignal indent.
+         (forward-line 1)
+         (setq indent (haskell-context-indent))
+         (if (< indent original-indent)
+             ;;The new indent is an improvement
+             (setq done t)
+           ;;Otherwise, indent is still >= original
+           ;; so go back to the line and keep typing.
+           (forward-line -1)))))
+    (save-excursion
+      (beginning-of-line)
+      (delete-horizontal-space)
+      (indent-to indent))
+    (if (< (current-column) indent)
+       (move-to-column indent))))
+
+      
+
+;;; Here are the functions which change the local variables
+;;; to facilitate tailorability.
+
+(defun default-mode ()
+  "Calls the function haskell-mode."
+  (interactive)
+  (haskell-mode)
+  (message haskell-indent-style))
+
+(defun wadler-mode ()
+  "Sets defaults according to Dr. Philip L. Wadler's preferences.
+   - Aligns `where' clauses with the corresponding equality.
+   - Aligns `else' keyword with the corresponding `then'
+   - haskell-list-offset 2
+   - haskell-indent-offset 8
+   - haskell-if-indent   2
+   - haskell-comment-column 0
+   - haskell-case-offset 2
+   - haskell-let-offset  5."
+  ;;Preferences:
+  ;;'haskell-align-where-with-eq  non-nil
+  ;;'haskell-list-offset 2
+  (interactive)
+  (haskell-mode)
+  (or haskell-align-where-with-eq
+      (progn
+       (setq haskell-align-where-with-eq t)
+       (setq haskell-std-indent-where nil)))
+  (setq haskell-align-else-with-then t)
+  (setq haskell-list-offset 2)
+  (setq haskell-indent-offset 8)
+  (setq haskell-if-offset 2)
+  (setq haskell-case-offset 2)
+  (setq haskell-let-offset 5)
+  (setq haskell-comment-column 0)
+  (setq haskell-indent-style "Wadler")
+  (message haskell-indent-style))
+             
+
+(defun report-mode ()
+  "Sets defaults according to the style of the Haskell Report.
+   - Aligns `where' clauses after the corresponding equality.
+   - Aligns `else' with `then'.
+   - haskell-then-offset   = 3
+   - haskell-where-offset  = 0.
+   - haskell-case-offset   = 5."
+  ;;Preferences:
+  ;; haskell-align-where-after-eq  non-nil
+  ;; haskell-then-offset  3
+  ;; haskell-where-offset 0
+  ;; haskell-case-offset  5
+  (interactive)
+  (haskell-mode)
+  (haskell-align-where-after-eq)
+  (or haskell-align-else-with-then
+      (haskell-align-else-with-then))
+  (setq haskell-then-offset 3)
+  (setq haskell-where-offset 0)
+  (setq haskell-case-offset 5)
+  (setq haskell-indent-style "Report")
+  (message haskell-indent-style))
+             
+
+(defun haskell-align-where-with-eq ()
+  "Sets indentation so that a 'where' clause lines up underneath
+its corresponding equals sign."
+  (interactive)
+  (or haskell-align-where-with-eq
+      (progn
+       (setq haskell-align-where-after-eq nil)
+       (setq haskell-std-indent-where nil)
+       (setq haskell-align-where-with-eq t)
+       haskell-align-where-with-eq)))
+
+
+
+(defun haskell-align-where-after-eq ()
+  "Sets indentation so that a 'where' clause lines up underneath
+the first nonspace character after its corresponding equals sign."
+  (interactive)
+  (or haskell-align-where-after-eq
+      (progn
+       (setq haskell-align-where-with-eq nil)
+       (setq haskell-std-indent-where nil)
+       (setq haskell-align-where-after-eq t)
+       haskell-align-where-after-eq)))
+
+
+(defun haskell-std-indent-where ()
+  "Sets indentation so that a `where' clause lines up underneath
+its corresponding equals sign."
+  (interactive)
+  (or haskell-std-indent-where
+      (progn
+       (setq haskell-align-where-after-eq nil)
+       (setq haskell-align-where-with-eq nil)
+       (setq haskell-std-indent-where t)
+       haskell-std-indent-where)))
+
+
+(defun haskell-align-else-with-then ()
+  "Sets indentation so that an `else' lines up underneath
+it's corresponding `then'."
+  (interactive)
+  (setq haskell-align-else-with-then
+       (not haskell-align-else-with-then))
+  (setq haskell-nest-ifs nil))
+
+(defun haskell-nest-ifs ()
+  "Sets indentation so that an `if' is lined up
+under an `if' in an `else ."
+  (interactive)
+  (setq haskell-nest-ifs
+       (not haskell-nest-ifs))
+  (setq haskell-align-else-with-then nil))
+
+
+(defun haskell-always-fixup-comment-space ()
+  "Non-nil means always position one space after a line comment `--',
+when reindenting or inserting a comment,
+whether or not one space exists."
+  (setq haskell-always-fixup-comment-space
+       (not haskell-always-fixup-comment-space))
+  haskell-always-fixup-comment-space)
+
+(defun haskell-indent-style ()
+  "Echos the chosen indentation style in the mini-buffer."
+  (interactive)
+  (message haskell-indent-style))
+
+(defun set-haskell-let-offset (offset)
+  "Changes the value of haskell-let-offset, the variable which
+determines extra indentation after a `let' and  `in'."
+  (interactive "nSet haskell-let-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-let-offset offset)))
+
+(defun set-haskell-if-offset (offset)
+  "Changes the value of haskell-let-offset, the variable which
+determines extra indentation after an `if', `then' and `else'."
+  (interactive "nSet haskell-if-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-if-offset offset)))
+
+(defun set-haskell-case-offset (offset)
+  "Changes the value of haskell-case-offset, the variable which
+determines extra indentation after a `case' and `of'."
+  (interactive "nSet haskell-case-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-case-offset offset)))
+
+
+(defun set-haskell-where-offset (offset)
+  "Changes the value of haskell-where-offset, the variable which
+determines extra indentation after a line of haskell code."
+  (interactive "nSet haskell-where-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-where-offset offset)))
+
+
+(defun set-haskell-indent-offset (offset)
+  "Changes the value of haskell-indent-offset, the variable which
+determines extra indentation after a line of haskell code."
+  (interactive "nSet haskell-indent-offset to: ")
+  (if (and (>= offset 1) (<= offset 10))
+      (setq haskell-indent-offset offset)))
+
+
+(defun set-haskell-list-offset (offset)
+  "Changes the value of haskell-list-offset, the variable which
+determines extra indentation after a line of haskell code for a list."
+  (interactive "nSet haskell-list-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-list-offset offset)))
+
+
+(defun set-haskell-comp-offset (offset)
+  "Changes the value of haskell-comp-offset, the variable which
+determines extra indentation after a list comprehension."
+  (interactive "nSet haskell-comp-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-comp-offset offset)))
+
+
+(defun set-haskell-then-offset (offset)
+  "Changes the value of haskell-then-offset, the variable which
+determines extra indentation for a `then' keyword after an `if'."
+  (interactive "nSet haskell-then-offset to: ")
+  (if (and (>= offset 0) (<= offset 10))
+      (setq haskell-then-offset offset)))
+
+
+(defun set-haskell-comment-column (column)
+  "Changes the value of haskell-comment-column, the variable which
+determines where to postition a line comment `--'."
+  (interactive "nSet haskell-comment-column to: ")
+  (if (and (>= column 0) (<= column 100))
+      (setq haskell-comment-column column)))
+        
+(defun set-haskell-concat-column (column)
+  "Changes the value of haskell-concat-column, the variable which
+determines where to postition a concatenation operator `++'."
+  (interactive "nSet haskell-concat-column to: ")
+  (if (and (>= column 0) (<= column 100))
+      (setq haskell-concat-column column)))
+        
+(defun set-haskell-where-threshold (column)
+  "Changes the value of haskell-where-threshold, the variable which
+determines when to override positioning a `where' under or after
+its corresponding equality."
+  (interactive "nSet haskell-where-threshold to: ")
+  (if (and (>= column 0) (<= column 100))
+      (setq haskell-where-threshold column)))
+        
+(defun flag ())
\ No newline at end of file
diff --git a/ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi b/ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi
new file mode 100644 (file)
index 0000000..616b0fc
Binary files /dev/null and b/ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi differ
diff --git a/ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi b/ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi
new file mode 100644 (file)
index 0000000..5f7aaeb
Binary files /dev/null and b/ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi differ
diff --git a/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el
new file mode 100644 (file)
index 0000000..c1dd5f1
--- /dev/null
@@ -0,0 +1,201 @@
+;;; Haskell mode for emacs (c) Simon Marlow 11/1/92
+
+(defvar haskell-mode-map ()
+  "Keymap used in Haskell mode.")
+
+(defvar haskell-literate-mode-map ()
+  "Keymap used in Haskell literate script mode.")
+
+(defvar haskell-mode-syntax-table ()
+  "Syntax table for haskell mode.")
+
+(if haskell-mode-map
+    ()
+  (setq haskell-mode-map (make-sparse-keymap))
+  (define-key haskell-mode-map "\C-j" 'haskell-newline-and-indent))
+
+(if haskell-literate-mode-map
+    ()
+  (setq haskell-literate-mode-map (make-sparse-keymap))
+  (define-key haskell-literate-mode-map "\C-j" 
+    'haskell-literate-newline-and-indent)
+  (define-key haskell-literate-mode-map "\M-\C-i" 
+    'haskell-literate-toggle-bird-track-line)
+  (define-key haskell-literate-mode-map "\M-m" 
+    'haskell-literate-back-to-indentation))
+
+
+(if haskell-mode-syntax-table
+    ()
+  (let ((i 0))
+    (setq haskell-mode-syntax-table (make-syntax-table))
+;    (while (< i ?0)
+;      (modify-syntax-entry i "." haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+;    (while (< i (1+ ?9))
+;      (modify-syntax-entry i "_" haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+;    (while (< i ?A)
+;      (modify-syntax-entry i "." haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+;    (while (< i (1+ ?Z))
+;      (modify-syntax-entry i "w" haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+;    (while (< i ?a)
+;      (modify-syntax-entry i "." haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+;    (while (< i (1+ ?z))
+;      (modify-syntax-entry i "w" haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+;    (while (< i 128)
+;      (modify-syntax-entry i "." haskell-mode-syntax-table)
+;      (setq i (1+ i)))
+    (modify-syntax-entry ?   " " haskell-mode-syntax-table)
+    (modify-syntax-entry ?\t " " haskell-mode-syntax-table)
+    (modify-syntax-entry ?\f "> b"    haskell-mode-syntax-table)
+    (modify-syntax-entry ?\n "> b"    haskell-mode-syntax-table)
+    (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\' "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?_  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\\ "." haskell-mode-syntax-table)
+    (modify-syntax-entry ?\( "()" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\[ "(]" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\] ")[" haskell-mode-syntax-table)
+    (modify-syntax-entry ?{  "(}1" haskell-mode-syntax-table)
+    (modify-syntax-entry ?}  "){4" haskell-mode-syntax-table)
+    (modify-syntax-entry ?-  ". 12b" haskell-mode-syntax-table)
+    ))
+
+(defun haskell-vars ()
+  (kill-all-local-variables)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'comment-start)
+  (setq comment-start "--")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "--[^a-zA-Z0-9]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'haskell-comment-indent)
+  ;(make-local-variable 'font-lock-keywords)
+  ;(setq font-lock-keywords haskell-literate-font-lock-keywords)
+  )
+
+(defun haskell-mode ()
+  "Major mode for editing Haskell programs.
+Blank lines separate paragraphs, Comments start with '--'. 
+Use Linefeed to do a newline and indent to the level of the previous line.
+Tab simply inserts a TAB character.
+Entry to this mode calls the value of haskell-mode-hook if non-nil."
+  (interactive)
+  (haskell-vars)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell")
+  (use-local-map haskell-mode-map)
+  (set-syntax-table haskell-mode-syntax-table)
+  (run-hooks 'haskell-mode-hook))
+
+(defun haskell-literate-mode ()
+  "Major mode for editing haskell programs in literate script form.
+Linefeed produces a newline, indented maybe with a bird track on it.
+M-TAB toggles the state of the bird track on the current-line.
+Entry to this mode calls haskell-mode-hook and haskell-literate-mode-hook."
+  (interactive)
+  (haskell-vars)
+  (setq major-mode 'haskell-literate-mode)
+  (setq mode-name "Literate Haskell")
+  (use-local-map haskell-literate-mode-map)
+  (set-syntax-table haskell-mode-syntax-table)
+  (run-hooks 'haskell-mode-hook)
+  (run-hooks 'haskell-literate-mode-hook))
+
+;; Find the indentation level for a comment..
+(defun haskell-comment-indent ()
+  (skip-chars-backward " \t")
+  ;; if the line is blank, put the comment at the beginning,
+  ;; else at comment-column
+  (if (bolp) 0 (max (1+ (current-column)) comment-column)))
+
+;; Newline, and indent according to the previous line's indentation.
+;; Don't forget to use 'indent-tabs-mode' if you require tabs to be used
+;; for indentation.
+(defun haskell-newline-and-indent ()
+  (interactive)
+  (newline)
+  (let ((c 0))
+    (save-excursion
+      (forward-line -1)
+      (back-to-indentation)
+      (setq c (if (eolp) 0 (current-column))))
+    (indent-to c)))                    ;ident new line to this level
+
+;;; Functions for literate scripts
+
+;; Newline and maybe add a bird track, indent
+(defun haskell-literate-newline-and-indent ()
+  (interactive)
+  (newline)
+  (let ((bird-track nil) (indent-column 0))
+    (save-excursion
+      (forward-line -1)
+      (if (= (following-char) ?>) (setq bird-track t))
+      (skip-chars-forward "^ \t")
+      (skip-chars-forward " \t")
+      (setq indent-column (if (eolp) 0 (current-column))))
+    (if bird-track (insert-char ?> 1))
+    (indent-to indent-column)))
+
+;; Toggle bird-track ][ 
+(defun haskell-literate-toggle-bird-track-line ()
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (if (= (following-char) ? )
+       (progn (delete-char 1) (insert-char ?> 1))
+      (if (= (following-char) ?>)
+         (progn (delete-char 1) (insert-char ?  1))
+       (progn (insert-char ?> 1) (insert-char ?  1))))))
+
+(defun haskell-literate-toggle-bird-track-region (start end)
+  (interactive "r") 
+  (save-excursion 
+    (goto-char start) 
+    (while (<= (point) end) 
+      (beginning-of-line)
+      (haskell-literate-toggle-bird-track-line)
+      (forward-line 1))))
+
+(defun haskell-literate-back-to-indentation ()
+  (interactive)
+  (beginning-of-line)
+  (if (= (following-char) ?>) 
+      (forward-char 1))
+  (skip-chars-forward " \t"))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; keywords for jwz's font-look-mode (lemacs 19)
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar haskell-literate-font-lock-keywords ()
+  "Font definitions for Literate Haskell files.")
+
+(setq haskell-literate-font-lock-keywords
+      (list
+       '("^[^>\n].*$" . font-lock-comment-face)
+       (concat "\\b\\("
+                   (mapconcat 'identity 
+                              '("case" "class" "data" "default" "deriving" "else" "hiding"
+                                "if" "import" "in" "infix" "infixl" "infixr" "instance"
+                                "interface" "let" "module" "of" "renaming" "then" "to"
+                                "type" "where")
+                              "\\|")
+                   "\\)\\b")
+       ))
+
diff --git a/ghc/CONTRIB/haskell-modes/yale/chak/haskell.el b/ghc/CONTRIB/haskell-modes/yale/chak/haskell.el
new file mode 100644 (file)
index 0000000..4470553
--- /dev/null
@@ -0,0 +1,1866 @@
+;;; ==================================================================
+;;; File:              haskell.el                                 ;;;
+;;;                                                                ;;;
+;;;                    Author:         A. Satish Pai              ;;;
+;;;                                     Maria M. Gutierrez         ;;;
+;;;                                     Dan Rabin (Jul-1991)       ;;;
+;;; ==================================================================
+;;; Time-stamp: <Sat Oct  7 1995 17:48:39 Stardate: [-31]6403.50 hwloidl>
+;;; ==================================================================
+;;;
+;;; extended by Manuel M.T. Chakravarty with rudimentary editing features 
+;;; (including better syntax table) and support for the font-lock-mode; 
+;;; changes are marked with !chak!
+;;;
+;;; using this mode on a 19.x Emacs running under a window system automagically
+;;; applies the font-lock-mode; this feature can be switched off by setting 
+;;; `haskell-auto-font-lock' to `nil'
+
+;;; Description: Haskell mode for GNU Emacs.
+
+;;; Related files:  comint.el
+
+;;; Contents:
+
+;;;  Update Log
+
+;;;  Known bugs / problems
+;;;  - the haskell editing mode (indentation, etc) is still missing.
+;;;  - the handling for errors from haskell needs to be rethought.
+;;;  - general cleanup of code.
+
+
+;;;  Errors generated
+
+;;; ==================================================================
+;;; Haskell mode for editing files, and an Inferior Haskell mode to
+;;; run a Haskell process. This file contains stuff snarfed and 
+;;; modified from tea.el, scheme.el, etc. This file may be freely
+;;; modified; however, if you have any bug-corrections or useful
+;;; improvements, I'd appreciate it if you sent me the mods so that
+;;; I can merge them into the version I maintain.
+;;;
+;;; The inferior Haskell mode requires comint.el. 
+;;; 
+;;; You might want to add this to your .emacs to go automagically
+;;; into Haskell mode while finding .hs files.
+;;; 
+;;;   (setq auto-mode-alist 
+;;;         (cons '("\\.hs$" . haskell-mode)
+;;;                auto-mode-alist)_)
+;;;
+;;; To use this file, set up your .emacs to autoload this file for 
+;;; haskell-mode. For example:
+;;; 
+;;;    (autoload 'haskell-mode "$HASKELL/emacs-tools/haskell.elc" 
+;;;       "Load Haskell mode" t)
+;;;
+;;;    (autoload 'run-mode "$HASKELL/emacs-tools/haskell.elc" 
+;;;       "Load Haskell mode" t)
+;;;
+;;; [Note: The path name given above is Yale specific!! Modify as
+;;; required.]
+;;; ================================================================
+
+;;; Announce your existence to the world at large.
+
+(provide 'haskell)
+
+
+;;; Load these other files.
+
+(require 'comint)        ; Olin Shivers' comint mode is the substratum
+
+;;; !chak!
+;;;
+(if (and window-system (string-match "19." emacs-version))
+    (require 'font-lock))
+
+
+\f
+;;; ================================================================
+;;; Declare a bunch of variables.
+;;; ================================================================
+
+
+;;; User settable (via M-x set-variable and M-x edit-options)
+
+(defvar haskell-program-name (getenv "HASKELLPROG")
+  "*Program invoked by the haskell command.")
+
+(defvar haskell-auto-create-process t
+  "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code.")
+
+(defvar haskell-auto-switch-input t
+  "*If not nil, jump to *haskell* buffer automatically on input request.")
+
+(defvar haskell-ask-before-saving t
+  "*If not nil, ask before saving random haskell-mode buffers.")
+
+(defvar haskell-initial-printers '("interactive")
+  "*Printers to set when starting a new Haskell process.")
+
+
+;;; Pad/buffer Initialization variables
+
+(defvar *haskell-buffer* "*haskell*"
+  "Name of the haskell process buffer")
+
+(defvar haskell-main-pad "\*Main-pad\*"
+  "Scratch pad associated with module Main")
+
+(defvar haskell-main-module "Main")
+
+
+(defvar *last-loaded* nil)
+(defvar *last-module* haskell-main-module)
+(defvar *last-pad* haskell-main-pad)
+
+
+;;; These are used for haskell-tutorial mode.
+
+(defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.lhs")
+(defvar *ht-temp-buffer* nil)
+(defvar *ht-file-buffer* "Haskell-Tutorial-Master")
+
+;;; !chak! variables for font-lock-mode support
+;;;
+
+(defvar haskell-auto-font-lock t
+  "Use font-lock-mode by default.")
+
+(defvar haskell-font-lock-keywords
+  (list
+   "\\bcase\\b" "\\bclass\\b" "\\bdata\\b" "\\bdefault\\b" "\\bderiving\\b" 
+   "\\belse\\b" "\\bhiding\\b" "\\bif\\b" "\\bimport\\b" "\\bin\\b"
+   "\\binfix\\b" "\\binfixl\\b" "\\binfixr\\b" "\\binstance\\b" 
+   "\\binterface\\b" "\\blet\\b" "\\bmodule\\b" "\\bof\\b" "\\brenaming\\b"
+   "\\bthen\\b" "\\bto\\b" "\\btype\\b" "\\bwhere\\b"
+   ;'("\\S_\\(\\.\\.\\|::\\|=>\\|=\\|@\\||\\|~\\|-\\|<-\\|->\\)\\S_" . 1)
+   '("\\bdata\\b\\s *\\(\\w+\\)\\(\\w\\|\\s \\)*=[^>]" 1 font-lock-type-face)
+   '("\\bdata\\b\\(\\s \\|(\\|)\\|\\w\\)*=>\\s *\n?\\s *\\(\\w+\\)" 2 
+     font-lock-type-face) 
+   '("\\btype\\b\\s *\\(\\w+\\)" 1 font-lock-type-face)
+   '("\\(\\w+\\)\\s *::\\(\\s \\|$\\)" 1 font-lock-function-name-face)
+   '("(\\(\\s_+\\))\\s *::\\(\\s \\|$\\)" 1 font-lock-function-name-face)
+;   '("\\($\\|[^\\\\]\\)\\('[^\\\\]'\\)" 2 font-lock-string-face t)
+   '("\\('\\([^\\\\]\\|\\\\'\\)'\\)" 1 font-lock-string-face t)
+   )
+  "Additional expressions to highlight in Haskell mode.")
+
+
+\f
+;;; ================================================================
+;;; Haskell editing mode stuff
+;;; ================================================================
+
+;;; Leave this place alone...
+;;; The definitions below have been pared down to the bare
+;;; minimum; they will be restored later.
+;;;
+;;; -Satish 2/5.
+
+;;; Keymap for Haskell mode
+(defvar haskell-mode-map (make-sparse-keymap)
+  "Keymap used for haskell-mode")
+
+(defun haskell-establish-key-bindings (keymap)
+  (define-key keymap "\C-ce"    'haskell-eval)
+  (define-key keymap "\C-cr"    'haskell-run)
+  (define-key keymap "\C-ct"    'haskell-report-type)
+  (define-key keymap "\C-cm"    'haskell-run-main)
+  (define-key keymap "\C-c\C-r" 'haskell-run-file)
+  (define-key keymap "\C-cp"    'haskell-get-pad)
+  (define-key keymap "\C-c\C-o" 'haskell-optimizers)
+  (define-key keymap "\C-c\C-p" 'haskell-printers)
+  (define-key keymap "\C-cc"    'haskell-compile)
+  (define-key keymap "\C-cl"    'haskell-load)
+  (define-key keymap "\C-ch"    'haskell-switch)
+  (define-key keymap "\C-c\C-k" 'haskell-kill)
+  (define-key keymap "\C-c:"    'haskell-command)
+  (define-key keymap "\C-cq"    'haskell-exit)
+  (define-key keymap "\C-ci"    'haskell-interrupt)
+  (define-key keymap "\C-cu"    'haskell-edit-unit))
+
+
+(haskell-establish-key-bindings haskell-mode-map)
+
+
+(defvar haskell-mode-syntax-table nil
+  "Syntax table used for haskell-mode")
+
+;; !chak! taken from lisp-mode
+;;
+(defvar haskell-mode-abbrev-table nil 
+  "Abbrev table used for the haskell-mode")
+
+;; !chak! took syntax table from haskell mode distributed with GHC and modified
+;;       it; we treat numbers as parts of words and operators as elements of
+;;       the syntactic class `_'
+;;
+(if haskell-mode-syntax-table
+    ()
+  (let ((i 0))
+    (setq haskell-mode-syntax-table (make-syntax-table))
+    (while (< i ?0)
+      (modify-syntax-entry i "." haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (while (< i (1+ ?9))
+      (modify-syntax-entry i "w" haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (while (< i ?A)
+      (modify-syntax-entry i "." haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (while (< i (1+ ?Z))
+      (modify-syntax-entry i "w" haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (while (< i ?a)
+      (modify-syntax-entry i "." haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (while (< i (1+ ?z))
+      (modify-syntax-entry i "w" haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (while (< i 128)
+      (modify-syntax-entry i "." haskell-mode-syntax-table)
+      (setq i (1+ i)))
+    (modify-syntax-entry ?   " " haskell-mode-syntax-table)
+    (modify-syntax-entry ?\t " " haskell-mode-syntax-table)
+    (modify-syntax-entry ?\n ">" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\f ">" haskell-mode-syntax-table)
+    (modify-syntax-entry ?!  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?#  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?$  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?%  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?&  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?*  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?+  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?.  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?/  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?<  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?=  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?>  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ??  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?@  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?^  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?|  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?~  "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\' "w" haskell-mode-syntax-table)
+    (modify-syntax-entry ?_  "w" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\\ "_" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\( "()" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\[ "(]" haskell-mode-syntax-table)
+    (modify-syntax-entry ?\] ")[" haskell-mode-syntax-table)
+    (modify-syntax-entry ?{  "(}1" haskell-mode-syntax-table)
+    (modify-syntax-entry ?}  "){4" haskell-mode-syntax-table)
+    (modify-syntax-entry ?-  "_ 123" haskell-mode-syntax-table)
+    ))
+
+;; !chak! taken from lisp-mode
+;;
+(define-abbrev-table 'haskell-mode-abbrev-table ())
+
+;; !chak! adapted from lisp-mode
+;;
+(defun haskell-mode-variables (haskell-syntax)
+  (cond (haskell-syntax
+         (set-syntax-table haskell-mode-syntax-table)))
+  (setq local-abbrev-table haskell-mode-abbrev-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'haskell-indent-line)
+;  (make-local-variable 'indent-region-function)
+;  (setq indent-region-function 'haskell-indent-region)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+;  (make-local-variable 'outline-regexp)
+;  (setq outline-regexp ";;; \\|(....")
+  (make-local-variable 'comment-start)
+  (setq comment-start "--")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "-- *")
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+;  (make-local-variable 'comment-indent-function)
+;  (setq comment-indent-function 'haskell-comment-indent)
+  (make-local-variable 'font-lock-keywords)
+  (setq font-lock-keywords haskell-font-lock-keywords)
+  )
+
+;; !chak!
+;;
+(defun haskell-indent-line ()
+  "Simple indentation function using `indent-relative'."
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (delete-horizontal-space)
+    (indent-relative)
+    )
+  )
+
+;;; Command for invoking the Haskell mode
+(defun haskell-mode nil
+  "Major mode for editing Haskell code to run in Emacs
+The following commands are available:
+\\{haskell-mode-map}
+
+A Haskell process can be fired up with \"M-x haskell\". 
+
+Customization: Entry to this mode runs the hooks that are the value of variable 
+haskell-mode-hook.
+
+Windows:
+
+There are 3 types of windows associated with Haskell mode.  They are:
+   *haskell*:  which is the process window.
+   Pad:        which are buffers available for each module.  It is here
+               where you want to test things before preserving them in a
+               file.  Pads are always associated with a module.
+               When issuing a command:
+                 The pad and its associated module are sent to the Haskell
+                 process prior to the execution of the command.
+   .hs:        These are the files where Haskell programs live.  They
+               have .hs as extension.
+               When issuing a command:
+                 The file is sent to the Haskell process prior to the
+                 execution of the command.
+
+Commands:
+
+Each command behaves differently according to the type of the window in which 
+the cursor is positioned when the command is issued .
+
+haskell-eval:   \\[haskell-eval]
+  Always promts user for a Haskell expression to be evaluated.  If in a
+  .hs file buffer, then the cursor tells which module is the current 
+  module and the pad for that module (if any) gets loaded as well.
+
+haskell-run:    \\[haskell-run]
+  Always queries for a variable of type Dialogue to be evaluated.
+
+haskell-run-main:    \\[haskell-run-main]
+  Run Dialogue named main in the current module.
+
+haskell-report-type:   \\[haskell-report-type]
+  Like haskell-eval, but prints the type of the expression without
+  evaluating it.
+
+haskell-mode:   \\[haskell-mode]
+  Puts the current buffer in haskell mode.
+
+haskell-compile:   \\[haskell-compile]
+  Compiles file in current buffer.
+
+haskell-load:   \\[haskell-load]
+  Loads file in current buffer.
+
+haskell-run-file:   \\[haskell-run-file]
+  Runs file in the current buffer.
+
+haskell-pad:   \\[haskell-pad]
+  Creates a scratch pad for the current module.
+
+haskell-optimizers:  \\[haskell-optimizers]
+  Shows the list of available optimizers.  Commands for turning them on/off.
+
+haskell-printers:  \\[haskell-printers]
+  Shows the list of available printers.  Commands for turning them on/off.
+
+haskell-command:   \\[haskell-command]
+  Prompts for a command to be sent to the command interface.  You don't
+  need to put the : before the command.
+
+haskell-quit:   \\[haskell-quit]
+  Terminates the haskell process.
+
+haskell-switch:   \\[haskell-switch]
+  Switches to the inferior Haskell buffer (*haskell*) and positions the
+  cursor at the end of the buffer.
+
+haskell-kill:  \\[haskell-kill]
+  Kill the current contents of the *haskell* buffer.
+  
+haskell-interrupt:   \\[haskell-interrupt]
+  Interrupts haskell process and resets it.
+
+haskell-edit-unit:   \\[haskell-edit-unit]
+  Edit the .hu file for the unit containing this file.
+"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map haskell-mode-map)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell")
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'indent-relative-maybe)
+  ;(setq local-abbrev-table haskell-mode-abbrev-table)
+  (set-syntax-table haskell-mode-syntax-table)
+  ;(setq tab-stop-list haskell-tab-stop-list) ;; save old list??
+  (haskell-mode-variables t)                                    ; !chak!
+  (cond (haskell-auto-font-lock                                        ; !chak!
+        (font-lock-mode 1)                                     ; !chak!
+        ))                                                     ; !chak!
+  (run-hooks 'haskell-mode-hook))
+
+\f
+;;;================================================================
+;;; Inferior Haskell stuff
+;;;================================================================
+
+
+(defvar inferior-haskell-mode-map (copy-keymap comint-mode-map))
+
+(haskell-establish-key-bindings inferior-haskell-mode-map)
+(define-key inferior-haskell-mode-map "\C-m"     'haskell-send-input)
+
+(defvar haskell-source-modes '(haskell-mode)
+  "*Used to determine if a buffer contains Haskell source code.
+If it's loaded into a buffer that is in one of these major modes, 
+it's considered a Haskell source file.")
+
+(defvar haskell-prompt-pattern "^[A-Z]\\([A-Z]\\|[a-z]\\|[0-9]\\)*>\\s-*"
+  "Regular expression capturing the Haskell system prompt.")
+
+(defvar haskell-prompt-ring ()
+  "Keeps track of input to haskell process from the minibuffer")
+
+(defun inferior-haskell-mode-variables ()
+  nil)  
+
+
+;;; INFERIOR-HASKELL-MODE (adapted from comint.el)
+
+(defun inferior-haskell-mode ()
+  "Major mode for interacting with an inferior Haskell process.
+
+The following commands are available:
+\\{inferior-haskell-mode-map}
+
+A Haskell process can be fired up with \"M-x haskell\". 
+
+Customization: Entry to this mode runs the hooks on comint-mode-hook and
+inferior-haskell-mode-hook (in that order).
+
+You can send text to the inferior Haskell process from other buffers containing
+Haskell source.  
+
+
+Windows:
+
+There are 3 types of windows in the inferior-haskell-mode.  They are:
+   *haskell*:  which is the process window.
+   Pad:        which are buffers available for each module.  It is here
+               where you want to test things before preserving them in a
+               file.  Pads are always associated with a module.
+               When issuing a command:
+                 The pad and its associated module are sent to the Haskell
+                 process prior to the execution of the command.
+   .hs:        These are the files where Haskell programs live.  They
+               have .hs as extension.
+               When issuing a command:
+                 The file is sent to the Haskell process prior to the
+                 execution of the command.
+
+Commands:
+
+Each command behaves differently according to the type of the window in which 
+the cursor is positioned when the command is issued.
+
+haskell-eval:   \\[haskell-eval]
+  Always promts user for a Haskell expression to be evaluated.  If in a
+  .hs file, then the cursor tells which module is the current module and
+  the pad for that module (if any) gets loaded as well.
+
+haskell-run:    \\[haskell-run]
+  Always queries for a variable of type Dialogue to be evaluated.
+
+haskell-run-main:    \\[haskell-run-main]
+  Run Dialogue named main.
+
+haskell-report-type:   \\[haskell-report-type]
+  Like haskell-eval, but prints the type of the expression without
+  evaluating it.
+
+haskell-mode:   \\[haskell-mode]
+  Puts the current buffer in haskell mode.
+
+haskell-compile:   \\[haskell-compile]
+  Compiles file in current buffer.
+
+haskell-load:   \\[haskell-load]
+  Loads file in current buffer.
+
+haskell-run-file:   \\[haskell-run-file]
+  Runs file in the current buffer.
+
+haskell-pad:   \\[haskell-pad]
+  Creates a scratch pad for the current module.
+
+haskell-optimizers:  \\[haskell-optimizers]
+  Shows the list of available optimizers.  Commands for turning them on/off.
+
+haskell-printers:  \\[haskell-printers]
+  Shows the list of available printers.  Commands for turning them on/off.
+
+haskell-command:   \\[haskell-command]
+  Prompts for a command to be sent to the command interface.  You don't
+  need to put the : before the command.
+
+haskell-quit:   \\[haskell-quit]
+  Terminates the haskell process.
+
+haskell-switch:   \\[haskell-switch]
+  Switches to the inferior Haskell buffer (*haskell*) and positions the
+  cursor at the end of the buffer.
+
+haskell-kill:  \\[haskell-kill]
+  Kill the current contents of the *haskell* buffer.
+  
+haskell-interrupt:   \\[haskell-interrupt]
+  Interrupts haskell process and resets it.
+
+haskell-edit-unit:   \\[haskell-edit-unit]
+  Edit the .hu file for the unit containing this file.
+
+The usual comint functions are also available. In particular, the 
+following are all available:
+
+comint-bol: Beginning of line, but skip prompt. Bound to C-a by default.
+comint-delchar-or-maybe-eof: Delete char, unless at end of buffer, in 
+            which case send EOF to process. Bound to C-d by default.
+
+Note however, that the default keymap bindings provided shadow some of
+the default comint mode bindings, so that you may want to bind them 
+to your choice of keys. 
+
+Comint mode's dynamic completion of filenames in the buffer is available.
+(Q.v. comint-dynamic-complete, comint-dynamic-list-completions.)
+
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+
+  (interactive)
+  (comint-mode)
+  (setq comint-prompt-regexp haskell-prompt-pattern)
+  ;; Customise in inferior-haskell-mode-hook
+  (inferior-haskell-mode-variables) 
+  (setq major-mode 'inferior-haskell-mode)
+  (setq mode-name "Inferior Haskell")
+  (setq mode-line-process '(": %s : busy"))
+  (use-local-map inferior-haskell-mode-map)
+  (setq comint-input-filter 'haskell-input-filter)
+  (setq comint-input-sentinel 'ignore)
+  (setq comint-get-old-input 'haskell-get-old-input)
+  (run-hooks 'inferior-haskell-mode-hook)
+    ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
+    ;The test is so we don't lose history if we run comint-mode twice in
+    ;a buffer.
+  (setq haskell-prompt-ring (make-ring comint-input-ring-size)))
+
+
+(defun haskell-input-filter (str)
+  "Don't save whitespace."
+  (not (string-match "\\s *" str)))
+
+
+\f
+;;; ==================================================================
+;;; Random utilities
+;;; ==================================================================
+
+
+;;; This keeps track of the status of the haskell process.
+;;; Values are:
+;;; busy -- The process is busy.
+;;; ready -- The process is ready for a command.
+;;; input -- The process is waiting for input.
+;;; debug -- The process is in the debugger.
+
+(defvar *haskell-status* 'busy
+  "Status of the haskell process")
+
+(defun set-haskell-status (value)
+  (setq *haskell-status* value)
+  (haskell-update-mode-line))
+
+(defun get-haskell-status ()
+  *haskell-status*)
+
+(defun haskell-update-mode-line ()
+  (save-excursion
+    (set-buffer *haskell-buffer*)
+    (cond ((eq *haskell-status* 'ready)
+          (setq mode-line-process '(": %s: ready")))
+         ((eq *haskell-status* 'input)
+          (setq mode-line-process '(": %s: input")))
+         ((eq *haskell-status* 'busy)
+          (setq mode-line-process '(": %s: busy")))
+         ((eq *haskell-status* 'debug)
+          (setq mode-line-process '(": %s: debug")))
+         (t
+          (haskell-mode-error "Confused about status of haskell process!")))
+    ;; Yes, this is the officially sanctioned technique for forcing
+    ;; a redisplay of the mode line.
+    (set-buffer-modified-p (buffer-modified-p))))
+
+
+(defun haskell-send-to-process (string)
+  (process-send-string "haskell" string)
+  (process-send-string "haskell" "\n"))
+
+
+\f
+;;; ==================================================================
+;;; Handle input in haskell process buffer; history commands.
+;;; ==================================================================
+
+(defun haskell-get-old-input ()
+  "Get old input text from Haskell process buffer."
+  (save-excursion
+    (if (re-search-forward haskell-prompt-pattern (point-max) 'move)
+       (goto-char (match-beginning 0)))
+    (cond ((re-search-backward haskell-prompt-pattern (point-min) t)
+          (comint-skip-prompt)
+          (let ((temp  (point)))
+            (end-of-line)
+            (buffer-substring temp (point)))))))
+
+
+(defun haskell-send-input ()
+  "Send input to Haskell while in the process buffer"
+  (interactive)
+  (if (eq (get-haskell-status) 'debug)
+      (comint-send-input)
+      (haskell-send-input-aux)))
+
+(defun haskell-send-input-aux ()
+  ;; Note that the input string does not include its terminal newline.
+  (let ((proc (get-buffer-process (current-buffer))))
+    (if (not proc)
+       (haskell-mode-error "Current buffer has no process!")
+       (let* ((pmark (process-mark proc))
+              (pmark-val (marker-position pmark))
+              (input (if (>= (point) pmark-val)
+                         (buffer-substring pmark (point))
+                         (let ((copy (funcall comint-get-old-input)))
+                           (goto-char pmark)
+                           (insert copy)
+                           copy))))
+         (insert ?\n)
+         (if (funcall comint-input-filter input)
+             (ring-insert input-ring input))
+         (funcall comint-input-sentinel input)
+         (set-marker (process-mark proc) (point))
+         (set-marker comint-last-input-end (point))
+         (haskell-send-to-process input)))))
+
+
+\f
+;;; ==================================================================
+;;; Minibuffer input stuff
+;;; ==================================================================
+
+;;; Haskell input history retrieval commands   (taken from comint.el)
+;;; M-p -- previous input    M-n -- next input
+
+(defvar haskell-minibuffer-local-map nil
+  "Local map for minibuffer when in Haskell")
+
+(if haskell-minibuffer-local-map
+    nil
+    (progn
+      (setq haskell-minibuffer-local-map
+           (copy-keymap minibuffer-local-map))
+      ;; Haskell commands
+      (define-key haskell-minibuffer-local-map "\ep"   'haskell-previous-input)
+      (define-key haskell-minibuffer-local-map "\en"   'haskell-next-input)
+      ))
+
+(defun haskell-previous-input (arg)
+  "Cycle backwards through input history."
+  (interactive "*p")
+  (let ((len (ring-length haskell-prompt-ring)))
+    (cond ((<= len 0)
+          (message "Empty input ring.")
+          (ding))
+         (t
+          (cond ((eq last-command 'haskell-previous-input)
+                 (delete-region (mark) (point))
+                 (set-mark (point)))
+                (t                          
+                 (setq input-ring-index
+                       (if (> arg 0) -1
+                           (if (< arg 0) 1 0)))
+                 (push-mark (point))))
+          (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
+          (insert (ring-ref haskell-prompt-ring input-ring-index))
+          (setq this-command 'haskell-previous-input))
+         )))
+        
+(defun haskell-next-input (arg)
+  "Cycle forwards through input history."
+  (interactive "*p")
+  (haskell-previous-input (- arg)))
+
+(defvar haskell-last-input-match ""
+  "Last string searched for by Haskell input history search, for defaulting.
+Buffer local variable.") 
+
+(defun haskell-previous-input-matching (str)
+  "Searches backwards through input history for substring match"
+  (interactive (let ((s (read-from-minibuffer 
+                        (format "Command substring (default %s): "
+                                haskell-last-input-match))))
+                (list (if (string= s "") haskell-last-input-match s))))
+  (setq haskell-last-input-match str) ; update default
+  (let ((str (regexp-quote str))
+        (len (ring-length haskell-prompt-ring))
+       (n 0))
+    (while (and (<= n len)
+               (not (string-match str (ring-ref haskell-prompt-ring n))))
+      (setq n (+ n 1)))
+    (cond ((<= n len) (haskell-previous-input (+ n 1)))
+         (t (haskell-mode-error "Not found.")))))
+
+
+;;; Actually read an expression from the minibuffer using the new keymap.
+
+(defun haskell-get-expression (prompt)
+  (let ((exp  (read-from-minibuffer prompt nil haskell-minibuffer-local-map)))
+    (ring-insert haskell-prompt-ring exp)
+    exp))
+
+
+\f
+;;; ==================================================================
+;;; Handle output from Haskell process
+;;; ==================================================================
+
+;;; The haskell process produces output with embedded control codes.
+;;; These control codes are used to keep track of what kind of input
+;;; the haskell process is expecting.  Ordinary output is just displayed.
+;;;
+;;; This is kind of complicated because control sequences can be broken
+;;; across multiple batches of text received from the haskell process.
+;;; If the string ends in the middle of a control sequence, save it up
+;;; for the next call.
+
+(defvar *haskell-saved-output* nil)
+
+;;; On the Next, there is some kind of race condition that causes stuff
+;;; sent to the Haskell subprocess before it has really started to be lost.
+;;; The point of this variable is to force the Emacs side to wait until
+;;; Haskell has started and printed out its banner before sending it
+;;; anything.  See start-haskell below.
+
+(defvar *haskell-process-alive* nil)
+
+(defun haskell-output-filter (process str)
+  "Filter for output from Yale Haskell command interface"
+  ;; *** debug
+  ;;(let ((buffer  (get-buffer-create "haskell-output")))
+  ;;  (save-excursion
+  ;;    (set-buffer buffer)
+  ;;    (insert str)))
+  (setq *haskell-process-alive* t)
+  (let ((next    0)
+       (start   0)
+       (data    (match-data)))
+    (unwind-protect
+       (progn
+         ;; If there was saved output from last time, glue it in front of the
+         ;; newly received input.
+         (if *haskell-saved-output*
+             (progn
+               (setq str (concat *haskell-saved-output* str))
+               (setq *haskell-saved-output* nil)))
+         ;; Loop, looking for complete command sequences.
+         ;; Set next to point to the first one.
+         ;; start points to first character to be processed.
+         (while (setq next
+                      (string-match *haskell-message-match-regexp*
+                                    str start))
+           ;; Display any intervening ordinary text.
+           (if (not (eq next start))
+               (haskell-display-output (substring str start next)))
+           ;; Now dispatch on the particular command sequence found.
+           ;; Handler functions are called with the string and start index
+           ;; as arguments, and should return the index of the "next"
+           ;; character.
+           (let ((end  (match-end 0)))
+             (haskell-handle-message str next)
+             (setq start end)))
+         ;; Look to see whether the string ends with an incomplete 
+         ;; command sequence.
+         ;; If so, save the tail of the string for next time.
+         (if (and (setq next
+                    (string-match *haskell-message-prefix-regexp* str start))
+                  (eq (match-end 0) (length str)))
+              (setq *haskell-saved-output* (substring str next))
+             (setq next (length str)))
+         ;; Display any leftover ordinary text.
+         (if (not (eq next start))
+             (haskell-display-output (substring str start next))))
+      (store-match-data data))))
+
+(defvar *haskell-message-match-regexp*
+  "EMACS:.*\n")
+
+(defvar *haskell-message-prefix-regexp*
+  "E\\(M\\(A\\(C\\(S\\(:.*\\)?\\)?\\)?\\)?\\)?")
+
+(defvar *haskell-message-dispatch*
+  '(("EMACS:debug\n"         . haskell-got-debug)
+    ("EMACS:busy\n"          . haskell-got-busy)
+    ("EMACS:input\n"         . haskell-got-input)
+    ("EMACS:ready\n"         . haskell-got-ready)
+    ("EMACS:printers .*\n"   . haskell-got-printers)
+    ("EMACS:optimizers .*\n" . haskell-got-optimizers)
+    ("EMACS:message .*\n"    . haskell-got-message)
+    ("EMACS:error\n"         . haskell-got-error)
+    ))
+
+(defun haskell-handle-message (str idx)
+  (let ((list  *haskell-message-dispatch*)
+       (fn    nil))
+    (while (and list (null fn))
+      (if (eq (string-match (car (car list)) str idx) idx)
+         (setq fn (cdr (car list)))
+         (setq list (cdr list))))
+    (if (null fn)
+       (haskell-mode-error "Garbled message from Haskell!")
+       (let ((end  (match-end 0)))
+         (funcall fn str idx end)
+         end))))
+
+
+(defun haskell-message-data (string start end)
+  (let ((real-start  (+ (string-match " " string start) 1))
+       (real-end    (- end 1)))
+    (substring string real-start real-end)))
+
+(defun haskell-got-debug (string start end)
+  (beep)
+  (message "In the debugger!")
+  (set-haskell-status 'debug))
+
+(defun haskell-got-busy (string start end)
+  (set-haskell-status 'busy))
+
+(defun haskell-got-input (string start end)
+  (if haskell-auto-switch-input
+      (progn
+       (haskell-switch)
+       (beep)))
+  (set-haskell-status 'input)
+  (message "Waiting for input..."))
+
+(defun haskell-got-ready (string start end)
+  (set-haskell-status 'ready))
+
+(defun haskell-got-printers (string start end)
+  (haskell-printers-update (haskell-message-data string start end)))
+
+(defun haskell-got-optimizers (string start end)
+  (haskell-optimizers-update (haskell-message-data string start end)))
+
+(defun haskell-got-message (string start end)
+  (message "%s" (haskell-message-data string start end)))
+
+(defun haskell-got-error (string start end)
+; [[!chak! I found that annoying]]  (beep)
+  (message "Haskell error."))
+
+
+;;; Displays output at end of given buffer.
+;;; This function only ensures that the output is visible, without 
+;;; selecting the buffer in which it is displayed.
+;;; Note that just using display-buffer instead of all this rigamarole
+;;; won't work; you need to temporarily select the window containing
+;;; the *haskell-buffer*, or else the display won't be scrolled to show
+;;; the new output.
+;;; *** This should really position the window in the buffer so that 
+;;; *** the point is on the last line of the window.
+
+(defun haskell-display-output (str)
+  (let ((window  (selected-window)))
+    (unwind-protect
+       (progn
+         (pop-to-buffer *haskell-buffer*)
+         (haskell-display-output-aux str))
+      (select-window window))))
+
+(defun haskell-display-output-aux (str)
+  (haskell-move-marker)
+  (insert str)
+  (haskell-move-marker))
+
+
+\f
+;;; ==================================================================
+;;; Interactive commands
+;;; ==================================================================
+
+
+;;; HASKELL
+;;; -------
+;;;
+;;; This is the function that fires up the inferior haskell process.
+
+(defun haskell ()
+  "Run an inferior Haskell process with input and output via buffer *haskell*.
+Takes the program name from the variable haskell-program-name.  
+Runs the hooks from inferior-haskell-mode-hook 
+(after the comint-mode-hook is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+  (interactive)
+  (if (not (haskell-process-exists-p))
+    (start-haskell)))
+
+(defun start-haskell ()
+  (message "Starting haskell subprocess...")
+  ;; Kill old haskell process.  Normally this routine is only called
+  ;; after checking haskell-process-exists-p, but things can get
+  ;; screwed up if you rename the *haskell* buffer while leaving the
+  ;; old process running.  This forces it to get rid of the old process
+  ;; and start a new one.
+  (if (get-process "haskell")
+      (delete-process "haskell"))
+  (let ((haskell-buffer
+        (apply 'make-comint
+               "haskell"
+               (or haskell-program-name
+                   (haskell-mode-error "Haskell-program-name undefined!"))
+               nil
+               nil)))
+    (save-excursion
+      (set-buffer haskell-buffer)
+      (inferior-haskell-mode))
+    (haskell-session-init)
+    ;; Wait for process to get started before sending it anything
+    ;; to avoid race condition on NeXT.
+    (setq *haskell-process-alive* nil)
+    (while (not *haskell-process-alive*)
+      (sleep-for 1))
+    (haskell-send-to-process ":(use-emacs-interface)")
+    (haskell-printers-set haskell-initial-printers nil)
+    (display-buffer haskell-buffer))
+  (message "Starting haskell subprocess...  Done."))
+
+
+(defun haskell-process-exists-p ()
+  (let ((haskell-buffer  (get-buffer *haskell-buffer*)))
+    (and haskell-buffer (comint-check-proc haskell-buffer))))
+
+
+
+;;; Initialize things on the emacs side, and tell haskell that it's
+;;; talking to emacs.
+
+(defun haskell-session-init ()
+  (set-haskell-status 'busy)
+  (setq *last-loaded* nil)
+  (setq *last-module* haskell-main-module)
+  (setq *last-pad* haskell-main-pad)
+  (setq *haskell-saved-output* nil)
+  (haskell-create-main-pad)
+  (set-process-filter (get-process "haskell") 'haskell-output-filter)
+  )
+
+
+(defun haskell-create-main-pad ()
+  (let ((buffer (get-buffer-create haskell-main-pad)))
+    (save-excursion
+      (set-buffer buffer)
+      (haskell-mode))
+    (haskell-record-pad-mapping
+      haskell-main-pad haskell-main-module nil)
+    buffer))
+
+
+;;; Called from evaluation and compilation commands to start up a Haskell
+;;; process if none is already in progress.
+
+(defun haskell-maybe-create-process ()
+  (cond ((haskell-process-exists-p)
+        t)
+       (haskell-auto-create-process
+        (start-haskell))
+       (t
+        (haskell-mode-error "No Haskell process!"))))
+
+
+
+;;; HASKELL-GET-PAD
+;;; ------------------------------------------------------------------
+
+;;; This always puts the pad buffer in the "other" window.
+;;; Having it wipe out the .hs file window is clearly the wrong
+;;; behavior.
+
+(defun haskell-get-pad ()
+  "Creates a new scratch pad for the current module.
+Signals an error if the current buffer is not a .hs file."
+  (interactive)
+  (let ((fname (buffer-file-name)))
+    (if fname
+       (do-get-pad fname (current-buffer))
+        (haskell-mode-error "Not in a .hs buffer!"))))
+
+
+(defun do-get-pad (fname buff)
+  (let* ((mname (or (haskell-get-modname buff)
+                   (read-no-blanks-input "Scratch pad for module? " nil)))
+        (pname (haskell-lookup-pad mname fname))
+        (pbuff nil))
+    ;; Generate the base name of the pad buffer, then create the
+    ;; buffer.  The actual name of the pad buffer may be something
+    ;; else because of name collisions.
+    (if (not pname)
+       (progn
+         (setq pname (format "*%s-pad*" mname))
+         (setq pbuff (generate-new-buffer pname))
+         (setq pname (buffer-name pbuff))
+         (haskell-record-pad-mapping pname mname fname)
+         )
+       (setq pbuff (get-buffer pname)))
+    ;; Make sure the pad buffer is in haskell mode.
+    (pop-to-buffer pbuff)
+    (haskell-mode)))
+
+
+
+;;; HASKELL-SWITCH
+;;; ------------------------------------------------------------------
+
+(defun haskell-switch ()
+  "Switches to \*haskell\* buffer."
+  (interactive)
+  (haskell-maybe-create-process)
+  (pop-to-buffer *haskell-buffer*)
+  (push-mark)
+  (goto-char (point-max)))
+
+
+
+;;; HASKELL-KILL
+;;; ------------------------------------------------------------------
+
+(defun haskell-kill ()
+  "Kill contents of *haskell* buffer.  \\[haskell-kill]"
+  (interactive)
+  (save-excursion
+    (set-buffer *haskell-buffer*)
+    (beginning-of-buffer)
+    (let ((mark  (point)))
+      (end-of-buffer)
+      (kill-region mark (point)))))
+
+
+
+;;; HASKELL-COMMAND
+;;; ------------------------------------------------------------------
+
+(defun haskell-command (str)
+  "Format STRING as a haskell command and send it to haskell process.  \\[haskell-command]"
+  (interactive "sHaskell command: ")
+  (haskell-send-to-process (format ":%s" str)))
+
+
+;;; HASKELL-EVAL and HASKELL-RUN
+;;; ------------------------------------------------------------------
+
+(defun haskell-eval ()
+  "Evaluate expression in current module. \\[haskell-eval]"
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
+                   "emacs-eval"))
+
+(defun haskell-run ()
+  "Run Haskell Dialogue in current module"
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux (haskell-get-expression "Haskell dialogue: ")
+                   "emacs-run"))
+
+(defun haskell-run-main ()
+  "Run Dialogue named main in current module"
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux "main" "emacs-run"))
+
+(defun haskell-report-type ()
+  "Print the type of the expression."
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
+                   "emacs-report-type"))
+
+(defun haskell-eval-aux (exp fn)
+  (cond ((equal *haskell-buffer* (buffer-name))
+        ;; In the *haskell* buffer.
+        (let* ((pname  *last-pad*)
+               (mname  *last-module*)
+               (fname  *last-loaded*))
+          (haskell-eval-aux-aux exp pname mname fname fn)))
+       ((buffer-file-name)
+        ;; In a .hs file.
+        (let* ((fname  (buffer-file-name))
+               (mname  (haskell-get-modname (current-buffer)))
+               (pname  (haskell-lookup-pad mname fname)))
+          (haskell-eval-aux-aux exp pname mname fname fn)))
+       (t
+        ;; In a pad.
+        (let* ((pname  (buffer-name (current-buffer)))
+               (mname  (haskell-get-module-from-pad pname))
+               (fname  (haskell-get-file-from-pad pname)))
+          (haskell-eval-aux-aux exp pname mname fname fn)))
+       ))
+
+(defun haskell-eval-aux-aux (exp pname mname fname fn)
+  (haskell-save-modified-source-files fname)
+  (haskell-send-to-process (format ":(%s" fn))
+  (haskell-send-to-process
+    (prin1-to-string exp))
+  (haskell-send-to-process
+    (prin1-to-string (or pname fname "interactive")))
+  (haskell-send-to-process
+    (prin1-to-string
+      (if (and pname (get-buffer pname))
+         (save-excursion
+           (set-buffer pname)
+           (buffer-string))
+         "")))
+  (haskell-send-to-process
+    (format "'|%s|" mname))
+  (haskell-send-to-process
+    (if fname
+       (prin1-to-string (haskell-maybe-get-unit-file-name fname))
+       "'#f"))
+  (haskell-send-to-process ")")
+  (setq *last-pad* pname)
+  (setq *last-module* mname)
+  (setq *last-loaded* fname))
+
+
+
+;;; HASKELL-RUN-FILE, HASKELL-LOAD, HASKELL-COMPILE
+;;; ------------------------------------------------------------------
+
+(defun haskell-run-file ()
+  "Runs Dialogue named main in current file."
+  (interactive)
+  (haskell-maybe-create-process)
+  (let ((fname  (haskell-get-file-to-operate-on)))
+    (haskell-save-modified-source-files fname)
+    (haskell-send-to-process ":(emacs-run-file")
+    (haskell-send-to-process (prin1-to-string fname))
+    (haskell-send-to-process ")")))
+
+(defun haskell-load ()
+  "Load current file."
+  (interactive)
+  (haskell-maybe-create-process)
+  (let ((fname  (haskell-get-file-to-operate-on)))
+    (haskell-save-modified-source-files fname)
+    (haskell-send-to-process ":(emacs-load-file")
+    (haskell-send-to-process (prin1-to-string fname))
+    (haskell-send-to-process ")")))
+
+(defun haskell-compile ()
+  "Compile current file."
+  (interactive)
+  (haskell-maybe-create-process)
+  (let ((fname  (haskell-get-file-to-operate-on)))
+    (haskell-save-modified-source-files fname)
+    (haskell-send-to-process ":(emacs-compile-file")
+    (haskell-send-to-process (prin1-to-string fname))
+    (haskell-send-to-process ")")))
+
+
+(defun haskell-get-file-to-operate-on ()
+  (cond ((equal *haskell-buffer* (buffer-name))
+        ;; When called from the haskell process buffer, prompt for a file.
+        (call-interactively 'haskell-get-file/prompt))
+       ((buffer-file-name)
+        ;; When called from a .hs file buffer, use the unit file
+        ;; associated with it, if there is one.
+        (haskell-maybe-get-unit-file-name (buffer-file-name)))
+       (t
+        ;; When called from a pad, use the file that the module the
+        ;; pad belongs to lives in.
+        (haskell-maybe-get-unit-file-name 
+          (haskell-get-file-from-pad (buffer-name (current-buffer)))))))
+
+(defun haskell-get-file/prompt (filename)
+  (interactive "fHaskell file:  ")
+  filename)
+
+
+
+;;; HASKELL-EXIT
+;;; ------------------------------------------------------------------
+
+(defun haskell-exit ()
+  "Quit the haskell process."
+  (interactive)
+  (cond ((not (haskell-process-exists-p))
+        (message "No process currently running."))
+       ((y-or-n-p "Do you really want to quit Haskell? ")
+        (haskell-send-to-process ":quit")
+        ;; If we were running the tutorial, mark the temp buffer as unmodified
+        ;; so we don't get asked about saving it later.
+        (if (and *ht-temp-buffer*
+                 (get-buffer *ht-temp-buffer*))
+            (save-excursion
+              (set-buffer *ht-temp-buffer*)
+              (set-buffer-modified-p nil)))
+        ;; Try to remove the haskell output buffer from the screen.
+        (bury-buffer *haskell-buffer*)
+        (replace-buffer-in-windows *haskell-buffer*))
+       (t
+        nil)))
+
+
+;;; HASKELL-INTERRUPT
+;;; ------------------------------------------------------------------
+
+(defun haskell-interrupt ()
+  "Interrupt the haskell process."
+  (interactive)
+  (if (haskell-process-exists-p)
+      (haskell-send-to-process "\C-c")))
+
+
+
+;;; HASKELL-EDIT-UNIT
+;;; ------------------------------------------------------------------
+
+(defun haskell-edit-unit ()
+  "Edit the .hu file."
+  (interactive)
+  (let ((fname       (buffer-file-name)))
+    (if fname
+       (let ((find-file-not-found-hooks  (list 'haskell-new-unit))
+             (file-not-found             nil)
+             (units-fname                (haskell-get-unit-file-name fname)))
+         (find-file-other-window units-fname)
+         ;; If creating a new file, initialize it to contain the name
+         ;; of the haskell source file.
+         (if file-not-found
+             (save-excursion
+               (insert
+                 (if (string= (file-name-directory fname)
+                              (file-name-directory units-fname))
+                     (file-name-nondirectory fname)
+                     fname)
+                 "\n"))))
+       (haskell-mode-error "Not in a .hs buffer!"))))
+
+(defun haskell-new-unit ()
+  (setq file-not-found t))
+
+
+;;; Look for a comment like "-- unit:" at top of file.
+;;; If not found, assume unit file has same name as the buffer but
+;;; a .hu extension.
+
+(defun haskell-get-unit-file-name (fname)
+  (or (haskell-get-unit-file-name-from-file fname)
+      (concat (haskell-strip-file-extension fname) ".hu")))
+
+(defun haskell-maybe-get-unit-file-name (fname)
+  (or (haskell-get-unit-file-name-from-file fname)
+      (haskell-strip-file-extension fname)))
+
+(defun haskell-get-unit-file-name-from-file (fname)
+  (let ((buffer  (get-file-buffer fname)))
+    (if buffer
+       (save-excursion
+         (beginning-of-buffer)
+         (if (re-search-forward "-- unit:[ \t]*" (point-max) t)
+             (let ((beg  (match-end 0)))
+               (end-of-line)
+               (buffer-substring beg (point)))
+             nil))
+       nil)))
+
+
+
+\f
+;;; ==================================================================
+;;; Support for printers/optimizers menus
+;;; ==================================================================
+
+;;; This code was adapted from the standard buff-menu.el code.
+
+(defvar haskell-menu-mode-map nil "")
+
+(if (not haskell-menu-mode-map)
+    (progn
+      (setq haskell-menu-mode-map (make-keymap))
+      (suppress-keymap haskell-menu-mode-map t)
+      (define-key haskell-menu-mode-map "m" 'hm-mark)
+      (define-key haskell-menu-mode-map "u" 'hm-unmark)
+      (define-key haskell-menu-mode-map "x" 'hm-exit)
+      (define-key haskell-menu-mode-map "q" 'hm-exit)
+      (define-key haskell-menu-mode-map " " 'next-line)
+      (define-key haskell-menu-mode-map "\177" 'hm-backup-unmark)
+      (define-key haskell-menu-mode-map "?" 'describe-mode)))
+
+;; Printers Menu mode is suitable only for specially formatted data.
+
+(put 'haskell-menu-mode 'mode-class 'special)
+
+(defun haskell-menu-mode ()
+  "Major mode for editing Haskell flags.
+Each line describes a flag.
+Letters do not insert themselves; instead, they are commands.
+m -- mark flag (turn it on)
+u -- unmark flag (turn it off)
+x -- exit; tell the Haskell process to update the flags, then leave menu.
+q -- exit; same as x.
+Precisely,\\{haskell-menu-mode-map}"
+  (kill-all-local-variables)
+  (use-local-map haskell-menu-mode-map)
+  (setq truncate-lines t)
+  (setq buffer-read-only t)
+  (setq major-mode 'haskell-menu-mode)
+  (setq mode-name "Haskell Flags Menu")
+  ;; These are all initialized elsewhere
+  (make-local-variable 'hm-current-flags)
+  (make-local-variable 'hm-request-fn)
+  (make-local-variable 'hm-update-fn)
+  (run-hooks 'haskell-menu-mode-hook))
+
+
+(defun haskell-menu (help-file buffer request-fn update-fn)
+  (haskell-maybe-create-process)
+  (if (get-buffer buffer)
+      (progn
+       (pop-to-buffer buffer)
+       (goto-char (point-min)))
+      (progn
+        (pop-to-buffer buffer)
+       (insert-file-contents help-file)
+       (haskell-menu-mode)
+       (setq hm-request-fn request-fn)
+       (setq hm-update-fn update-fn)
+       ))
+  (hm-mark-current)
+  (message "m = mark; u = unmark; x = execute; q = quit; ? = more help."))
+
+
+
+;;; A line that starts with *hm-marked* is a menu item turned on.
+;;; A line that starts with *hm-unmarked* is turned off.
+;;; A line that starts with anything else is just random text and is
+;;; ignored by commands that deal with menu items.
+
+(defvar *hm-marked*   " on")
+(defvar *hm-unmarked* "   ")
+(defvar *hm-marked-regexp*   " on   \\w")
+(defvar *hm-unmarked-regexp* "      \\w")
+
+(defun hm-mark ()
+  "Mark flag to be turned on."
+  (interactive)
+  (beginning-of-line)
+  (cond ((looking-at *hm-marked-regexp*)
+        (forward-line 1))
+       ((looking-at *hm-unmarked-regexp*)
+        (let ((buffer-read-only  nil))
+          (delete-char (length *hm-unmarked*))
+          (insert *hm-marked*)
+          (forward-line 1)))
+       (t
+        (forward-line 1))))
+
+(defun hm-unmark ()
+  "Unmark flag."
+  (interactive)
+  (beginning-of-line)
+  (cond ((looking-at *hm-unmarked-regexp*)
+        (forward-line 1))
+       ((looking-at *hm-marked-regexp*)
+        (let ((buffer-read-only  nil))
+          (delete-char (length *hm-marked*))
+          (insert *hm-unmarked*)
+          (forward-line 1)))
+       (t
+        (forward-line 1))))
+
+(defun hm-backup-unmark ()
+  "Move up and unmark."
+  (interactive)
+  (forward-line -1)
+  (hm-unmark)
+  (forward-line -1))
+
+
+;;; Actually make the changes.
+
+(defun hm-exit ()
+  "Update flags, then leave menu."
+  (interactive)
+  (hm-execute)
+  (hm-quit))
+
+(defun hm-execute ()
+  "Tell haskell process to tweak flags."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (let ((flags-on   nil)
+         (flags-off  nil))
+      (while (not (eq (point) (point-max)))
+       (cond ((looking-at *hm-unmarked-regexp*)
+              (setq flags-off (cons (hm-flag) flags-off)))
+             ((looking-at *hm-marked-regexp*)
+              (setq flags-on (cons (hm-flag) flags-on)))
+             (t
+              nil))
+       (forward-line 1))
+      (funcall hm-update-fn flags-on flags-off))))
+
+
+(defun hm-quit ()
+  (interactive)
+  "Make the menu go away."
+  (bury-buffer (current-buffer))
+  (replace-buffer-in-windows (current-buffer)))
+
+(defun hm-flag ()
+  (save-excursion
+    (beginning-of-line)
+    (forward-char 6)
+    (let ((beg  (point)))
+      ;; End of flag name marked by tab or two spaces.
+      (re-search-forward "\t\\|  ")
+      (buffer-substring beg (match-beginning 0)))))
+
+
+;;; Update the menu to mark only those items currently turned on.
+
+(defun hm-mark-current ()
+  (funcall hm-request-fn)
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eq (point) (point-max)))
+      (cond ((and (looking-at *hm-unmarked-regexp*)
+                 (hm-item-currently-on-p (hm-flag)))
+            (hm-mark))
+           ((and (looking-at *hm-marked-regexp*)
+                 (not (hm-item-currently-on-p (hm-flag))))
+            (hm-unmark))
+           (t
+            (forward-line 1))))))
+
+
+;;; See if a menu item is turned on.
+
+(defun hm-item-currently-on-p (item)
+  (member-string= item hm-current-flags))
+
+(defun member-string= (item list)
+  (cond ((null list)
+        nil)
+       ((string= item (car list))
+        list)
+       (t
+        (member-string= item (cdr list)))))
+
+
+
+;;; Make the menu for printers.
+
+(defvar *haskell-printers-help*
+  (concat (getenv "HASKELL") "/emacs-tools/printer-help.txt")
+  "Help file for printers.")
+
+(defvar *haskell-printers-buffer* "*Haskell printers*")
+
+(defun haskell-printers ()
+  "Set printers interactively."
+  (interactive)
+  (haskell-menu
+    *haskell-printers-help*
+    *haskell-printers-buffer*
+    'haskell-printers-inquire
+    'haskell-printers-set))
+               
+(defun haskell-printers-inquire ()
+  (setq hm-current-flags t)
+  (haskell-send-to-process ":(emacs-send-printers)")
+  (while (eq hm-current-flags t)
+    (sleep-for 1)))
+
+(defun haskell-printers-update (data)
+  (setq hm-current-flags (read data)))
+
+(defun haskell-printers-set (flags-on flags-off)
+  (haskell-send-to-process ":(emacs-set-printers '")
+  (haskell-send-to-process (prin1-to-string flags-on))
+  (haskell-send-to-process ")"))
+
+
+;;; Equivalent stuff for the optimizers menu
+
+(defvar *haskell-optimizers-help*
+  (concat (getenv "HASKELL") "/emacs-tools/optimizer-help.txt")
+  "Help file for optimizers.")
+
+(defvar *haskell-optimizers-buffer* "*Haskell optimizers*")
+
+(defun haskell-optimizers ()
+  "Set optimizers interactively."
+  (interactive)
+  (haskell-menu
+    *haskell-optimizers-help*
+    *haskell-optimizers-buffer*
+    'haskell-optimizers-inquire
+    'haskell-optimizers-set))
+               
+(defun haskell-optimizers-inquire ()
+  (setq hm-current-flags t)
+  (haskell-send-to-process ":(emacs-send-optimizers)")
+  (while (eq hm-current-flags t)
+    (sleep-for 1)))
+
+(defun haskell-optimizers-update (data)
+  (setq hm-current-flags (read data)))
+
+(defun haskell-optimizers-set (flags-on flags-off)
+  (haskell-send-to-process ":(emacs-set-optimizers '")
+  (haskell-send-to-process (prin1-to-string flags-on))
+  (haskell-send-to-process ")"))
+
+
+\f
+;;; ==================================================================
+;;; Random utilities
+;;; ==================================================================
+
+
+;;; Keep track of the association between pads, modules, and files.
+;;; The global variable is a list of (pad-buffer-name module-name file-name)
+;;; lists.
+
+(defvar *haskell-pad-mappings* ()
+  "Associates pads with their corresponding module and file.")
+
+(defun haskell-record-pad-mapping (pname mname fname)
+  (setq *haskell-pad-mappings*
+       (cons (list pname mname fname) *haskell-pad-mappings*)))
+
+(defun haskell-get-module-from-pad (pname)
+  (car (cdr (assoc pname *haskell-pad-mappings*))))
+
+(defun haskell-get-file-from-pad (pname)
+  (car (cdr (cdr (assoc pname *haskell-pad-mappings*)))))
+
+(defun haskell-lookup-pad (mname fname)
+  (let ((pname  (haskell-lookup-pad-aux mname fname *haskell-pad-mappings*)))
+    (if (and pname (get-buffer pname))
+       pname
+       nil)))
+
+(defun haskell-lookup-pad-aux (mname fname list)
+  (cond ((null list)
+        nil)
+       ((and (equal mname (car (cdr (car list))))
+             (equal fname (car (cdr (cdr (car list))))))
+        (car (car list)))
+       (t
+        (haskell-lookup-pad-aux mname fname (cdr list)))))
+
+
+
+;;; Save any modified .hs and .hu files.
+;;; Yes, the two set-buffer calls really seem to be necessary.  It seems
+;;; that y-or-n-p makes emacs forget we had temporarily selected some
+;;; other buffer, and if you just do save-buffer directly it will end
+;;; up trying to save the current buffer instead.  The built-in
+;;; save-some-buffers function has this problem....
+
+(defun haskell-save-modified-source-files (filename)
+  (let ((buffers   (buffer-list))
+       (found-any nil))
+    (while buffers
+      (let ((buffer  (car buffers)))
+       (if (and (buffer-modified-p buffer)
+                (save-excursion
+                  (set-buffer buffer)
+                  (and buffer-file-name
+                       (haskell-source-file-p buffer-file-name)
+                       (setq found-any t)
+                       (or (null haskell-ask-before-saving)
+                           (and filename (string= buffer-file-name filename))
+                           (y-or-n-p
+                               (format "Save file %s? " buffer-file-name))))))
+           (save-excursion
+             (set-buffer buffer)
+             (save-buffer))))
+      (setq buffers (cdr buffers)))
+    (if found-any
+       (message "")
+        (message "(No files need saving)"))))
+  
+(defun haskell-source-file-p (filename)
+  (or (string-match "\\.hs$" filename)
+      (string-match "\\.lhs$" filename)
+      (string-match "\\.hi$" filename)
+      (string-match "\\.hu$" filename)))
+
+
+
+;;; Buffer utilities
+
+(defun haskell-move-marker ()
+  "Moves the marker and point to the end of buffer"
+  (set-marker comint-last-input-end (point-max))
+  (set-marker (process-mark (get-process "haskell")) (point-max))
+  (goto-char (point-max)))
+  
+
+       
+;;; Extract the name of the module the point is in, from the given buffer.
+
+(defvar *haskell-re-module-hs*  "^module\\s *")
+(defvar *haskell-re-module-lhs* "^>\\s *module\\s *")
+(defvar *haskell-re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*")
+
+(defun haskell-get-modname (buff)
+  "Get module name in BUFFER that point is in."
+  (save-excursion
+    (set-buffer buff)
+    (let ((regexp  (if (haskell-lhs-filename-p (buffer-file-name))
+                      *haskell-re-module-lhs*
+                      *haskell-re-module-hs*)))
+      (if (or (looking-at regexp)
+             (re-search-backward regexp (point-min) t)
+             (re-search-forward regexp (point-max) t))
+         (progn
+           (goto-char (match-end 0))
+           (if (looking-at *haskell-re-modname*)
+               (buffer-substring (match-beginning 0) (match-end 0))
+               (haskell-mode-error "Module name not found!!")))
+         "Main"))))
+
+
+;;; Strip file extensions.
+;;; Only strip off extensions we know about; e.g.
+;;; "foo.hs" -> "foo" but "foo.bar" -> "foo.bar".
+
+(defvar *haskell-filename-regexp* "\\(.*\\)\\.\\(hs\\|lhs\\)$")
+
+(defun haskell-strip-file-extension (filename)
+  "Strip off the extension from a filename."
+  (if (string-match *haskell-filename-regexp* filename)
+      (substring filename (match-beginning 1) (match-end 1))
+      filename))
+
+
+;;; Is this a .lhs filename?
+
+(defun haskell-lhs-filename-p (filename)
+  (string-match ".*\\.lhs$" filename))
+
+
+;;; Haskell mode error
+
+(defun haskell-mode-error (msg)
+  "Show MSG in message line as an error from the haskell mode."
+  (error (concat "Haskell mode:  " msg)))
+
+
+\f
+;;; ==================================================================
+;;; User customization
+;;; ==================================================================
+
+(defvar haskell-load-hook nil
+  "This hook is run when haskell is loaded in.
+This is a good place to put key bindings."
+  )
+       
+(run-hooks 'haskell-load-hook)
+
+
+
+\f
+;;;======================================================================
+;;; Tutorial mode setup
+;;;======================================================================
+
+;;; Set up additional key bindings for tutorial mode.
+
+(defvar ht-mode-map (make-sparse-keymap))
+
+(haskell-establish-key-bindings ht-mode-map)
+(define-key ht-mode-map "\C-c\C-f" 'ht-next-page)
+(define-key ht-mode-map "\C-c\C-b" 'ht-prev-page)
+(define-key ht-mode-map "\C-c\C-l" 'ht-restore-page)
+(define-key ht-mode-map "\C-c?"    'describe-mode)
+
+(defun haskell-tutorial-mode ()
+  "Major mode for running the Haskell tutorial.  
+You can use these commands:
+\\{ht-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map ht-mode-map)
+  (setq major-mode 'haskell-tutorial-mode)
+  (setq mode-name "Haskell Tutorial")
+  (set-syntax-table haskell-mode-syntax-table)
+  (run-hooks 'haskell-mode-hook))
+
+
+(defun haskell-tutorial ()
+  "Run the haskell tutorial."
+  (interactive)
+  (ht-load-tutorial)
+  (ht-make-buffer)
+  (ht-display-page)
+  (haskell-maybe-create-process)
+  (haskell-send-to-process ":(emacs-set-printers '(interactive))")
+  )
+
+
+;;; Load the tutorial file into a read-only buffer.  Do not display this
+;;; buffer.
+
+(defun ht-load-tutorial ()
+  (let ((buffer  (get-buffer *ht-file-buffer*)))
+    (if buffer
+       (save-excursion
+         (set-buffer buffer)
+         (beginning-of-buffer))
+       (save-excursion
+         (set-buffer (setq buffer (get-buffer-create *ht-file-buffer*)))
+         (let ((fname (substitute-in-file-name *ht-source-file*)))
+           (if (file-readable-p fname)
+               (ht-load-tutorial-aux fname)
+               (call-interactively 'ht-load-tutorial-aux)))))))
+
+(defun ht-load-tutorial-aux (filename)
+  (interactive "fTutorial file: ")
+  (insert-file filename)
+  (set-buffer-modified-p nil)
+  (setq buffer-read-only t)
+  (beginning-of-buffer))
+
+
+;;; Create a buffer to use for messing about with each page of the tutorial.
+;;; Put the buffer into haskell-tutorial-mode.
+
+(defun ht-make-buffer ()
+  (find-file (concat "/tmp/" (make-temp-name "ht") ".lhs"))
+  (setq *ht-temp-buffer* (buffer-name))
+  (haskell-tutorial-mode))
+
+
+;;; Commands for loading text into the tutorial pad buffer
+
+(defun ht-next-page ()
+  "Go to the next tutorial page."
+  (interactive)
+  (if (ht-goto-next-page)
+      (ht-display-page)
+      (beep)))
+
+(defun ht-goto-next-page ()
+  (let ((buff  (current-buffer)))
+    (unwind-protect
+       (progn
+         (set-buffer *ht-file-buffer*)
+         (search-forward "\C-l" nil t))
+      (set-buffer buff))))
+
+(defun ht-prev-page ()
+  "Go to the previous tutorial page."
+  (interactive)
+  (if (ht-goto-prev-page)
+      (ht-display-page)
+      (beep)))
+
+(defun ht-goto-prev-page ()
+  (let ((buff  (current-buffer)))
+    (unwind-protect
+       (progn
+         (set-buffer *ht-file-buffer*)
+         (search-backward "\C-l" nil t))
+      (set-buffer buff))))
+
+(defun ht-goto-page (arg)
+  "Go to the tutorial page specified as the argument."
+  (interactive "sGo to page: ")
+  (if (ht-searchfor-page (format "Page: %s " arg))
+      (ht-display-page)
+      (beep)))
+
+(defun ht-goto-section (arg)
+  "Go to the tutorial section specified as the argument."
+  (interactive "sGo to section: ")
+  (if (ht-searchfor-page (format "Section: %s " arg))
+      (ht-display-page)
+      (beep)))
+
+(defun ht-searchfor-page (search-string)
+  (let ((buff           (current-buffer)))
+    (unwind-protect
+       (progn
+         (set-buffer *ht-file-buffer*)
+         (let ((point  (point)))
+           (beginning-of-buffer)
+           (if (search-forward search-string nil t)
+               t
+               (progn
+                 (goto-char point)
+                 nil))))
+      (set-buffer buff))))
+
+(defun ht-restore-page ()
+  (interactive)
+  (let ((old-point  (point)))
+    (ht-display-page)
+    (goto-char old-point)))
+
+(defun ht-display-page ()
+  (set-buffer *ht-file-buffer*)
+  (let* ((beg   (progn
+                (if (search-backward "\C-l" nil t)
+                    (forward-line 1)
+                    (beginning-of-buffer))
+                (point)))
+        (end   (progn
+                 (if (search-forward "\C-l" nil t)
+                     (beginning-of-line)
+                     (end-of-buffer))
+                 (point)))
+        (text  (buffer-substring beg end)))
+    (set-buffer *ht-temp-buffer*)
+    (erase-buffer)
+    (insert text)
+    (beginning-of-buffer)))
+
+
+\f
+;;;======================================================================
+;;; Menu bar stuff
+;;;======================================================================
+
+;;; This only works in Emacs version 19, so it's in a separate file for now.
+
+(if (featurep 'menu-bar)
+    (load-library "haskell-menu"))
+
diff --git a/ghc/CONTRIB/haskell-modes/yale/original/README b/ghc/CONTRIB/haskell-modes/yale/original/README
new file mode 100644 (file)
index 0000000..bb22105
--- /dev/null
@@ -0,0 +1,5 @@
+This directory contains GNU Emacs support for editing Haskell files.
+We don't yet have a fancy editing mode, but haskell.el contains stuff
+for running Haskell as an inferior process from Emacs with key bindings
+for evaluating code from buffers, etc.  Look at the comments in haskell.el
+for more information.
diff --git a/ghc/CONTRIB/haskell-modes/yale/original/comint.el b/ghc/CONTRIB/haskell-modes/yale/original/comint.el
new file mode 100644 (file)
index 0000000..e690005
--- /dev/null
@@ -0,0 +1,1524 @@
+;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff
+;;; Copyright Olin Shivers (1988).
+;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
+;;; notice appearing here to the effect that you may use this code any
+;;; way you like, as long as you don't charge money for it, remove this
+;;; notice, or hold me liable for its results.
+
+;;; The changelog is at the end of this file.
+
+;;; Please send me bug reports, bug fixes, and extensions, so that I can
+;;; merge them into the master source.
+;;;     - Olin Shivers (shivers@cs.cmu.edu)
+
+;;; This hopefully generalises shell mode, lisp mode, tea mode, soar mode,...
+;;; This file defines a general command-interpreter-in-a-buffer package
+;;; (comint mode). The idea is that you can build specific process-in-a-buffer
+;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
+;;; This way, all these specific packages share a common base functionality, 
+;;; and a common set of bindings, which makes them easier to use (and
+;;; saves code, implementation time, etc., etc.).
+
+;;; Several packages are already defined using comint mode:
+;;; - cmushell.el defines a shell-in-a-buffer mode.
+;;; - cmulisp.el defines a simple lisp-in-a-buffer mode.
+;;; Cmushell and cmulisp mode are similar to, and intended to replace,
+;;; their counterparts in the standard gnu emacs release (in shell.el). 
+;;; These replacements are more featureful, robust, and uniform than the 
+;;; released versions. The key bindings in lisp mode are also more compatible
+;;; with the bindings of Hemlock and Zwei (the Lisp Machine emacs).
+;;;
+;;; - The file cmuscheme.el defines a scheme-in-a-buffer mode.
+;;; - The file tea.el tunes scheme and inferior-scheme modes for T.
+;;; - The file soar.el tunes lisp and inferior-lisp modes for Soar.
+;;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex,
+;;;   previewers, and printers from within emacs.
+;;; - background.el allows csh-like job control inside emacs.
+;;; It is pretty easy to make new derived modes for other processes.
+
+;;; For documentation on the functionality provided by comint mode, and
+;;; the hooks available for customising it, see the comments below.
+;;; For further information on the standard derived modes (shell, 
+;;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
+
+;;; For hints on converting existing process modes (e.g., tex-mode,
+;;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
+;;; instead of shell-mode, see the notes at the end of this file.
+
+(provide 'comint)
+(defconst comint-version "2.01")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Brief Command Documentation:
+;;;============================================================================
+;;; Comint Mode Commands: (common to all derived modes, like cmushell & cmulisp
+;;; mode)
+;;;
+;;; m-p            comint-previous-input           Cycle backwards in input history
+;;; m-n            comint-next-input               Cycle forwards
+;;; m-s     comint-previous-similar-input   Previous similar input
+;;; c-c r   comint-previous-input-matching  Search backwards in input history
+;;; return  comint-send-input
+;;; c-a     comint-bol                      Beginning of line; skip prompt.
+;;; c-d            comint-delchar-or-maybe-eof     Delete char unless at end of buff.
+;;; c-c c-u comint-kill-input              ^u
+;;; c-c c-w backward-kill-word             ^w
+;;; c-c c-c comint-interrupt-subjob        ^c
+;;; c-c c-z comint-stop-subjob             ^z
+;;; c-c c-\ comint-quit-subjob             ^\
+;;; c-c c-o comint-kill-output             Delete last batch of process output
+;;; c-c c-r comint-show-output             Show last batch of process output
+;;;
+;;; Not bound by default in comint-mode
+;;; send-invisible                     Read a line w/o echo, and send to proc
+;;; (These are bound in shell-mode)
+;;; comint-dynamic-complete            Complete filename at point.
+;;; comint-dynamic-list-completions    List completions in help buffer.
+;;; comint-replace-by-expanded-filename        Expand and complete filename at point;
+;;;                                    replace with expanded/completed name.
+;;; comint-kill-subjob                 No mercy.
+;;; comint-continue-subjob             Send CONT signal to buffer's process
+;;;                                    group. Useful if you accidentally
+;;;                                    suspend your process (with C-c C-z).
+;;;
+;;; Bound for RMS -- I prefer the input history stuff, but you might like 'em.
+;;; m-P           comint-msearch-input         Search backwards for prompt
+;;; m-N    comint-psearch-input                Search forwards for prompt
+;;; C-cR   comint-msearch-input-matching Search backwards for prompt & string
+
+;;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
+;;; comint-load-hook is run after loading in this package.
+
+
+
+
+
+;;; Buffer Local Variables:
+;;;============================================================================
+;;; Comint mode buffer local variables:
+;;;     comint-prompt-regexp    - string       comint-bol uses to match prompt.
+;;;     comint-last-input-end   - marker       For comint-kill-output command
+;;;     input-ring-size         - integer      For the input history
+;;;     input-ring              - ring             mechanism
+;;;     input-ring-index        - marker           ...
+;;;     comint-last-input-match - string           ...
+;;;     comint-get-old-input    - function     Hooks for specific 
+;;;     comint-input-sentinel   - function         process-in-a-buffer
+;;;     comint-input-filter     - function         modes.
+;;;     comint-input-send      - function
+;;;     comint-eol-on-send     - boolean
+
+(defvar comint-prompt-regexp "^"
+  "Regexp to recognise prompts in the inferior process.
+Defaults to \"^\", the null string at BOL.
+
+Good choices:
+  Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
+  Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
+  franz: \"^\\(->\\|<[0-9]*>:\\) *\"
+  kcl: \"^>+ *\"
+  shell: \"^[^#$%>]*[#$%>] *\"
+  T: \"^>+ *\"
+
+This is a good thing to set in mode hooks.")
+
+(defvar input-ring-size 30
+  "Size of input history ring.")
+
+;;; Here are the per-interpreter hooks.
+(defvar comint-get-old-input (function comint-get-old-input-default)
+  "Function that submits old text in comint mode.
+This function is called when return is typed while the point is in old text.
+It returns the text to be submitted as process input.  The default is
+comint-get-old-input-default, which grabs the current line, and strips off
+leading text matching comint-prompt-regexp")
+
+(defvar comint-input-sentinel (function ignore)
+  "Called on each input submitted to comint mode process by comint-send-input.
+Thus it can, for instance, track cd/pushd/popd commands issued to the csh.")
+
+(defvar comint-input-filter
+  (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
+  "Predicate for filtering additions to input history.
+Only inputs answering true to this function are saved on the input
+history list. Default is to save anything that isn't all whitespace")
+
+(defvar comint-input-sender (function comint-simple-send)
+  "Function to actually send to PROCESS the STRING submitted by user.
+Usually this is just 'comint-simple-send, but if your mode needs to 
+massage the input string, this is your hook. This is called from
+the user command comint-send-input. comint-simple-send just sends
+the string plus a newline.")
+
+(defvar comint-eol-on-send 'T
+  "If non-nil, then jump to the end of the line before sending input to process.
+See COMINT-SEND-INPUT")
+
+(defvar comint-mode-hook '()
+  "Called upon entry into comint-mode")
+
+(defvar comint-mode-map nil)
+
+(defun comint-mode ()
+  "Major mode for interacting with an inferior interpreter.
+Interpreter name is same as buffer name, sans the asterisks.
+Return at end of buffer sends line as input.
+Return not at end copies rest of line to end and sends it.
+Setting mode variable comint-eol-on-send means jump to the end of the line
+before submitting new input.
+
+This mode is typically customised to create inferior-lisp-mode,
+shell-mode, etc.. This can be done by setting the hooks
+comint-input-sentinel, comint-input-filter, comint-input-sender and
+comint-get-old-input to appropriate functions, and the variable
+comint-prompt-regexp to the appropriate regular expression.
+
+An input history is maintained of size input-ring-size, and
+can be accessed with the commands comint-next-input [\\[comint-next-input]] and 
+comint-previous-input [\\[comint-previous-input]]. Commands not keybound by
+default are send-invisible, comint-dynamic-complete, and 
+comint-list-dynamic-completions.
+
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it.
+
+\\{comint-mode-map}
+
+Entry to this mode runs the hooks on comint-mode-hook"
+  (interactive)
+  (let ((old-ring (and (assq 'input-ring (buffer-local-variables))
+                      (boundp 'input-ring)
+                      input-ring))
+       (old-ptyp comint-ptyp)) ; preserve across local var kill. gross.
+    (kill-all-local-variables)
+    (setq major-mode 'comint-mode)
+    (setq mode-name "Comint")
+    (setq mode-line-process '(": %s"))
+    (use-local-map comint-mode-map)
+    (make-local-variable 'comint-last-input-end)
+    (setq comint-last-input-end (make-marker))
+    (make-local-variable 'comint-last-input-match)
+    (setq comint-last-input-match "")
+    (make-local-variable 'comint-prompt-regexp) ; Don't set; default
+    (make-local-variable 'input-ring-size)      ; ...to global val.
+    (make-local-variable 'input-ring)
+    (make-local-variable 'input-ring-index)
+    (setq input-ring-index 0)
+    (make-local-variable 'comint-get-old-input)
+    (make-local-variable 'comint-input-sentinel)
+    (make-local-variable 'comint-input-filter)  
+    (make-local-variable 'comint-input-sender)
+    (make-local-variable 'comint-eol-on-send)
+    (make-local-variable 'comint-ptyp)
+    (setq comint-ptyp old-ptyp)
+    (run-hooks 'comint-mode-hook)
+    ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
+    ;The test is so we don't lose history if we run comint-mode twice in
+    ;a buffer.
+    (setq input-ring (if (ring-p old-ring) old-ring
+                        (make-ring input-ring-size)))))
+
+;;; The old-ptyp stuff above is because we have to preserve the value of
+;;; comint-ptyp across calls to comint-mode, in spite of the
+;;; kill-all-local-variables that it does. Blech. Hopefully, this will all
+;;; go away when a later release fixes the signalling bug.
+
+(if comint-mode-map
+    nil
+  (setq comint-mode-map (make-sparse-keymap))
+  (define-key comint-mode-map "\ep" 'comint-previous-input)
+  (define-key comint-mode-map "\en" 'comint-next-input)
+  (define-key comint-mode-map "\es" 'comint-previous-similar-input)
+  (define-key comint-mode-map "\C-m" 'comint-send-input)
+  (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
+  (define-key comint-mode-map "\C-a" 'comint-bol)
+  (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
+  (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
+  (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
+  (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
+  (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
+  (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output)
+  (define-key comint-mode-map "\C-cr"    'comint-previous-input-matching)
+  (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
+  ;;; Here's the prompt-search stuff I installed for RMS to try...
+  (define-key comint-mode-map "\eP" 'comint-msearch-input)
+  (define-key comint-mode-map "\eN" 'comint-psearch-input)
+  (define-key comint-mode-map "\C-cR" 'comint-msearch-input-matching))
+
+
+;;; This function is used to make a full copy of the comint mode map,
+;;; so that client modes won't interfere with each other. This function
+;;; isn't necessary in emacs 18.5x, but we keep it around for 18.4x versions.
+(defun full-copy-sparse-keymap (km)
+  "Recursively copy the sparse keymap KM"
+  (cond ((consp km)
+        (cons (full-copy-sparse-keymap (car km))
+              (full-copy-sparse-keymap (cdr km))))
+       (t km)))
+
+(defun comint-check-proc (buffer-name)
+  "True if there is a process associated w/buffer BUFFER-NAME, and
+it is alive (status RUN or STOP)."
+  (let ((proc (get-buffer-process buffer-name)))
+    (and proc (memq (process-status proc) '(run stop)))))
+
+;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
+;;; for the second argument (program).
+(defun make-comint (name program &optional startfile &rest switches)
+  (let* ((buffer (get-buffer-create (concat "*" name "*")))
+        (proc (get-buffer-process buffer)))
+    ;; If no process, or nuked process, crank up a new one and put buffer in
+    ;; comint mode. Otherwise, leave buffer and existing process alone.
+    (cond ((or (not proc) (not (memq (process-status proc) '(run stop))))
+          (save-excursion
+            (set-buffer buffer)
+            (comint-mode)) ; Install local vars, mode, keymap, ...
+          (comint-exec buffer name program startfile switches)))
+    buffer))
+
+(defvar comint-ptyp t
+  "True if communications via pty; false if by pipe. Buffer local.
+This is to work around a bug in emacs process signalling.")
+
+(defun comint-exec (buffer name command startfile switches)
+  "Fires up a process in buffer for comint modes.
+Blasts any old process running in the buffer. Doesn't set the buffer mode.
+You can use this to cheaply run a series of processes in the same comint
+buffer."
+  (save-excursion
+    (set-buffer buffer)
+    (let ((proc (get-buffer-process buffer)))  ; Blast any old process.
+      (if proc (delete-process proc)))
+    ;; Crank up a new process
+    (let ((proc (comint-exec-1 name buffer command switches)))
+      (make-local-variable 'comint-ptyp)
+      (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe.
+      ;; Jump to the end, and set the process mark.
+      (goto-char (point-max))
+      (set-marker (process-mark proc) (point)))
+      ;; Feed it the startfile.
+      (cond (startfile
+            ;;This is guaranteed to wait long enough
+            ;;but has bad results if the comint does not prompt at all
+            ;;      (while (= size (buffer-size))
+            ;;        (sleep-for 1))
+            ;;I hope 1 second is enough!
+            (sleep-for 1)
+            (goto-char (point-max))
+            (insert-file-contents startfile)
+            (setq startfile (buffer-substring (point) (point-max)))
+            (delete-region (point) (point-max))
+            (comint-send-string proc startfile)))
+    buffer))
+
+;;; This auxiliary function cranks up the process for comint-exec in
+;;; the appropriate environment. It is twice as long as it should be
+;;; because emacs has two distinct mechanisms for manipulating the
+;;; process environment, selected at compile time with the
+;;; MAINTAIN-ENVIRONMENT #define. In one case, process-environment
+;;; is bound; in the other it isn't.
+
+(defun comint-exec-1 (name buffer command switches)
+  (if (boundp 'process-environment) ; Not a completely reliable test.
+      (let ((process-environment
+            (comint-update-env process-environment
+                               (list (format "TERMCAP=emacs:co#%d:tc=unknown"
+                                             (screen-width))
+                                     "TERM=emacs"
+                                     "EMACS=t"))))
+       (apply 'start-process name buffer command switches))
+
+      (let ((tcapv (getenv "TERMCAP"))
+           (termv (getenv "TERM"))
+           (emv   (getenv "EMACS")))
+       (unwind-protect
+            (progn (setenv "TERMCAP" (format "emacs:co#%d:tc=unknown"
+                                             (screen-width)))
+                   (setenv "TERM" "emacs")
+                   (setenv "EMACS" "t")
+                   (apply 'start-process name buffer command switches))
+         (setenv "TERMCAP" tcapv)
+         (setenv "TERM"    termv)
+         (setenv "EMACS"   emv)))))
+            
+
+
+;; This is just (append new old-env) that compresses out shadowed entries.
+;; It's also pretty ugly, mostly due to elisp's horrible iteration structures.
+(defun comint-update-env (old-env new)
+  (let ((ans (reverse new))
+       (vars (mapcar (function (lambda (vv)
+                       (and (string-match "^[^=]*=" vv)
+                            (substring vv 0 (match-end 0)))))
+                     new)))
+    (while old-env
+      (let* ((vv (car old-env)) ; vv is var=value
+            (var (and (string-match "^[^=]*=" vv)
+                      (substring vv 0 (match-end 0)))))
+       (setq old-env (cdr old-env))
+       (cond ((not (and var (comint-mem var vars)))
+              (if var (setq var (cons var vars)))
+              (setq ans (cons vv ans))))))
+    (nreverse ans)))
+
+;;; This should be in emacs, but it isn't.
+(defun comint-mem (item list &optional elt=)
+  "Test to see if ITEM is equal to an item in LIST.
+Option comparison function ELT= defaults to equal."
+  (let ((elt= (or elt= (function equal)))
+       (done nil))
+    (while (and list (not done))
+      (if (funcall elt= item (car list))
+         (setq done list)
+         (setq list (cdr list))))
+    done))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Ring Code
+;;;============================================================================
+;;; This code defines a ring data structure. A ring is a 
+;;;     (hd-index tl-index . vector) 
+;;; list. You can insert to, remove from, and rotate a ring. When the ring
+;;; fills up, insertions cause the oldest elts to be quietly dropped.
+;;;
+;;; HEAD = index of the newest item on the ring.
+;;; TAIL = index of the oldest item on the ring.
+;;;
+;;; These functions are used by the input history mechanism, but they can
+;;; be used for other purposes as well.
+
+(defun ring-p (x) 
+  "T if X is a ring; NIL otherwise."
+  (and (consp x) (integerp (car x))
+       (consp (cdr x)) (integerp (car (cdr x)))
+       (vectorp (cdr (cdr x)))))
+
+(defun make-ring (size)
+  "Make a ring that can contain SIZE elts"
+  (cons 1 (cons 0 (make-vector (+ size 1) nil))))
+
+(defun ring-plus1 (index veclen)
+  "INDEX+1, with wraparound"
+  (let ((new-index (+ index 1)))
+    (if (= new-index veclen) 0 new-index)))
+
+(defun ring-minus1 (index veclen)
+  "INDEX-1, with wraparound"
+  (- (if (= 0 index) veclen index) 1))
+
+(defun ring-length (ring)
+  "Number of elts in the ring."
+  (let ((hd (car ring)) (tl (car (cdr ring)))  (siz (length (cdr (cdr ring)))))
+    (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd)))))
+      (if (= len siz) 0 len))))
+
+(defun ring-empty-p (ring)
+  (= 0 (ring-length ring)))
+
+(defun ring-insert (ring item)
+  "Insert a new item onto the ring. If the ring is full, dump the oldest
+item to make room."       
+  (let* ((vec (cdr (cdr ring)))  (len (length vec))
+        (new-hd (ring-minus1 (car ring) len)))
+      (setcar ring new-hd)
+      (aset vec new-hd item)
+      (if (ring-empty-p ring) ;overflow -- dump one off the tail.
+         (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len)))))
+
+(defun ring-remove (ring)
+  "Remove the oldest item retained on the ring."
+  (if (ring-empty-p ring) (error "Ring empty")
+      (let ((tl (car (cdr ring)))  (vec (cdr (cdr ring))))
+       (set-car (cdr ring) (ring-minus1 tl (length vec)))
+       (aref vec tl))))
+
+;;; This isn't actually used in this package. I just threw it in in case
+;;; someone else wanted it. If you want rotating-ring behavior on your history
+;;; retrieval (analagous to kill ring behavior), this function is what you
+;;; need. I should write the yank-input and yank-pop-input-or-kill to go with
+;;; this, and not bind it to a key by default, so it would be available to
+;;; people who want to bind it to a key. But who would want it? Blech.
+(defun ring-rotate (ring n)
+  (if (not (= n 0))
+      (if (ring-empty-p ring) ;Is this the right error check?
+         (error "ring empty")
+         (let ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring))))
+           (let ((len (length vec)))
+             (while (> n 0)
+               (setq tl (ring-plus1 tl len))
+               (aset ring tl (aref ring hd))
+               (setq hd (ring-plus1 hd len))
+               (setq n (- n 1)))
+             (while (< n 0)
+               (setq hd (ring-minus1 hd len))
+               (aset vec hd (aref vec tl))
+               (setq tl (ring-minus1 tl len))
+               (setq n (- n 1))))
+           (set-car ring hd)
+           (set-car (cdr ring) tl)))))
+
+(defun comint-mod (n m)
+  "Returns N mod M. M is positive. Answer is guaranteed to be non-negative, 
+and less than m."
+  (let ((n (% n m)))
+    (if (>= n 0) n
+       (+ n
+          (if (>= m 0) m (- m)))))) ; (abs m)
+
+(defun ring-ref (ring index)
+  (let ((numelts (ring-length ring)))
+    (if (= numelts 0) (error "indexed empty ring")
+       (let* ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring)))
+              (index (comint-mod index numelts))
+              (vec-index (comint-mod (+ index hd) 
+                                     (length vec))))
+         (aref vec vec-index)))))
+
+
+;;; Input history retrieval commands
+;;; M-p -- previous input    M-n -- next input
+;;; C-c r -- previous input matching
+;;; ===========================================================================
+
+(defun comint-previous-input (arg)
+  "Cycle backwards through input history."
+  (interactive "*p")
+  (let ((len (ring-length input-ring)))
+    (cond ((<= len 0)
+          (message "Empty input ring")
+          (ding))
+         ((not (comint-after-pmark-p))
+          (message "Not after process mark")
+          (ding))
+         (t
+          (cond ((eq last-command 'comint-previous-input)
+                 (delete-region (mark) (point)))
+                ((eq last-command 'comint-previous-similar-input)
+                 (delete-region 
+                  (process-mark (get-buffer-process (current-buffer)))
+                  (point)))
+                (t                          
+                 (setq input-ring-index
+                       (if (> arg 0) -1
+                           (if (< arg 0) 1 0)))
+                 (push-mark (point))))
+          (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
+          (message "%d" (1+ input-ring-index))
+          (insert (ring-ref input-ring input-ring-index))
+          (setq this-command 'comint-previous-input)))))
+        
+(defun comint-next-input (arg)
+  "Cycle forwards through input history."
+  (interactive "*p")
+  (comint-previous-input (- arg)))
+
+(defvar comint-last-input-match ""
+  "Last string searched for by comint input history search, for defaulting.
+Buffer local variable.") 
+
+(defun comint-previous-input-matching (str)
+  "Searches backwards through input history for substring match."
+  (interactive (let* ((last-command last-command) ; preserve around r-f-m
+                     (s (read-from-minibuffer 
+                        (format "Command substring (default %s): "
+                                comint-last-input-match))))
+                (list (if (string= s "") comint-last-input-match s))))
+; (interactive "sCommand substring: ")
+  (setq comint-last-input-match str) ; update default
+  (if (not (eq last-command 'comint-previous-input))
+      (setq input-ring-index -1))
+  (let ((str (regexp-quote str))
+        (len (ring-length input-ring))
+       (n (+ input-ring-index 1)))
+    (while (and (< n len) (not (string-match str (ring-ref input-ring n))))
+      (setq n (+ n 1)))
+    (cond ((< n len)
+          (comint-previous-input (- n input-ring-index)))
+         (t (if (eq last-command 'comint-previous-input) 
+                (setq this-command 'comint-previous-input))
+            (message "Not found.")
+            (ding)))))
+
+
+;;; These next three commands are alternatives to the input history commands --
+;;; comint-next-input, comint-previous-input and 
+;;; comint-previous-input-matching. They search through the process buffer
+;;; text looking for occurrences of the prompt. RMS likes them better;
+;;; I don't. Bound to M-P, M-N, and C-c R (uppercase P, N, and R) for
+;;; now. Try'em out. Go with what you like...
+
+;;; comint-msearch-input-matching prompts for a string, not a regexp.
+;;; This could be considered to be the wrong thing. I decided to keep it
+;;; simple, and not make the user worry about regexps. This, of course,
+;;; limits functionality.
+
+(defun comint-psearch-input ()
+  "Search forwards for next occurrence of prompt and skip to end of line.
+\(prompt is anything matching regexp comint-prompt-regexp)"
+  (interactive)
+  (if (re-search-forward comint-prompt-regexp (point-max) t)
+      (end-of-line)
+      (error "No occurrence of prompt found")))
+
+(defun comint-msearch-input ()
+  "Search backwards for previous occurrence of prompt and skip to end of line.
+Search starts from beginning of current line."
+  (interactive)
+  (let ((p (save-excursion
+            (beginning-of-line)
+            (cond ((re-search-backward comint-prompt-regexp (point-min) t)
+                   (end-of-line)
+                   (point))
+                  (t nil)))))
+    (if p (goto-char p)
+       (error "No occurrence of prompt found"))))
+
+(defun comint-msearch-input-matching (str)
+  "Search backwards for occurrence of prompt followed by STRING.
+STRING is prompted for, and is NOT a regular expression."
+  (interactive (let ((s (read-from-minibuffer 
+                        (format "Command (default %s): "
+                                comint-last-input-match))))
+                (list (if (string= s "") comint-last-input-match s))))
+; (interactive "sCommand: ")
+  (setq comint-last-input-match str) ; update default
+  (let* ((r (concat comint-prompt-regexp (regexp-quote str)))
+        (p (save-excursion
+             (beginning-of-line)
+             (cond ((re-search-backward r (point-min) t)
+                    (end-of-line)
+                    (point))
+                   (t nil)))))
+    (if p (goto-char p)
+       (error "No match"))))
+
+;;;
+;;; Similar input -- contributed by ccm and highly winning.
+;;;
+;;; Reenter input, removing back to the last insert point if it exists. 
+;;;
+(defvar comint-last-similar-string "" 
+  "The string last used in a similar string search.")
+(defun comint-previous-similar-input (arg)
+  "Reenters the last input that matches the string typed so far.  If repeated 
+successively older inputs are reentered.  If arg is 1, it will go back
+in the history, if -1 it will go forward."
+  (interactive "p")
+  (if (not (comint-after-pmark-p))
+      (error "Not after process mark"))
+  (if (not (eq last-command 'comint-previous-similar-input))
+      (setq input-ring-index -1
+           comint-last-similar-string 
+           (buffer-substring 
+            (process-mark (get-buffer-process (current-buffer)))
+            (point))))
+  (let* ((size (length comint-last-similar-string))
+        (len (ring-length input-ring))
+        (n (+ input-ring-index arg))
+        entry)
+    (while (and (< n len) 
+               (or (< (length (setq entry (ring-ref input-ring n))) size)
+                   (not (equal comint-last-similar-string 
+                               (substring entry 0 size)))))
+      (setq n (+ n arg)))
+    (cond ((< n len)
+          (setq input-ring-index n)
+          (if (eq last-command 'comint-previous-similar-input)
+              (delete-region (mark) (point)) ; repeat
+              (push-mark (point)))           ; 1st time
+          (insert (substring entry size)))
+         (t (message "Not found.") (ding) (sit-for 1)))
+    (message "%d" (1+ input-ring-index))))
+
+
+
+
+
+
+
+
+
+(defun comint-send-input () 
+  "Send input to process.  After the process output mark, sends all text
+from the process mark to point as input to the process.  Before the
+process output mark, calls value of variable comint-get-old-input to retrieve
+old input, copies it to the end of the buffer, and sends it.  A terminal
+newline is also inserted into the buffer and sent to the process.  In either
+case, value of variable comint-input-sentinel is called on the input before
+sending it.  The input is entered into the input history ring, if value of
+variable comint-input-filter returns non-nil when called on the input.
+
+If variable comint-eol-on-send is non-nil, then point is moved to the end of
+line before sending the input.
+
+comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen
+according to the command interpreter running in the buffer. E.g.,
+If the interpreter is the csh,
+    comint-get-old-input is the default: take the current line, discard any
+        initial string matching regexp comint-prompt-regexp.
+    comint-input-sentinel monitors input for \"cd\", \"pushd\", and \"popd\" 
+        commands. When it sees one, it cd's the buffer.
+    comint-input-filter is the default: returns T if the input isn't all white
+       space.
+
+If the comint is Lucid Common Lisp, 
+    comint-get-old-input snarfs the sexp ending at point.
+    comint-input-sentinel does nothing.
+    comint-input-filter returns NIL if the input matches input-filter-regexp,
+        which matches (1) all whitespace (2) :a, :c, etc.
+
+Similarly for Soar, Scheme, etc.."
+  (interactive)
+  ;; Note that the input string does not include its terminal newline.
+  (let ((proc (get-buffer-process (current-buffer))))
+    (if (not proc) (error "Current buffer has no process")
+       (let* ((pmark (process-mark proc))
+              (pmark-val (marker-position pmark))
+              (input (if (>= (point) pmark-val)
+                         (progn (if comint-eol-on-send (end-of-line))
+                                (buffer-substring pmark (point)))
+                         (let ((copy (funcall comint-get-old-input)))
+                           (goto-char pmark)
+                           (insert copy)
+                           copy))))
+         (insert ?\n)
+         (if (funcall comint-input-filter input) (ring-insert input-ring input))
+         (funcall comint-input-sentinel input)
+         (funcall comint-input-sender proc input)
+         (set-marker (process-mark proc) (point))
+         (set-marker comint-last-input-end (point))))))
+
+(defun comint-get-old-input-default ()
+  "Default for comint-get-old-input: take the current line, and discard
+any initial text matching comint-prompt-regexp."
+  (save-excursion
+    (beginning-of-line)
+    (comint-skip-prompt)
+    (let ((beg (point)))
+      (end-of-line)
+      (buffer-substring beg (point)))))
+
+(defun comint-skip-prompt ()
+  "Skip past the text matching regexp comint-prompt-regexp. 
+If this takes us past the end of the current line, don't skip at all."
+  (let ((eol (save-excursion (end-of-line) (point))))
+    (if (and (looking-at comint-prompt-regexp)
+            (<= (match-end 0) eol))
+       (goto-char (match-end 0)))))
+
+
+(defun comint-after-pmark-p ()
+  "Is point after the process output marker?"
+  ;; Since output could come into the buffer after we looked at the point
+  ;; but before we looked at the process marker's value, we explicitly 
+  ;; serialise. This is just because I don't know whether or not emacs
+  ;; services input during execution of lisp commands.
+  (let ((proc-pos (marker-position
+                  (process-mark (get-buffer-process (current-buffer))))))
+    (<= proc-pos (point))))
+
+(defun comint-simple-send (proc string)
+  "Default function for sending to PROC input STRING.
+This just sends STRING plus a newline. To override this,
+set the hook COMINT-INPUT-SENDER."
+  (comint-send-string proc string)
+  (comint-send-string proc "\n"))
+
+(defun comint-bol (arg)
+  "Goes to the beginning of line, then skips past the prompt, if any.
+If a prefix argument is given (\\[universal-argument]), then no prompt skip 
+-- go straight to column 0.
+
+The prompt skip is done by skipping text matching the regular expression
+comint-prompt-regexp, a buffer local variable.
+
+If you don't like this command, reset c-a to beginning-of-line 
+in your hook, comint-mode-hook."
+  (interactive "P")
+  (beginning-of-line)
+  (if (null arg) (comint-skip-prompt)))
+
+;;; These two functions are for entering text you don't want echoed or
+;;; saved -- typically passwords to ftp, telnet, or somesuch.
+;;; Just enter m-x send-invisible and type in your line.
+
+(defun comint-read-noecho (prompt)
+  "Prompt the user with argument PROMPT. Read a single line of text
+without echoing, and return it. Note that the keystrokes comprising
+the text can still be recovered (temporarily) with \\[view-lossage]. This
+may be a security bug for some applications."
+  (let ((echo-keystrokes 0)
+       (answ "")
+       tem)
+    (if (and (stringp prompt) (not (string= (message prompt) "")))
+       (message prompt))
+    (while (not(or  (= (setq tem (read-char)) ?\^m)
+                   (= tem ?\n)))
+      (setq answ (concat answ (char-to-string tem))))
+    (message "")
+    answ))
+
+(defun send-invisible (str)
+  "Read a string without echoing, and send it to the process running
+in the current buffer. A new-line is additionally sent. String is not 
+saved on comint input history list.
+Security bug: your string can still be temporarily recovered with
+\\[view-lossage]."
+; (interactive (list (comint-read-noecho "Enter non-echoed text")))
+  (interactive "P") ; Defeat snooping via C-x esc
+  (let ((proc (get-buffer-process (current-buffer))))
+    (if (not proc) (error "Current buffer has no process")
+       (comint-send-string proc
+                           (if (stringp str) str
+                               (comint-read-noecho "Enter non-echoed text")))
+       (comint-send-string proc "\n"))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Low-level process communication
+
+(defvar comint-input-chunk-size 512
+  "*Long inputs send to comint processes are broken up into chunks of this size.
+If your process is choking on big inputs, try lowering the value.")
+
+(defun comint-send-string (proc str)
+  "Send PROCESS the contents of STRING as input.
+This is equivalent to process-send-string, except that long input strings
+are broken up into chunks of size comint-input-chunk-size. Processes
+are given a chance to output between chunks. This can help prevent processes
+from hanging when you send them long inputs on some OS's."
+  (let* ((len (length str))
+        (i (min len comint-input-chunk-size)))
+    (process-send-string proc (substring str 0 i))
+    (while (< i len)
+      (let ((next-i (+ i comint-input-chunk-size)))
+       (accept-process-output)
+       (process-send-string proc (substring str i (min len next-i)))
+       (setq i next-i)))))
+
+(defun comint-send-region (proc start end)
+  "Sends to PROC the region delimited by START and END.
+This is a replacement for process-send-region that tries to keep
+your process from hanging on long inputs. See comint-send-string."
+  (comint-send-string proc (buffer-substring start end)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Random input hackage
+
+(defun comint-kill-output ()
+  "Kill all output from interpreter since last input."
+  (interactive)
+  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
+    (kill-region comint-last-input-end pmark)
+    (goto-char pmark)    
+    (insert "*** output flushed ***\n")
+    (set-marker pmark (point))))
+
+(defun comint-show-output ()
+  "Display start of this batch of interpreter output at top of window.
+Also put cursor there."
+  (interactive)
+  (goto-char comint-last-input-end)
+  (backward-char)
+  (beginning-of-line)
+  (set-window-start (selected-window) (point))
+  (end-of-line))
+
+(defun comint-interrupt-subjob ()
+  "Interrupt the current subjob."
+  (interactive)
+  (interrupt-process nil comint-ptyp))
+
+(defun comint-kill-subjob ()
+  "Send kill signal to the current subjob."
+  (interactive)
+  (kill-process nil comint-ptyp))
+
+(defun comint-quit-subjob ()
+  "Send quit signal to the current subjob."
+  (interactive)
+  (quit-process nil comint-ptyp))
+
+(defun comint-stop-subjob ()
+  "Stop the current subjob.
+WARNING: if there is no current subjob, you can end up suspending
+the top-level process running in the buffer. If you accidentally do
+this, use \\[comint-continue-subjob] to resume the process. (This
+is not a problem with most shells, since they ignore this signal.)"
+  (interactive)
+  (stop-process nil comint-ptyp))
+
+(defun comint-continue-subjob ()
+  "Send CONT signal to process buffer's process group.
+Useful if you accidentally suspend the top-level process."
+  (interactive)
+  (continue-process nil comint-ptyp))
+
+(defun comint-kill-input ()
+  "Kill all text from last stuff output by interpreter to point."
+  (interactive)
+  (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
+        (p-pos (marker-position pmark)))
+    (if (> (point) p-pos)
+       (kill-region pmark (point)))))
+
+(defun comint-delchar-or-maybe-eof (arg)
+  "Delete ARG characters forward, or send an EOF to process if at end of buffer."
+  (interactive "p")
+  (if (eobp)
+      (process-send-eof)
+      (delete-char arg)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Support for source-file processing commands.
+;;;============================================================================
+;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
+;;; commands that process files of source text (e.g. loading or compiling
+;;; files). So the corresponding process-in-a-buffer modes have commands
+;;; for doing this (e.g., lisp-load-file). The functions below are useful
+;;; for defining these commands.
+;;;
+;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
+;;; and Soar, in that they don't know anything about file extensions.
+;;; So the compile/load interface gets the wrong default occasionally.
+;;; The load-file/compile-file default mechanism could be smarter -- it
+;;; doesn't know about the relationship between filename extensions and
+;;; whether the file is source or executable. If you compile foo.lisp
+;;; with compile-file, then the next load-file should use foo.bin for
+;;; the default, not foo.lisp. This is tricky to do right, particularly
+;;; because the extension for executable files varies so much (.o, .bin,
+;;; .lbin, .mo, .vo, .ao, ...).
+
+
+;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
+;;; commands.
+;;;
+;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
+;;; want to save the buffer before issuing any process requests to the command
+;;; interpreter.
+;;;
+;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
+;;; for the file to process.
+
+;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
+;;;============================================================================
+;;; This function computes the defaults for the load-file and compile-file
+;;; commands for tea, soar, cmulisp, and cmuscheme modes. 
+;;; 
+;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
+;;; source-file processing command. NIL if there hasn't been one yet.
+;;; - SOURCE-MODES is a list used to determine what buffers contain source
+;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
+;;; Typically, (lisp-mode) or (scheme-mode).
+;;; 
+;;; If the command is given while the cursor is inside a string, *and*
+;;; the string is an existing filename, *and* the filename is not a directory,
+;;; then the string is taken as default. This allows you to just position
+;;; your cursor over a string that's a filename and have it taken as default.
+;;;
+;;; If the command is given in a file buffer whose major mode is in
+;;; SOURCE-MODES, then the the filename is the default file, and the
+;;; file's directory is the default directory.
+;;; 
+;;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
+;;; then the default directory & file are what was used in the last source-file
+;;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
+;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
+;;; is the cwd, with no default file. (\"no default file\" = nil)
+;;; 
+;;; SOURCE-REGEXP is typically going to be something like (tea-mode)
+;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
+;;; for Soar programs, etc.
+;;; 
+;;; The function returns a pair: (default-directory . default-file).
+
+(defun comint-source-default (previous-dir/file source-modes)
+  (cond ((and buffer-file-name (memq major-mode source-modes))
+        (cons (file-name-directory    buffer-file-name)
+              (file-name-nondirectory buffer-file-name)))
+       (previous-dir/file)
+       (t
+        (cons default-directory nil))))
+
+
+;;; (COMINT-CHECK-SOURCE fname)
+;;;============================================================================
+;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
+;;; process-in-a-buffer modes), this function can be called on the filename.
+;;; If the file is loaded into a buffer, and the buffer is modified, the user
+;;; is queried to see if he wants to save the buffer before proceeding with
+;;; the load or compile.
+
+(defun comint-check-source (fname)
+  (let ((buff (get-file-buffer fname)))
+    (if (and buff
+            (buffer-modified-p buff)
+            (y-or-n-p (format "Save buffer %s first? "
+                              (buffer-name buff))))
+       ;; save BUFF.
+       (let ((old-buffer (current-buffer)))
+         (set-buffer buff)
+         (save-buffer)
+         (set-buffer old-buffer)))))
+
+
+;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
+;;;============================================================================
+;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
+;;; commands that process source files (like loading or compiling a file).
+;;; It prompts for the filename, provides a default, if there is one,
+;;; and returns the result filename.
+;;; 
+;;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
+;;; 
+;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
+;;; from the last source processing command.  SOURCE-MODES is a list of major
+;;; modes used to determine what file buffers contain source files.  (These
+;;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
+;;; then the filename reader will only accept a file that exists.
+;;; 
+;;; A typical use:
+;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
+;;;                                 '(lisp-mode) t))
+
+;;; This is pretty stupid about strings. It decides we're in a string
+;;; if there's a quote on both sides of point on the current line.
+(defun comint-extract-string ()
+  "Returns string around point that starts the current line or nil." 
+  (save-excursion
+    (let* ((point (point))
+          (bol (progn (beginning-of-line) (point)))
+          (eol (progn (end-of-line) (point)))
+          (start (progn (goto-char point) 
+                        (and (search-backward "\"" bol t) 
+                             (1+ (point)))))
+          (end (progn (goto-char point)
+                      (and (search-forward "\"" eol t)
+                           (1- (point))))))
+      (and start end
+          (buffer-substring start end)))))
+
+(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
+  (let* ((def (comint-source-default prev-dir/file source-modes))
+         (stringfile (comint-extract-string))
+        (sfile-p (and stringfile
+                      (file-exists-p stringfile)
+                      (not (file-directory-p stringfile))))
+        (defdir  (if sfile-p (file-name-directory stringfile)
+                      (car def)))
+        (deffile (if sfile-p (file-name-nondirectory stringfile)
+                      (cdr def)))
+        (ans (read-file-name (if deffile (format "%s(default %s) "
+                                                 prompt    deffile)
+                                 prompt)
+                             defdir
+                             (concat defdir deffile)
+                             mustmatch-p)))
+    (list (expand-file-name (substitute-in-file-name ans)))))
+
+;;; I am somewhat divided on this string-default feature. It seems
+;;; to violate the principle-of-least-astonishment, in that it makes
+;;; the default harder to predict, so you actually have to look and see
+;;; what the default really is before choosing it. This can trip you up.
+;;; On the other hand, it can be useful, I guess. I would appreciate feedback
+;;; on this.
+;;;     -Olin
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Simple process query facility.
+;;; ===========================================================================
+;;; This function is for commands that want to send a query to the process
+;;; and show the response to the user. For example, a command to get the
+;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
+;;; to an inferior Common Lisp process.
+;;; 
+;;; This simple facility just sends strings to the inferior process and pops
+;;; up a window for the process buffer so you can see what the process
+;;; responds with.  We don't do anything fancy like try to intercept what the
+;;; process responds with and put it in a pop-up window or on the message
+;;; line. We just display the buffer. Low tech. Simple. Works good.
+
+;;; Send to the inferior process PROC the string STR. Pop-up but do not select
+;;; a window for the inferior process so that its response can be seen.
+(defun comint-proc-query (proc str)
+  (let* ((proc-buf (process-buffer proc))
+        (proc-mark (process-mark proc)))
+    (display-buffer proc-buf)
+    (set-buffer proc-buf) ; but it's not the selected *window*
+    (let ((proc-win (get-buffer-window proc-buf))
+         (proc-pt (marker-position proc-mark)))
+      (comint-send-string proc str) ; send the query
+      (accept-process-output proc)  ; wait for some output
+      ;; Try to position the proc window so you can see the answer.
+      ;; This is bogus code. If you delete the (sit-for 0), it breaks.
+      ;; I don't know why. Wizards invited to improve it.
+      (if (not (pos-visible-in-window-p proc-pt proc-win))
+         (let ((opoint (window-point proc-win)))
+           (set-window-point proc-win proc-mark) (sit-for 0)
+           (if (not (pos-visible-in-window-p opoint proc-win))
+               (push-mark opoint)
+               (set-window-point proc-win opoint)))))))
+
+
+
+
+
+
+
+
+
+
+
+;;; Filename completion in a buffer
+;;; ===========================================================================
+;;; Useful completion functions, courtesy of the Ergo group.
+;;; M-<Tab> will complete the filename at the cursor as much as possible
+;;; M-? will display a list of completions in the help buffer.
+
+;;; Three commands:
+;;; comint-dynamic-complete            Complete filename at point.
+;;; comint-dynamic-list-completions    List completions in help buffer.
+;;; comint-replace-by-expanded-filename        Expand and complete filename at point;
+;;;                                    replace with expanded/completed name.
+
+;;; These are not installed in the comint-mode keymap. But they are
+;;; available for people who want them. Shell-mode installs them:
+;;; (define-key cmushell-mode-map "\M-\t" 'comint-dynamic-complete)
+;;; (define-key cmushell-mode-map "\M-?"  'comint-dynamic-list-completions)))
+;;;
+;;; Commands like this are fine things to put in load hooks if you
+;;; want them present in specific modes. Example:
+;;; (setq cmushell-load-hook
+;;;       '((lambda () (define-key lisp-mode-map "\M-\t"
+;;;                               'comint-replace-by-expanded-filename))))
+;;;          
+
+
+(defun comint-match-partial-pathname ()
+  "Returns the string of an existing filename or causes an error."
+  (if (save-excursion (backward-char 1) (looking-at "\\s ")) ""
+      (save-excursion
+       (re-search-backward "[^~/A-Za-z0-9---_.$#,]+")
+       (re-search-forward "[~/A-Za-z0-9---_.$#,]+")
+       (substitute-in-file-name 
+         (buffer-substring (match-beginning 0) (match-end 0))))))
+
+
+(defun comint-replace-by-expanded-filename ()
+"Replace the filename at point with an expanded, canonicalised, and
+completed replacement.
+\"Expanded\" means environment variables (e.g., $HOME) and ~'s are
+replaced with the corresponding directories.  \"Canonicalised\" means ..
+and \. are removed, and the filename is made absolute instead of relative.
+See functions expand-file-name and substitute-in-file-name. See also
+comint-dynamic-complete."
+  (interactive)
+  (let* ((pathname (comint-match-partial-pathname))
+        (pathdir (file-name-directory pathname))
+        (pathnondir (file-name-nondirectory pathname))
+        (completion (file-name-completion pathnondir
+                                          (or pathdir default-directory))))
+    (cond ((null completion)
+          (message "No completions of %s." pathname)
+          (ding))
+         ((eql completion t)
+          (message "Unique completion."))
+         (t                            ; this means a string was returned.
+          (delete-region (match-beginning 0) (match-end 0))
+          (insert (expand-file-name (concat pathdir completion)))))))
+
+
+(defun comint-dynamic-complete ()
+  "Dynamically complete the filename at point.
+This function is similar to comint-replace-by-expanded-filename, except
+that it won't change parts of the filename already entered in the buffer; 
+it just adds completion characters to the end of the filename."
+  (interactive)
+  (let* ((pathname (comint-match-partial-pathname))
+        (pathdir (file-name-directory pathname))
+        (pathnondir (file-name-nondirectory pathname))
+        (completion (file-name-completion  pathnondir
+                                          (or pathdir default-directory))))
+    (cond ((null completion)
+          (message "No completions of %s." pathname)
+          (ding))
+         ((eql completion t)
+          (message "Unique completion."))
+         (t                            ; this means a string was returned.
+          (goto-char (match-end 0))
+          (insert (substring completion (length pathnondir)))))))
+
+(defun comint-dynamic-list-completions ()
+  "List in help buffer all possible completions of the filename at point."
+  (interactive)
+  (let* ((pathname (comint-match-partial-pathname))
+        (pathdir (file-name-directory pathname))
+        (pathnondir (file-name-nondirectory pathname))
+        (completions
+         (file-name-all-completions pathnondir
+                                    (or pathdir default-directory))))
+    (cond ((null completions)
+          (message "No completions of %s." pathname)
+          (ding))
+         (t
+          (let ((conf (current-window-configuration)))
+            (with-output-to-temp-buffer "*Help*"
+              (display-completion-list completions))
+            (sit-for 0)
+            (message "Hit space to flush.")
+            (let ((ch (read-char)))
+              (if (= ch ?\ )
+                  (set-window-configuration conf)
+                  (setq unread-command-char ch))))))))
+
+; Ergo bindings
+; (global-set-key "\M-\t" 'comint-replace-by-expanded-filename)
+; (global-set-key "\M-?" 'comint-dynamic-list-completions)
+; (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Converting process modes to use comint mode
+;;; ===========================================================================
+;;; Several gnu packages (tex-mode, background, dbx, gdb, kermit, prolog, 
+;;; telnet are some) use the shell package as clients. Most of them would
+;;; be better off using the comint package, but they predate it. 
+;;;
+;;; Altering these packages to use comint mode should greatly
+;;; improve their functionality, and is fairly easy.
+;;; 
+;;; Renaming variables
+;;; Most of the work is renaming variables and functions. These are the common
+;;; ones:
+;;; Local variables:
+;;;    last-input-end          comint-last-input-end
+;;;    last-input-start        <unnecessary>
+;;;    shell-prompt-pattern    comint-prompt-regexp
+;;;     shell-set-directory-error-hook <no equivalent>
+;;; Miscellaneous:
+;;;    shell-set-directory     <unnecessary>
+;;;    shell-mode-map          comint-mode-map
+;;; Commands:
+;;;    shell-send-input        comint-send-input
+;;;    shell-send-eof          comint-delchar-or-maybe-eof
+;;;    kill-shell-input        comint-kill-input
+;;;    interrupt-shell-subjob  comint-interrupt-subjob
+;;;    stop-shell-subjob       comint-stop-subjob
+;;;    quit-shell-subjob       comint-quit-subjob
+;;;    kill-shell-subjob       comint-kill-subjob
+;;;    kill-output-from-shell  comint-kill-output
+;;;    show-output-from-shell  comint-show-output
+;;;    copy-last-shell-input   Use comint-previous-input/comint-next-input
+;;;
+;;; LAST-INPUT-START is no longer necessary because inputs are stored on the
+;;; input history ring. SHELL-SET-DIRECTORY is gone, its functionality taken
+;;; over by SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-sentinel.
+;;; Comint mode does not provide functionality equivalent to 
+;;; shell-set-directory-error-hook; it is gone.
+;;; 
+;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
+;;; *not* create the comint-mode local variables in your foo-mode function.
+;;; This is not modular.  Instead, call comint-mode, and let *it* create the
+;;; necessary comint-specific local variables. Then create the
+;;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
+;;; be foo-mode-map, and its mode to be foo-mode.  Set the comint-mode hooks
+;;; (comint-prompt-regexp, comint-input-filter, comint-input-sentinel,
+;;; comint-get-old-input) that need to be different from the defaults.  Call
+;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
+;;; comint-mode will take care of it. The following example, from cmushell.el,
+;;; is typical:
+;;; 
+;;; (defun shell-mode ()
+;;;   (interactive)
+;;;   (comint-mode)
+;;;   (setq comint-prompt-regexp shell-prompt-pattern)
+;;;   (setq major-mode 'shell-mode)
+;;;   (setq mode-name "Shell")
+;;;   (cond ((not shell-mode-map)
+;;;         (setq shell-mode-map (full-copy-sparse-keymap comint-mode-map))
+;;;         (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete)
+;;;         (define-key shell-mode-map "\M-?"
+;;;                      'comint-dynamic-list-completions)))
+;;;   (use-local-map shell-mode-map)
+;;;   (make-local-variable 'shell-directory-stack)
+;;;   (setq shell-directory-stack nil)
+;;;   (setq comint-input-sentinel 'shell-directory-tracker)
+;;;   (run-hooks 'shell-mode-hook))
+;;;
+;;;
+;;; Note that make-comint is different from make-shell in that it
+;;; doesn't have a default program argument. If you give make-shell
+;;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
+;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument
+;;; of NIL, it barfs. Adjust your code accordingly...
+;;;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;; Do the user's customisation...
+
+(defvar comint-load-hook nil
+  "This hook is run when comint is loaded in.
+This is a good place to put keybindings.")
+       
+(run-hooks 'comint-load-hook)
+
+;;; Change log:
+;;; 9/12/89 
+;;;  - Souped up the filename expansion procedures.
+;;;    Doc strings are much clearer and more detailed.
+;;;    Fixed a bug where doing a filename completion when the point
+;;;    was in the middle of the filename instead of at the end would lose.
+;;;
+;;; 2/17/90 
+;;;  - Souped up the command history stuff so that text inserted
+;;;    by comint-previous-input-matching is removed by following
+;;;    command history recalls. comint-next/previous-input-matching
+;;;    is now much more smoothly integrated w/the command history stuff.
+;;;  - Added comint-eol-on-send flag and comint-input-sender hook.
+;;;    Comint-input-sender based on code contributed by Jeff Peck
+;;;    (peck@sun.com).
+;;;
+;;; 3/13/90 ccm@cmu.cs.edu
+;;;  - Added comint-previous-similar-input for looking up similar inputs.
+;;;  - Added comint-send-and-get-output to allow snarfing input from
+;;;    buffer. 
+;;;  - Added the ability to pick up a source file by positioning over
+;;;    a string in comint-get-source.
+;;;  - Added add-hook to make it a little easier for the user to use
+;;;    multiple hooks.
+;;;  
+;;; 5/22/90 shivers
+;;; - Moved Chris' multiplexed ipc stuff to comint-ipc.el.
+;;; - Altered Chris' comint-get-source string feature. The string
+;;;   is only offered as a default if it names an existing file.
+;;; - Changed comint-exec to directly crank up the process, instead
+;;;   of calling the env program. This made background.el happy.
+;;; - Added new buffer-local var comint-ptyp. The problem is that
+;;;   the signalling functions don't work as advertised. If you are
+;;;   communicating via pipes, the CURRENT-GROUP arg is supposed to
+;;;   be ignored, but, unfortunately it seems to be the case that you
+;;;   must pass a NIL for this arg in the pipe case. COMINT-PTYP
+;;;   is a flag that tells whether the process is communicating
+;;;   via pipes or a pty. The comint signalling functions use it
+;;;   to determine the necessary CURRENT-GROUP arg value. The bug
+;;;   has been reported to the Gnu folks.
+;;; - comint-dynamic-complete flushes the help window if you hit space
+;;;   after you execute it.
+;;; - Added functions comint-send-string, comint-send-region and var 
+;;;   comint-input-chunk-size.  comint-send-string tries to prevent processes
+;;;   from hanging when you send them long strings by breaking them into
+;;;   chunks and allowing process output between chunks. I got the idea from
+;;;   Eero Simoncelli's Common Lisp package. Note that using
+;;;   comint-send-string means that the process buffer's contents can change
+;;;   during a call!  If you depend on process output only happening between
+;;;   toplevel commands, this could be a problem. In such a case, use
+;;;   process-send-string instead. If this is a problem for people, I'd like
+;;;   to hear about it.
+;;; - Added comint-proc-query as a simple mechanism for commands that
+;;;   want to query an inferior process and display its response. For a
+;;;   typical use, see lisp-show-arglist in cmulisp.el.
+;;; - Added constant comint-version, which is now "2.01".
+;;;
+;;; 6/14/90 shivers
+;;; - Had comint-update-env defined twice. Removed extra copy. Also
+;;;   renamed mem to be comint-mem, for modularity. The duplication
+;;;   was reported by Michael Meissner.
+;;; 6/16/90 shivers
+;;; - Emacs has two different mechanisms for maintaining the process
+;;;   environment, determined at compile time by the MAINTAIN-ENVIRONMENT
+;;;   #define. One uses the process-environment global variable, and
+;;;   one uses a getenv/setenv interface. comint-exec assumed the
+;;;   process-environment interface; it has been generalised (with
+;;;   comint-exec-1) to handle both cases. Pretty bogus. We could,
+;;;   of course, skip all this and just use the etc/env program to
+;;;   handle the environment tweaking, but that obscures process
+;;;   queries that other modules (like background.el) depend on. etc/env
+;;;   is also fairly bogus. This bug, and some of the fix code was
+;;;   reported by Dan Pierson.
+;;;
+;;; 9/5/90 shivers
+;;; - Changed make-variable-buffer-local's to make-local-variable's.
+;;;   This leaves non-comint-mode buffers alone. Stephane Payrard
+;;;   reported the sloppy useage.
+;;; - You can now go from comint-previous-similar-input to
+;;;   comint-previous-input with no problem.
+
+
diff --git a/ghc/CONTRIB/haskell-modes/yale/original/haskell-menu.el b/ghc/CONTRIB/haskell-modes/yale/original/haskell-menu.el
new file mode 100644 (file)
index 0000000..9f851c6
--- /dev/null
@@ -0,0 +1,43 @@
+;;; haskell-menu.el -- support for Haskell menubar functions
+;;;
+;;; author :  Sandra Loosemore
+;;; date   :  15 Jun 1994
+;;;
+
+
+;;; Add an entry to the main menu bar
+
+(defvar menu-bar-haskell-menu (make-sparse-keymap "Haskell"))
+(define-key haskell-mode-map [menu-bar haskell]
+  (cons "Haskell" menu-bar-haskell-menu))
+(define-key inferior-haskell-mode-map [menu-bar haskell]
+  (cons "Haskell" menu-bar-haskell-menu))
+(define-key ht-mode-map [menu-bar haskell]
+  (cons "Haskell" menu-bar-haskell-menu))
+
+
+;;; Define the functions.  They get listed on the menu in the reverse
+;;; order that they're defined.
+
+(define-key menu-bar-haskell-menu [haskell-tutorial]
+  '("Tutorial" . haskell-tutorial))
+(define-key menu-bar-haskell-menu [haskell-optimizers]
+  '("Optimizers..." . haskell-optimizers))
+(define-key menu-bar-haskell-menu [haskell-printers]
+  '("Printers..." . haskell-printers))
+(define-key menu-bar-haskell-menu [haskell-get-pad]
+  '("Scratch Pad" . haskell-get-pad))
+(define-key menu-bar-haskell-menu [haskell-compile]
+  '("Compile File..." . haskell-compile))
+(define-key menu-bar-haskell-menu [haskell-run-file]
+  '("Run File..." . haskell-run-file))
+(define-key menu-bar-haskell-menu [haskell-load]
+  '("Load File..." . haskell-load))
+(define-key menu-bar-haskell-menu [haskell-report-type]
+  '("Type Check Expression..." . haskell-report-type))
+(define-key menu-bar-haskell-menu [haskell-run]
+  '("Run Dialogue..." . haskell-run))
+(define-key menu-bar-haskell-menu [haskell-eval]
+  '("Eval Expression..." . haskell-eval))
+
+(provide 'haskell-menu)
diff --git a/ghc/CONTRIB/haskell-modes/yale/original/haskell.el b/ghc/CONTRIB/haskell-modes/yale/original/haskell.el
new file mode 100644 (file)
index 0000000..9b4c95b
--- /dev/null
@@ -0,0 +1,1710 @@
+;;; ==================================================================
+;;; File:              haskell.el                                 ;;;
+;;;                                                                ;;;
+;;;                    Author:         A. Satish Pai              ;;;
+;;;                                     Maria M. Gutierrez         ;;;
+;;;                                     Dan Rabin (Jul-1991)       ;;;
+;;; ==================================================================
+
+;;; Description: Haskell mode for GNU Emacs.
+
+;;; Related files:  comint.el
+
+;;; Contents:
+
+;;;  Update Log
+
+;;;  Known bugs / problems
+;;;  - the haskell editing mode (indentation, etc) is still missing.
+;;;  - the handling for errors from haskell needs to be rethought.
+;;;  - general cleanup of code.
+
+
+;;;  Errors generated
+
+;;; ==================================================================
+;;; Haskell mode for editing files, and an Inferior Haskell mode to
+;;; run a Haskell process. This file contains stuff snarfed and 
+;;; modified from tea.el, scheme.el, etc. This file may be freely
+;;; modified; however, if you have any bug-corrections or useful
+;;; improvements, I'd appreciate it if you sent me the mods so that
+;;; I can merge them into the version I maintain.
+;;;
+;;; The inferior Haskell mode requires comint.el. 
+;;; 
+;;; You might want to add this to your .emacs to go automagically
+;;; into Haskell mode while finding .hs files.
+;;; 
+;;;   (setq auto-mode-alist 
+;;;         (cons '("\\.hs$" . haskell-mode)
+;;;                auto-mode-alist)_)
+;;;
+;;; To use this file, set up your .emacs to autoload this file for 
+;;; haskell-mode. For example:
+;;; 
+;;;    (autoload 'haskell-mode "$HASKELL/emacs-tools/haskell.elc" 
+;;;       "Load Haskell mode" t)
+;;;
+;;;    (autoload 'run-mode "$HASKELL/emacs-tools/haskell.elc" 
+;;;       "Load Haskell mode" t)
+;;;
+;;; [Note: The path name given above is Yale specific!! Modify as
+;;; required.]
+;;; ================================================================
+
+;;; Announce your existence to the world at large.
+
+(provide 'haskell)
+
+
+;;; Load these other files.
+
+(require 'comint)        ; Olin Shivers' comint mode is the substratum
+
+
+
+\f
+;;; ================================================================
+;;; Declare a bunch of variables.
+;;; ================================================================
+
+
+;;; User settable (via M-x set-variable and M-x edit-options)
+
+(defvar haskell-program-name (getenv "HASKELLPROG")
+  "*Program invoked by the haskell command.")
+
+(defvar haskell-auto-create-process t
+  "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code.")
+
+(defvar haskell-auto-switch-input t
+  "*If not nil, jump to *haskell* buffer automatically on input request.")
+
+(defvar haskell-ask-before-saving t
+  "*If not nil, ask before saving random haskell-mode buffers.")
+
+(defvar haskell-initial-printers '("interactive")
+  "*Printers to set when starting a new Haskell process.")
+
+
+;;; Pad/buffer Initialization variables
+
+(defvar *haskell-buffer* "*haskell*"
+  "Name of the haskell process buffer")
+
+(defvar haskell-main-pad "\*Main-pad\*"
+  "Scratch pad associated with module Main")
+
+(defvar haskell-main-module "Main")
+
+
+(defvar *last-loaded* nil)
+(defvar *last-module* haskell-main-module)
+(defvar *last-pad* haskell-main-pad)
+
+
+;;; These are used for haskell-tutorial mode.
+
+(defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.lhs")
+(defvar *ht-temp-buffer* nil)
+(defvar *ht-file-buffer* "Haskell-Tutorial-Master")
+
+
+\f
+;;; ================================================================
+;;; Haskell editing mode stuff
+;;; ================================================================
+
+;;; Leave this place alone...
+;;; The definitions below have been pared down to the bare
+;;; minimum; they will be restored later.
+;;;
+;;; -Satish 2/5.
+
+;;; Keymap for Haskell mode
+(defvar haskell-mode-map (make-sparse-keymap)
+  "Keymap used for haskell-mode")
+
+(defun haskell-establish-key-bindings (keymap)
+  (define-key keymap "\C-ce"    'haskell-eval)
+  (define-key keymap "\C-cr"    'haskell-run)
+  (define-key keymap "\C-ct"    'haskell-report-type)
+  (define-key keymap "\C-cm"    'haskell-run-main)
+  (define-key keymap "\C-c\C-r" 'haskell-run-file)
+  (define-key keymap "\C-cp"    'haskell-get-pad)
+  (define-key keymap "\C-c\C-o" 'haskell-optimizers)
+  (define-key keymap "\C-c\C-p" 'haskell-printers)
+  (define-key keymap "\C-cc"    'haskell-compile)
+  (define-key keymap "\C-cl"    'haskell-load)
+  (define-key keymap "\C-ch"    'haskell-switch)
+  (define-key keymap "\C-c\C-k" 'haskell-kill)
+  (define-key keymap "\C-c:"    'haskell-command)
+  (define-key keymap "\C-cq"    'haskell-exit)
+  (define-key keymap "\C-ci"    'haskell-interrupt)
+  (define-key keymap "\C-cu"    'haskell-edit-unit))
+
+
+(haskell-establish-key-bindings haskell-mode-map)
+
+
+(defvar haskell-mode-syntax-table nil
+  "Syntax table used for haskell-mode")
+
+(if haskell-mode-syntax-table
+    nil
+    (setq haskell-mode-syntax-table (standard-syntax-table)))
+
+;;; Command for invoking the Haskell mode
+(defun haskell-mode nil
+  "Major mode for editing Haskell code to run in Emacs
+The following commands are available:
+\\{haskell-mode-map}
+
+A Haskell process can be fired up with \"M-x haskell\". 
+
+Customization: Entry to this mode runs the hooks that are the value of variable 
+haskell-mode-hook.
+
+Windows:
+
+There are 3 types of windows associated with Haskell mode.  They are:
+   *haskell*:  which is the process window.
+   Pad:        which are buffers available for each module.  It is here
+               where you want to test things before preserving them in a
+               file.  Pads are always associated with a module.
+               When issuing a command:
+                 The pad and its associated module are sent to the Haskell
+                 process prior to the execution of the command.
+   .hs:        These are the files where Haskell programs live.  They
+               have .hs as extension.
+               When issuing a command:
+                 The file is sent to the Haskell process prior to the
+                 execution of the command.
+
+Commands:
+
+Each command behaves differently according to the type of the window in which 
+the cursor is positioned when the command is issued .
+
+haskell-eval:   \\[haskell-eval]
+  Always promts user for a Haskell expression to be evaluated.  If in a
+  .hs file buffer, then the cursor tells which module is the current 
+  module and the pad for that module (if any) gets loaded as well.
+
+haskell-run:    \\[haskell-run]
+  Always queries for a variable of type Dialogue to be evaluated.
+
+haskell-run-main:    \\[haskell-run-main]
+  Run Dialogue named main in the current module.
+
+haskell-report-type:   \\[haskell-report-type]
+  Like haskell-eval, but prints the type of the expression without
+  evaluating it.
+
+haskell-mode:   \\[haskell-mode]
+  Puts the current buffer in haskell mode.
+
+haskell-compile:   \\[haskell-compile]
+  Compiles file in current buffer.
+
+haskell-load:   \\[haskell-load]
+  Loads file in current buffer.
+
+haskell-run-file:   \\[haskell-run-file]
+  Runs file in the current buffer.
+
+haskell-pad:   \\[haskell-pad]
+  Creates a scratch pad for the current module.
+
+haskell-optimizers:  \\[haskell-optimizers]
+  Shows the list of available optimizers.  Commands for turning them on/off.
+
+haskell-printers:  \\[haskell-printers]
+  Shows the list of available printers.  Commands for turning them on/off.
+
+haskell-command:   \\[haskell-command]
+  Prompts for a command to be sent to the command interface.  You don't
+  need to put the : before the command.
+
+haskell-quit:   \\[haskell-quit]
+  Terminates the haskell process.
+
+haskell-switch:   \\[haskell-switch]
+  Switches to the inferior Haskell buffer (*haskell*) and positions the
+  cursor at the end of the buffer.
+
+haskell-kill:  \\[haskell-kill]
+  Kill the current contents of the *haskell* buffer.
+  
+haskell-interrupt:   \\[haskell-interrupt]
+  Interrupts haskell process and resets it.
+
+haskell-edit-unit:   \\[haskell-edit-unit]
+  Edit the .hu file for the unit containing this file.
+"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map haskell-mode-map)
+  (setq major-mode 'haskell-mode)
+  (setq mode-name "Haskell")
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'indent-relative-maybe)
+  ;(setq local-abbrev-table haskell-mode-abbrev-table)
+  (set-syntax-table haskell-mode-syntax-table)
+  ;(setq tab-stop-list haskell-tab-stop-list) ;; save old list??
+  (run-hooks 'haskell-mode-hook))
+
+\f
+;;;================================================================
+;;; Inferior Haskell stuff
+;;;================================================================
+
+
+(defvar inferior-haskell-mode-map (full-copy-sparse-keymap comint-mode-map))
+
+(haskell-establish-key-bindings inferior-haskell-mode-map)
+(define-key inferior-haskell-mode-map "\C-m"     'haskell-send-input)
+
+(defvar haskell-source-modes '(haskell-mode)
+  "*Used to determine if a buffer contains Haskell source code.
+If it's loaded into a buffer that is in one of these major modes, 
+it's considered a Haskell source file.")
+
+(defvar haskell-prompt-pattern "^[A-Z]\\([A-Z]\\|[a-z]\\|[0-9]\\)*>\\s-*"
+  "Regular expression capturing the Haskell system prompt.")
+
+(defvar haskell-prompt-ring ()
+  "Keeps track of input to haskell process from the minibuffer")
+
+(defun inferior-haskell-mode-variables ()
+  nil)  
+
+
+;;; INFERIOR-HASKELL-MODE (adapted from comint.el)
+
+(defun inferior-haskell-mode ()
+  "Major mode for interacting with an inferior Haskell process.
+
+The following commands are available:
+\\{inferior-haskell-mode-map}
+
+A Haskell process can be fired up with \"M-x haskell\". 
+
+Customization: Entry to this mode runs the hooks on comint-mode-hook and
+inferior-haskell-mode-hook (in that order).
+
+You can send text to the inferior Haskell process from other buffers containing
+Haskell source.  
+
+
+Windows:
+
+There are 3 types of windows in the inferior-haskell-mode.  They are:
+   *haskell*:  which is the process window.
+   Pad:        which are buffers available for each module.  It is here
+               where you want to test things before preserving them in a
+               file.  Pads are always associated with a module.
+               When issuing a command:
+                 The pad and its associated module are sent to the Haskell
+                 process prior to the execution of the command.
+   .hs:        These are the files where Haskell programs live.  They
+               have .hs as extension.
+               When issuing a command:
+                 The file is sent to the Haskell process prior to the
+                 execution of the command.
+
+Commands:
+
+Each command behaves differently according to the type of the window in which 
+the cursor is positioned when the command is issued.
+
+haskell-eval:   \\[haskell-eval]
+  Always promts user for a Haskell expression to be evaluated.  If in a
+  .hs file, then the cursor tells which module is the current module and
+  the pad for that module (if any) gets loaded as well.
+
+haskell-run:    \\[haskell-run]
+  Always queries for a variable of type Dialogue to be evaluated.
+
+haskell-run-main:    \\[haskell-run-main]
+  Run Dialogue named main.
+
+haskell-report-type:   \\[haskell-report-type]
+  Like haskell-eval, but prints the type of the expression without
+  evaluating it.
+
+haskell-mode:   \\[haskell-mode]
+  Puts the current buffer in haskell mode.
+
+haskell-compile:   \\[haskell-compile]
+  Compiles file in current buffer.
+
+haskell-load:   \\[haskell-load]
+  Loads file in current buffer.
+
+haskell-run-file:   \\[haskell-run-file]
+  Runs file in the current buffer.
+
+haskell-pad:   \\[haskell-pad]
+  Creates a scratch pad for the current module.
+
+haskell-optimizers:  \\[haskell-optimizers]
+  Shows the list of available optimizers.  Commands for turning them on/off.
+
+haskell-printers:  \\[haskell-printers]
+  Shows the list of available printers.  Commands for turning them on/off.
+
+haskell-command:   \\[haskell-command]
+  Prompts for a command to be sent to the command interface.  You don't
+  need to put the : before the command.
+
+haskell-quit:   \\[haskell-quit]
+  Terminates the haskell process.
+
+haskell-switch:   \\[haskell-switch]
+  Switches to the inferior Haskell buffer (*haskell*) and positions the
+  cursor at the end of the buffer.
+
+haskell-kill:  \\[haskell-kill]
+  Kill the current contents of the *haskell* buffer.
+  
+haskell-interrupt:   \\[haskell-interrupt]
+  Interrupts haskell process and resets it.
+
+haskell-edit-unit:   \\[haskell-edit-unit]
+  Edit the .hu file for the unit containing this file.
+
+The usual comint functions are also available. In particular, the 
+following are all available:
+
+comint-bol: Beginning of line, but skip prompt. Bound to C-a by default.
+comint-delchar-or-maybe-eof: Delete char, unless at end of buffer, in 
+            which case send EOF to process. Bound to C-d by default.
+
+Note however, that the default keymap bindings provided shadow some of
+the default comint mode bindings, so that you may want to bind them 
+to your choice of keys. 
+
+Comint mode's dynamic completion of filenames in the buffer is available.
+(Q.v. comint-dynamic-complete, comint-dynamic-list-completions.)
+
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+
+  (interactive)
+  (comint-mode)
+  (setq comint-prompt-regexp haskell-prompt-pattern)
+  ;; Customise in inferior-haskell-mode-hook
+  (inferior-haskell-mode-variables) 
+  (setq major-mode 'inferior-haskell-mode)
+  (setq mode-name "Inferior Haskell")
+  (setq mode-line-process '(": %s : busy"))
+  (use-local-map inferior-haskell-mode-map)
+  (setq comint-input-filter 'haskell-input-filter)
+  (setq comint-input-sentinel 'ignore)
+  (setq comint-get-old-input 'haskell-get-old-input)
+  (run-hooks 'inferior-haskell-mode-hook)
+    ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
+    ;The test is so we don't lose history if we run comint-mode twice in
+    ;a buffer.
+  (setq haskell-prompt-ring (make-ring input-ring-size)))
+
+
+(defun haskell-input-filter (str)
+  "Don't save whitespace."
+  (not (string-match "\\s *" str)))
+
+
+\f
+;;; ==================================================================
+;;; Random utilities
+;;; ==================================================================
+
+
+;;; This keeps track of the status of the haskell process.
+;;; Values are:
+;;; busy -- The process is busy.
+;;; ready -- The process is ready for a command.
+;;; input -- The process is waiting for input.
+;;; debug -- The process is in the debugger.
+
+(defvar *haskell-status* 'busy
+  "Status of the haskell process")
+
+(defun set-haskell-status (value)
+  (setq *haskell-status* value)
+  (haskell-update-mode-line))
+
+(defun get-haskell-status ()
+  *haskell-status*)
+
+(defun haskell-update-mode-line ()
+  (save-excursion
+    (set-buffer *haskell-buffer*)
+    (cond ((eq *haskell-status* 'ready)
+          (setq mode-line-process '(": %s: ready")))
+         ((eq *haskell-status* 'input)
+          (setq mode-line-process '(": %s: input")))
+         ((eq *haskell-status* 'busy)
+          (setq mode-line-process '(": %s: busy")))
+         ((eq *haskell-status* 'debug)
+          (setq mode-line-process '(": %s: debug")))
+         (t
+          (haskell-mode-error "Confused about status of haskell process!")))
+    ;; Yes, this is the officially sanctioned technique for forcing
+    ;; a redisplay of the mode line.
+    (set-buffer-modified-p (buffer-modified-p))))
+
+
+(defun haskell-send-to-process (string)
+  (process-send-string "haskell" string)
+  (process-send-string "haskell" "\n"))
+
+
+\f
+;;; ==================================================================
+;;; Handle input in haskell process buffer; history commands.
+;;; ==================================================================
+
+(defun haskell-get-old-input ()
+  "Get old input text from Haskell process buffer."
+  (save-excursion
+    (if (re-search-forward haskell-prompt-pattern (point-max) 'move)
+       (goto-char (match-beginning 0)))
+    (cond ((re-search-backward haskell-prompt-pattern (point-min) t)
+          (comint-skip-prompt)
+          (let ((temp  (point)))
+            (end-of-line)
+            (buffer-substring temp (point)))))))
+
+
+(defun haskell-send-input ()
+  "Send input to Haskell while in the process buffer"
+  (interactive)
+  (if (eq (get-haskell-status) 'debug)
+      (comint-send-input)
+      (haskell-send-input-aux)))
+
+(defun haskell-send-input-aux ()
+  ;; Note that the input string does not include its terminal newline.
+  (let ((proc (get-buffer-process (current-buffer))))
+    (if (not proc)
+       (haskell-mode-error "Current buffer has no process!")
+       (let* ((pmark (process-mark proc))
+              (pmark-val (marker-position pmark))
+              (input (if (>= (point) pmark-val)
+                         (buffer-substring pmark (point))
+                         (let ((copy (funcall comint-get-old-input)))
+                           (goto-char pmark)
+                           (insert copy)
+                           copy))))
+         (insert ?\n)
+         (if (funcall comint-input-filter input)
+             (ring-insert input-ring input))
+         (funcall comint-input-sentinel input)
+         (set-marker (process-mark proc) (point))
+         (set-marker comint-last-input-end (point))
+         (haskell-send-to-process input)))))
+
+
+\f
+;;; ==================================================================
+;;; Minibuffer input stuff
+;;; ==================================================================
+
+;;; Haskell input history retrieval commands   (taken from comint.el)
+;;; M-p -- previous input    M-n -- next input
+
+(defvar haskell-minibuffer-local-map nil
+  "Local map for minibuffer when in Haskell")
+
+(if haskell-minibuffer-local-map
+    nil
+    (progn
+      (setq haskell-minibuffer-local-map
+           (full-copy-sparse-keymap minibuffer-local-map))
+      ;; Haskell commands
+      (define-key haskell-minibuffer-local-map "\ep"   'haskell-previous-input)
+      (define-key haskell-minibuffer-local-map "\en"   'haskell-next-input)
+      ))
+
+(defun haskell-previous-input (arg)
+  "Cycle backwards through input history."
+  (interactive "*p")
+  (let ((len (ring-length haskell-prompt-ring)))
+    (cond ((<= len 0)
+          (message "Empty input ring.")
+          (ding))
+         (t
+          (cond ((eq last-command 'haskell-previous-input)
+                 (delete-region (mark) (point))
+                 (set-mark (point)))
+                (t                          
+                 (setq input-ring-index
+                       (if (> arg 0) -1
+                           (if (< arg 0) 1 0)))
+                 (push-mark (point))))
+          (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
+          (insert (ring-ref haskell-prompt-ring input-ring-index))
+          (setq this-command 'haskell-previous-input))
+         )))
+        
+(defun haskell-next-input (arg)
+  "Cycle forwards through input history."
+  (interactive "*p")
+  (haskell-previous-input (- arg)))
+
+(defvar haskell-last-input-match ""
+  "Last string searched for by Haskell input history search, for defaulting.
+Buffer local variable.") 
+
+(defun haskell-previous-input-matching (str)
+  "Searches backwards through input history for substring match"
+  (interactive (let ((s (read-from-minibuffer 
+                        (format "Command substring (default %s): "
+                                haskell-last-input-match))))
+                (list (if (string= s "") haskell-last-input-match s))))
+  (setq haskell-last-input-match str) ; update default
+  (let ((str (regexp-quote str))
+        (len (ring-length haskell-prompt-ring))
+       (n 0))
+    (while (and (<= n len)
+               (not (string-match str (ring-ref haskell-prompt-ring n))))
+      (setq n (+ n 1)))
+    (cond ((<= n len) (haskell-previous-input (+ n 1)))
+         (t (haskell-mode-error "Not found.")))))
+
+
+;;; Actually read an expression from the minibuffer using the new keymap.
+
+(defun haskell-get-expression (prompt)
+  (let ((exp  (read-from-minibuffer prompt nil haskell-minibuffer-local-map)))
+    (ring-insert haskell-prompt-ring exp)
+    exp))
+
+
+\f
+;;; ==================================================================
+;;; Handle output from Haskell process
+;;; ==================================================================
+
+;;; The haskell process produces output with embedded control codes.
+;;; These control codes are used to keep track of what kind of input
+;;; the haskell process is expecting.  Ordinary output is just displayed.
+;;;
+;;; This is kind of complicated because control sequences can be broken
+;;; across multiple batches of text received from the haskell process.
+;;; If the string ends in the middle of a control sequence, save it up
+;;; for the next call.
+
+(defvar *haskell-saved-output* nil)
+
+;;; On the Next, there is some kind of race condition that causes stuff
+;;; sent to the Haskell subprocess before it has really started to be lost.
+;;; The point of this variable is to force the Emacs side to wait until
+;;; Haskell has started and printed out its banner before sending it
+;;; anything.  See start-haskell below.
+
+(defvar *haskell-process-alive* nil)
+
+(defun haskell-output-filter (process str)
+  "Filter for output from Yale Haskell command interface"
+  ;; *** debug
+  ;;(let ((buffer  (get-buffer-create "haskell-output")))
+  ;;  (save-excursion
+  ;;    (set-buffer buffer)
+  ;;    (insert str)))
+  (setq *haskell-process-alive* t)
+  (let ((next    0)
+       (start   0)
+       (data    (match-data)))
+    (unwind-protect
+       (progn
+         ;; If there was saved output from last time, glue it in front of the
+         ;; newly received input.
+         (if *haskell-saved-output*
+             (progn
+               (setq str (concat *haskell-saved-output* str))
+               (setq *haskell-saved-output* nil)))
+         ;; Loop, looking for complete command sequences.
+         ;; Set next to point to the first one.
+         ;; start points to first character to be processed.
+         (while (setq next
+                      (string-match *haskell-message-match-regexp*
+                                    str start))
+           ;; Display any intervening ordinary text.
+           (if (not (eq next start))
+               (haskell-display-output (substring str start next)))
+           ;; Now dispatch on the particular command sequence found.
+           ;; Handler functions are called with the string and start index
+           ;; as arguments, and should return the index of the "next"
+           ;; character.
+           (let ((end  (match-end 0)))
+             (haskell-handle-message str next)
+             (setq start end)))
+         ;; Look to see whether the string ends with an incomplete 
+         ;; command sequence.
+         ;; If so, save the tail of the string for next time.
+         (if (and (setq next
+                    (string-match *haskell-message-prefix-regexp* str start))
+                  (eq (match-end 0) (length str)))
+              (setq *haskell-saved-output* (substring str next))
+             (setq next (length str)))
+         ;; Display any leftover ordinary text.
+         (if (not (eq next start))
+             (haskell-display-output (substring str start next))))
+      (store-match-data data))))
+
+(defvar *haskell-message-match-regexp*
+  "EMACS:.*\n")
+
+(defvar *haskell-message-prefix-regexp*
+  "E\\(M\\(A\\(C\\(S\\(:.*\\)?\\)?\\)?\\)?\\)?")
+
+(defvar *haskell-message-dispatch*
+  '(("EMACS:debug\n"         . haskell-got-debug)
+    ("EMACS:busy\n"          . haskell-got-busy)
+    ("EMACS:input\n"         . haskell-got-input)
+    ("EMACS:ready\n"         . haskell-got-ready)
+    ("EMACS:printers .*\n"   . haskell-got-printers)
+    ("EMACS:optimizers .*\n" . haskell-got-optimizers)
+    ("EMACS:message .*\n"    . haskell-got-message)
+    ("EMACS:error\n"         . haskell-got-error)
+    ))
+
+(defun haskell-handle-message (str idx)
+  (let ((list  *haskell-message-dispatch*)
+       (fn    nil))
+    (while (and list (null fn))
+      (if (eq (string-match (car (car list)) str idx) idx)
+         (setq fn (cdr (car list)))
+         (setq list (cdr list))))
+    (if (null fn)
+       (haskell-mode-error "Garbled message from Haskell!")
+       (let ((end  (match-end 0)))
+         (funcall fn str idx end)
+         end))))
+
+
+(defun haskell-message-data (string start end)
+  (let ((real-start  (+ (string-match " " string start) 1))
+       (real-end    (- end 1)))
+    (substring string real-start real-end)))
+
+(defun haskell-got-debug (string start end)
+  (beep)
+  (message "In the debugger!")
+  (set-haskell-status 'debug))
+
+(defun haskell-got-busy (string start end)
+  (set-haskell-status 'busy))
+
+(defun haskell-got-input (string start end)
+  (if haskell-auto-switch-input
+      (progn
+       (haskell-switch)
+       (beep)))
+  (set-haskell-status 'input)
+  (message "Waiting for input..."))
+
+(defun haskell-got-ready (string start end)
+  (set-haskell-status 'ready))
+
+(defun haskell-got-printers (string start end)
+  (haskell-printers-update (haskell-message-data string start end)))
+
+(defun haskell-got-optimizers (string start end)
+  (haskell-optimizers-update (haskell-message-data string start end)))
+
+(defun haskell-got-message (string start end)
+  (message "%s" (haskell-message-data string start end)))
+
+(defun haskell-got-error (string start end)
+  (beep)
+  (message "Haskell error."))
+
+
+;;; Displays output at end of given buffer.
+;;; This function only ensures that the output is visible, without 
+;;; selecting the buffer in which it is displayed.
+;;; Note that just using display-buffer instead of all this rigamarole
+;;; won't work; you need to temporarily select the window containing
+;;; the *haskell-buffer*, or else the display won't be scrolled to show
+;;; the new output.
+;;; *** This should really position the window in the buffer so that 
+;;; *** the point is on the last line of the window.
+
+(defun haskell-display-output (str)
+  (let ((window  (selected-window)))
+    (unwind-protect
+       (progn
+         (pop-to-buffer *haskell-buffer*)
+         (haskell-display-output-aux str))
+      (select-window window))))
+
+(defun haskell-display-output-aux (str)
+  (haskell-move-marker)
+  (insert str)
+  (haskell-move-marker))
+
+
+\f
+;;; ==================================================================
+;;; Interactive commands
+;;; ==================================================================
+
+
+;;; HASKELL
+;;; -------
+;;;
+;;; This is the function that fires up the inferior haskell process.
+
+(defun haskell ()
+  "Run an inferior Haskell process with input and output via buffer *haskell*.
+Takes the program name from the variable haskell-program-name.  
+Runs the hooks from inferior-haskell-mode-hook 
+(after the comint-mode-hook is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+  (interactive)
+  (if (not (haskell-process-exists-p))
+    (start-haskell)))
+
+(defun start-haskell ()
+  (message "Starting haskell subprocess...")
+  ;; Kill old haskell process.  Normally this routine is only called
+  ;; after checking haskell-process-exists-p, but things can get
+  ;; screwed up if you rename the *haskell* buffer while leaving the
+  ;; old process running.  This forces it to get rid of the old process
+  ;; and start a new one.
+  (if (get-process "haskell")
+      (delete-process "haskell"))
+  (let ((haskell-buffer
+        (apply 'make-comint
+               "haskell"
+               (or haskell-program-name
+                   (haskell-mode-error "Haskell-program-name undefined!"))
+               nil
+               nil)))
+    (save-excursion
+      (set-buffer haskell-buffer)
+      (inferior-haskell-mode))
+    (haskell-session-init)
+    ;; Wait for process to get started before sending it anything
+    ;; to avoid race condition on NeXT.
+    (setq *haskell-process-alive* nil)
+    (while (not *haskell-process-alive*)
+      (sleep-for 1))
+    (haskell-send-to-process ":(use-emacs-interface)")
+    (haskell-printers-set haskell-initial-printers nil)
+    (display-buffer haskell-buffer))
+  (message "Starting haskell subprocess...  Done."))
+
+
+(defun haskell-process-exists-p ()
+  (let ((haskell-buffer  (get-buffer *haskell-buffer*)))
+    (and haskell-buffer (comint-check-proc haskell-buffer))))
+
+
+
+;;; Initialize things on the emacs side, and tell haskell that it's
+;;; talking to emacs.
+
+(defun haskell-session-init ()
+  (set-haskell-status 'busy)
+  (setq *last-loaded* nil)
+  (setq *last-module* haskell-main-module)
+  (setq *last-pad* haskell-main-pad)
+  (setq *haskell-saved-output* nil)
+  (haskell-create-main-pad)
+  (set-process-filter (get-process "haskell") 'haskell-output-filter)
+  )
+
+
+(defun haskell-create-main-pad ()
+  (let ((buffer (get-buffer-create haskell-main-pad)))
+    (save-excursion
+      (set-buffer buffer)
+      (haskell-mode))
+    (haskell-record-pad-mapping
+      haskell-main-pad haskell-main-module nil)
+    buffer))
+
+
+;;; Called from evaluation and compilation commands to start up a Haskell
+;;; process if none is already in progress.
+
+(defun haskell-maybe-create-process ()
+  (cond ((haskell-process-exists-p)
+        t)
+       (haskell-auto-create-process
+        (start-haskell))
+       (t
+        (haskell-mode-error "No Haskell process!"))))
+
+
+
+;;; HASKELL-GET-PAD
+;;; ------------------------------------------------------------------
+
+;;; This always puts the pad buffer in the "other" window.
+;;; Having it wipe out the .hs file window is clearly the wrong
+;;; behavior.
+
+(defun haskell-get-pad ()
+  "Creates a new scratch pad for the current module.
+Signals an error if the current buffer is not a .hs file."
+  (interactive)
+  (let ((fname (buffer-file-name)))
+    (if fname
+       (do-get-pad fname (current-buffer))
+        (haskell-mode-error "Not in a .hs buffer!"))))
+
+
+(defun do-get-pad (fname buff)
+  (let* ((mname (or (haskell-get-modname buff)
+                   (read-no-blanks-input "Scratch pad for module? " nil)))
+        (pname (haskell-lookup-pad mname fname))
+        (pbuff nil))
+    ;; Generate the base name of the pad buffer, then create the
+    ;; buffer.  The actual name of the pad buffer may be something
+    ;; else because of name collisions.
+    (if (not pname)
+       (progn
+         (setq pname (format "*%s-pad*" mname))
+         (setq pbuff (generate-new-buffer pname))
+         (setq pname (buffer-name pbuff))
+         (haskell-record-pad-mapping pname mname fname)
+         )
+       (setq pbuff (get-buffer pname)))
+    ;; Make sure the pad buffer is in haskell mode.
+    (pop-to-buffer pbuff)
+    (haskell-mode)))
+
+
+
+;;; HASKELL-SWITCH
+;;; ------------------------------------------------------------------
+
+(defun haskell-switch ()
+  "Switches to \*haskell\* buffer."
+  (interactive)
+  (haskell-maybe-create-process)
+  (pop-to-buffer *haskell-buffer*)
+  (push-mark)
+  (goto-char (point-max)))
+
+
+
+;;; HASKELL-KILL
+;;; ------------------------------------------------------------------
+
+(defun haskell-kill ()
+  "Kill contents of *haskell* buffer.  \\[haskell-kill]"
+  (interactive)
+  (save-excursion
+    (set-buffer *haskell-buffer*)
+    (beginning-of-buffer)
+    (let ((mark  (point)))
+      (end-of-buffer)
+      (kill-region mark (point)))))
+
+
+
+;;; HASKELL-COMMAND
+;;; ------------------------------------------------------------------
+
+(defun haskell-command (str)
+  "Format STRING as a haskell command and send it to haskell process.  \\[haskell-command]"
+  (interactive "sHaskell command: ")
+  (haskell-send-to-process (format ":%s" str)))
+
+
+;;; HASKELL-EVAL and HASKELL-RUN
+;;; ------------------------------------------------------------------
+
+(defun haskell-eval ()
+  "Evaluate expression in current module. \\[haskell-eval]"
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
+                   "emacs-eval"))
+
+(defun haskell-run ()
+  "Run Haskell Dialogue in current module"
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux (haskell-get-expression "Haskell dialogue: ")
+                   "emacs-run"))
+
+(defun haskell-run-main ()
+  "Run Dialogue named main in current module"
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux "main" "emacs-run"))
+
+(defun haskell-report-type ()
+  "Print the type of the expression."
+  (interactive)
+  (haskell-maybe-create-process)
+  (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
+                   "emacs-report-type"))
+
+(defun haskell-eval-aux (exp fn)
+  (cond ((equal *haskell-buffer* (buffer-name))
+        ;; In the *haskell* buffer.
+        (let* ((pname  *last-pad*)
+               (mname  *last-module*)
+               (fname  *last-loaded*))
+          (haskell-eval-aux-aux exp pname mname fname fn)))
+       ((buffer-file-name)
+        ;; In a .hs file.
+        (let* ((fname  (buffer-file-name))
+               (mname  (haskell-get-modname (current-buffer)))
+               (pname  (haskell-lookup-pad mname fname)))
+          (haskell-eval-aux-aux exp pname mname fname fn)))
+       (t
+        ;; In a pad.
+        (let* ((pname  (buffer-name (current-buffer)))
+               (mname  (haskell-get-module-from-pad pname))
+               (fname  (haskell-get-file-from-pad pname)))
+          (haskell-eval-aux-aux exp pname mname fname fn)))
+       ))
+
+(defun haskell-eval-aux-aux (exp pname mname fname fn)
+  (haskell-save-modified-source-files fname)
+  (haskell-send-to-process (format ":(%s" fn))
+  (haskell-send-to-process
+    (prin1-to-string exp))
+  (haskell-send-to-process
+    (prin1-to-string (or pname fname "interactive")))
+  (haskell-send-to-process
+    (prin1-to-string
+      (if (and pname (get-buffer pname))
+         (save-excursion
+           (set-buffer pname)
+           (buffer-string))
+         "")))
+  (haskell-send-to-process
+    (format "'|%s|" mname))
+  (haskell-send-to-process
+    (if fname
+       (prin1-to-string (haskell-maybe-get-unit-file-name fname))
+       "'#f"))
+  (haskell-send-to-process ")")
+  (setq *last-pad* pname)
+  (setq *last-module* mname)
+  (setq *last-loaded* fname))
+
+
+
+;;; HASKELL-RUN-FILE, HASKELL-LOAD, HASKELL-COMPILE
+;;; ------------------------------------------------------------------
+
+(defun haskell-run-file ()
+  "Runs Dialogue named main in current file."
+  (interactive)
+  (haskell-maybe-create-process)
+  (let ((fname  (haskell-get-file-to-operate-on)))
+    (haskell-save-modified-source-files fname)
+    (haskell-send-to-process ":(emacs-run-file")
+    (haskell-send-to-process (prin1-to-string fname))
+    (haskell-send-to-process ")")))
+
+(defun haskell-load ()
+  "Load current file."
+  (interactive)
+  (haskell-maybe-create-process)
+  (let ((fname  (haskell-get-file-to-operate-on)))
+    (haskell-save-modified-source-files fname)
+    (haskell-send-to-process ":(emacs-load-file")
+    (haskell-send-to-process (prin1-to-string fname))
+    (haskell-send-to-process ")")))
+
+(defun haskell-compile ()
+  "Compile current file."
+  (interactive)
+  (haskell-maybe-create-process)
+  (let ((fname  (haskell-get-file-to-operate-on)))
+    (haskell-save-modified-source-files fname)
+    (haskell-send-to-process ":(emacs-compile-file")
+    (haskell-send-to-process (prin1-to-string fname))
+    (haskell-send-to-process ")")))
+
+
+(defun haskell-get-file-to-operate-on ()
+  (cond ((equal *haskell-buffer* (buffer-name))
+        ;; When called from the haskell process buffer, prompt for a file.
+        (call-interactively 'haskell-get-file/prompt))
+       ((buffer-file-name)
+        ;; When called from a .hs file buffer, use the unit file
+        ;; associated with it, if there is one.
+        (haskell-maybe-get-unit-file-name (buffer-file-name)))
+       (t
+        ;; When called from a pad, use the file that the module the
+        ;; pad belongs to lives in.
+        (haskell-maybe-get-unit-file-name 
+          (haskell-get-file-from-pad (buffer-name (current-buffer)))))))
+
+(defun haskell-get-file/prompt (filename)
+  (interactive "fHaskell file:  ")
+  (haskell-run-file-aux filename))
+
+
+
+;;; HASKELL-EXIT
+;;; ------------------------------------------------------------------
+
+(defun haskell-exit ()
+  "Quit the haskell process."
+  (interactive)
+  (cond ((not (haskell-process-exists-p))
+        (message "No process currently running."))
+       ((y-or-n-p "Do you really want to quit Haskell? ")
+        (haskell-send-to-process ":quit")
+        ;; If we were running the tutorial, mark the temp buffer as unmodified
+        ;; so we don't get asked about saving it later.
+        (if (and *ht-temp-buffer*
+                 (get-buffer *ht-temp-buffer*))
+            (save-excursion
+              (set-buffer *ht-temp-buffer*)
+              (set-buffer-modified-p nil)))
+        ;; Try to remove the haskell output buffer from the screen.
+        (bury-buffer *haskell-buffer*)
+        (replace-buffer-in-windows *haskell-buffer*))
+       (t
+        nil)))
+
+
+;;; HASKELL-INTERRUPT
+;;; ------------------------------------------------------------------
+
+(defun haskell-interrupt ()
+  "Interrupt the haskell process."
+  (interactive)
+  (if (haskell-process-exists-p)
+      (haskell-send-to-process "\C-c")))
+
+
+
+;;; HASKELL-EDIT-UNIT
+;;; ------------------------------------------------------------------
+
+(defun haskell-edit-unit ()
+  "Edit the .hu file."
+  (interactive)
+  (let ((fname       (buffer-file-name)))
+    (if fname
+       (let ((find-file-not-found-hooks  (list 'haskell-new-unit))
+             (file-not-found             nil)
+             (units-fname                (haskell-get-unit-file-name fname)))
+         (find-file-other-window units-fname)
+         ;; If creating a new file, initialize it to contain the name
+         ;; of the haskell source file.
+         (if file-not-found
+             (save-excursion
+               (insert
+                 (if (string= (file-name-directory fname)
+                              (file-name-directory units-fname))
+                     (file-name-nondirectory fname)
+                     fname)
+                 "\n"))))
+       (haskell-mode-error "Not in a .hs buffer!"))))
+
+(defun haskell-new-unit ()
+  (setq file-not-found t))
+
+
+;;; Look for a comment like "-- unit:" at top of file.
+;;; If not found, assume unit file has same name as the buffer but
+;;; a .hu extension.
+
+(defun haskell-get-unit-file-name (fname)
+  (or (haskell-get-unit-file-name-from-file fname)
+      (concat (haskell-strip-file-extension fname) ".hu")))
+
+(defun haskell-maybe-get-unit-file-name (fname)
+  (or (haskell-get-unit-file-name-from-file fname)
+      (haskell-strip-file-extension fname)))
+
+(defun haskell-get-unit-file-name-from-file (fname)
+  (let ((buffer  (get-file-buffer fname)))
+    (if buffer
+       (save-excursion
+         (beginning-of-buffer)
+         (if (re-search-forward "-- unit:[ \t]*" (point-max) t)
+             (let ((beg  (match-end 0)))
+               (end-of-line)
+               (buffer-substring beg (point)))
+             nil))
+       nil)))
+
+
+
+\f
+;;; ==================================================================
+;;; Support for printers/optimizers menus
+;;; ==================================================================
+
+;;; This code was adapted from the standard buff-menu.el code.
+
+(defvar haskell-menu-mode-map nil "")
+
+(if (not haskell-menu-mode-map)
+    (progn
+      (setq haskell-menu-mode-map (make-keymap))
+      (suppress-keymap haskell-menu-mode-map t)
+      (define-key haskell-menu-mode-map "m" 'hm-mark)
+      (define-key haskell-menu-mode-map "u" 'hm-unmark)
+      (define-key haskell-menu-mode-map "x" 'hm-exit)
+      (define-key haskell-menu-mode-map "q" 'hm-exit)
+      (define-key haskell-menu-mode-map " " 'next-line)
+      (define-key haskell-menu-mode-map "\177" 'hm-backup-unmark)
+      (define-key haskell-menu-mode-map "?" 'describe-mode)))
+
+;; Printers Menu mode is suitable only for specially formatted data.
+
+(put 'haskell-menu-mode 'mode-class 'special)
+
+(defun haskell-menu-mode ()
+  "Major mode for editing Haskell flags.
+Each line describes a flag.
+Letters do not insert themselves; instead, they are commands.
+m -- mark flag (turn it on)
+u -- unmark flag (turn it off)
+x -- exit; tell the Haskell process to update the flags, then leave menu.
+q -- exit; same as x.
+Precisely,\\{haskell-menu-mode-map}"
+  (kill-all-local-variables)
+  (use-local-map haskell-menu-mode-map)
+  (setq truncate-lines t)
+  (setq buffer-read-only t)
+  (setq major-mode 'haskell-menu-mode)
+  (setq mode-name "Haskell Flags Menu")
+  ;; These are all initialized elsewhere
+  (make-local-variable 'hm-current-flags)
+  (make-local-variable 'hm-request-fn)
+  (make-local-variable 'hm-update-fn)
+  (run-hooks 'haskell-menu-mode-hook))
+
+
+(defun haskell-menu (help-file buffer request-fn update-fn)
+  (haskell-maybe-create-process)
+  (if (get-buffer buffer)
+      (progn
+       (pop-to-buffer buffer)
+       (goto-char (point-min)))
+      (progn
+        (pop-to-buffer buffer)
+       (insert-file-contents help-file)
+       (haskell-menu-mode)
+       (setq hm-request-fn request-fn)
+       (setq hm-update-fn update-fn)
+       ))
+  (hm-mark-current)
+  (message "m = mark; u = unmark; x = execute; q = quit; ? = more help."))
+
+
+
+;;; A line that starts with *hm-marked* is a menu item turned on.
+;;; A line that starts with *hm-unmarked* is turned off.
+;;; A line that starts with anything else is just random text and is
+;;; ignored by commands that deal with menu items.
+
+(defvar *hm-marked*   " on")
+(defvar *hm-unmarked* "   ")
+(defvar *hm-marked-regexp*   " on   \\w")
+(defvar *hm-unmarked-regexp* "      \\w")
+
+(defun hm-mark ()
+  "Mark flag to be turned on."
+  (interactive)
+  (beginning-of-line)
+  (cond ((looking-at *hm-marked-regexp*)
+        (forward-line 1))
+       ((looking-at *hm-unmarked-regexp*)
+        (let ((buffer-read-only  nil))
+          (delete-char (length *hm-unmarked*))
+          (insert *hm-marked*)
+          (forward-line 1)))
+       (t
+        (forward-line 1))))
+
+(defun hm-unmark ()
+  "Unmark flag."
+  (interactive)
+  (beginning-of-line)
+  (cond ((looking-at *hm-unmarked-regexp*)
+        (forward-line 1))
+       ((looking-at *hm-marked-regexp*)
+        (let ((buffer-read-only  nil))
+          (delete-char (length *hm-marked*))
+          (insert *hm-unmarked*)
+          (forward-line 1)))
+       (t
+        (forward-line 1))))
+
+(defun hm-backup-unmark ()
+  "Move up and unmark."
+  (interactive)
+  (forward-line -1)
+  (hm-unmark)
+  (forward-line -1))
+
+
+;;; Actually make the changes.
+
+(defun hm-exit ()
+  "Update flags, then leave menu."
+  (interactive)
+  (hm-execute)
+  (hm-quit))
+
+(defun hm-execute ()
+  "Tell haskell process to tweak flags."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (let ((flags-on   nil)
+         (flags-off  nil))
+      (while (not (eq (point) (point-max)))
+       (cond ((looking-at *hm-unmarked-regexp*)
+              (setq flags-off (cons (hm-flag) flags-off)))
+             ((looking-at *hm-marked-regexp*)
+              (setq flags-on (cons (hm-flag) flags-on)))
+             (t
+              nil))
+       (forward-line 1))
+      (funcall hm-update-fn flags-on flags-off))))
+
+
+(defun hm-quit ()
+  (interactive)
+  "Make the menu go away."
+  (bury-buffer (current-buffer))
+  (replace-buffer-in-windows (current-buffer)))
+
+(defun hm-flag ()
+  (save-excursion
+    (beginning-of-line)
+    (forward-char 6)
+    (let ((beg  (point)))
+      ;; End of flag name marked by tab or two spaces.
+      (re-search-forward "\t\\|  ")
+      (buffer-substring beg (match-beginning 0)))))
+
+
+;;; Update the menu to mark only those items currently turned on.
+
+(defun hm-mark-current ()
+  (funcall hm-request-fn)
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eq (point) (point-max)))
+      (cond ((and (looking-at *hm-unmarked-regexp*)
+                 (hm-item-currently-on-p (hm-flag)))
+            (hm-mark))
+           ((and (looking-at *hm-marked-regexp*)
+                 (not (hm-item-currently-on-p (hm-flag))))
+            (hm-unmark))
+           (t
+            (forward-line 1))))))
+
+
+;;; See if a menu item is turned on.
+
+(defun hm-item-currently-on-p (item)
+  (member-string= item hm-current-flags))
+
+(defun member-string= (item list)
+  (cond ((null list)
+        nil)
+       ((string= item (car list))
+        list)
+       (t
+        (member-string= item (cdr list)))))
+
+
+
+;;; Make the menu for printers.
+
+(defvar *haskell-printers-help*
+  (concat (getenv "HASKELL") "/emacs-tools/printer-help.txt")
+  "Help file for printers.")
+
+(defvar *haskell-printers-buffer* "*Haskell printers*")
+
+(defun haskell-printers ()
+  "Set printers interactively."
+  (interactive)
+  (haskell-menu
+    *haskell-printers-help*
+    *haskell-printers-buffer*
+    'haskell-printers-inquire
+    'haskell-printers-set))
+               
+(defun haskell-printers-inquire ()
+  (setq hm-current-flags t)
+  (haskell-send-to-process ":(emacs-send-printers)")
+  (while (eq hm-current-flags t)
+    (sleep-for 1)))
+
+(defun haskell-printers-update (data)
+  (setq hm-current-flags (read data)))
+
+(defun haskell-printers-set (flags-on flags-off)
+  (haskell-send-to-process ":(emacs-set-printers '")
+  (haskell-send-to-process (prin1-to-string flags-on))
+  (haskell-send-to-process ")"))
+
+
+;;; Equivalent stuff for the optimizers menu
+
+(defvar *haskell-optimizers-help*
+  (concat (getenv "HASKELL") "/emacs-tools/optimizer-help.txt")
+  "Help file for optimizers.")
+
+(defvar *haskell-optimizers-buffer* "*Haskell optimizers*")
+
+(defun haskell-optimizers ()
+  "Set optimizers interactively."
+  (interactive)
+  (haskell-menu
+    *haskell-optimizers-help*
+    *haskell-optimizers-buffer*
+    'haskell-optimizers-inquire
+    'haskell-optimizers-set))
+               
+(defun haskell-optimizers-inquire ()
+  (setq hm-current-flags t)
+  (haskell-send-to-process ":(emacs-send-optimizers)")
+  (while (eq hm-current-flags t)
+    (sleep-for 1)))
+
+(defun haskell-optimizers-update (data)
+  (setq hm-current-flags (read data)))
+
+(defun haskell-optimizers-set (flags-on flags-off)
+  (haskell-send-to-process ":(emacs-set-optimizers '")
+  (haskell-send-to-process (prin1-to-string flags-on))
+  (haskell-send-to-process ")"))
+
+
+\f
+;;; ==================================================================
+;;; Random utilities
+;;; ==================================================================
+
+
+;;; Keep track of the association between pads, modules, and files.
+;;; The global variable is a list of (pad-buffer-name module-name file-name)
+;;; lists.
+
+(defvar *haskell-pad-mappings* ()
+  "Associates pads with their corresponding module and file.")
+
+(defun haskell-record-pad-mapping (pname mname fname)
+  (setq *haskell-pad-mappings*
+       (cons (list pname mname fname) *haskell-pad-mappings*)))
+
+(defun haskell-get-module-from-pad (pname)
+  (car (cdr (assoc pname *haskell-pad-mappings*))))
+
+(defun haskell-get-file-from-pad (pname)
+  (car (cdr (cdr (assoc pname *haskell-pad-mappings*)))))
+
+(defun haskell-lookup-pad (mname fname)
+  (let ((pname  (haskell-lookup-pad-aux mname fname *haskell-pad-mappings*)))
+    (if (and pname (get-buffer pname))
+       pname
+       nil)))
+
+(defun haskell-lookup-pad-aux (mname fname list)
+  (cond ((null list)
+        nil)
+       ((and (equal mname (car (cdr (car list))))
+             (equal fname (car (cdr (cdr (car list))))))
+        (car (car list)))
+       (t
+        (haskell-lookup-pad-aux mname fname (cdr list)))))
+
+
+
+;;; Save any modified .hs and .hu files.
+;;; Yes, the two set-buffer calls really seem to be necessary.  It seems
+;;; that y-or-n-p makes emacs forget we had temporarily selected some
+;;; other buffer, and if you just do save-buffer directly it will end
+;;; up trying to save the current buffer instead.  The built-in
+;;; save-some-buffers function has this problem....
+
+(defun haskell-save-modified-source-files (filename)
+  (let ((buffers   (buffer-list))
+       (found-any nil))
+    (while buffers
+      (let ((buffer  (car buffers)))
+       (if (and (buffer-modified-p buffer)
+                (save-excursion
+                  (set-buffer buffer)
+                  (and buffer-file-name
+                       (haskell-source-file-p buffer-file-name)
+                       (setq found-any t)
+                       (or (null haskell-ask-before-saving)
+                           (and filename (string= buffer-file-name filename))
+                           (y-or-n-p
+                               (format "Save file %s? " buffer-file-name))))))
+           (save-excursion
+             (set-buffer buffer)
+             (save-buffer))))
+      (setq buffers (cdr buffers)))
+    (if found-any
+       (message "")
+        (message "(No files need saving)"))))
+  
+(defun haskell-source-file-p (filename)
+  (or (string-match "\\.hs$" filename)
+      (string-match "\\.lhs$" filename)
+      (string-match "\\.hi$" filename)
+      (string-match "\\.hu$" filename)))
+
+
+
+;;; Buffer utilities
+
+(defun haskell-move-marker ()
+  "Moves the marker and point to the end of buffer"
+  (set-marker comint-last-input-end (point-max))
+  (set-marker (process-mark (get-process "haskell")) (point-max))
+  (goto-char (point-max)))
+  
+
+       
+;;; Extract the name of the module the point is in, from the given buffer.
+
+(defvar *haskell-re-module-hs*  "^module\\s *")
+(defvar *haskell-re-module-lhs* "^>\\s *module\\s *")
+(defvar *haskell-re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*")
+
+(defun haskell-get-modname (buff)
+  "Get module name in BUFFER that point is in."
+  (save-excursion
+    (set-buffer buff)
+    (let ((regexp  (if (haskell-lhs-filename-p (buffer-file-name))
+                      *haskell-re-module-lhs*
+                      *haskell-re-module-hs*)))
+      (if (or (looking-at regexp)
+             (re-search-backward regexp (point-min) t)
+             (re-search-forward regexp (point-max) t))
+         (progn
+           (goto-char (match-end 0))
+           (if (looking-at *haskell-re-modname*)
+               (buffer-substring (match-beginning 0) (match-end 0))
+               (haskell-mode-error "Module name not found!!")))
+         "Main"))))
+
+
+;;; Strip file extensions.
+;;; Only strip off extensions we know about; e.g.
+;;; "foo.hs" -> "foo" but "foo.bar" -> "foo.bar".
+
+(defvar *haskell-filename-regexp* "\\(.*\\)\\.\\(hs\\|lhs\\)$")
+
+(defun haskell-strip-file-extension (filename)
+  "Strip off the extension from a filename."
+  (if (string-match *haskell-filename-regexp* filename)
+      (substring filename (match-beginning 1) (match-end 1))
+      filename))
+
+
+;;; Is this a .lhs filename?
+
+(defun haskell-lhs-filename-p (filename)
+  (string-match ".*\\.lhs$" filename))
+
+
+;;; Haskell mode error
+
+(defun haskell-mode-error (msg)
+  "Show MSG in message line as an error from the haskell mode."
+  (error (concat "Haskell mode:  " msg)))
+
+
+\f
+;;; ==================================================================
+;;; User customization
+;;; ==================================================================
+
+(defvar haskell-load-hook nil
+  "This hook is run when haskell is loaded in.
+This is a good place to put key bindings."
+  )
+       
+(run-hooks 'haskell-load-hook)
+
+
+
+\f
+;;;======================================================================
+;;; Tutorial mode setup
+;;;======================================================================
+
+;;; Set up additional key bindings for tutorial mode.
+
+(defvar ht-mode-map (make-sparse-keymap))
+
+(haskell-establish-key-bindings ht-mode-map)
+(define-key ht-mode-map "\C-c\C-f" 'ht-next-page)
+(define-key ht-mode-map "\C-c\C-b" 'ht-prev-page)
+(define-key ht-mode-map "\C-c\C-l" 'ht-restore-page)
+(define-key ht-mode-map "\C-c?"    'describe-mode)
+
+(defun haskell-tutorial-mode ()
+  "Major mode for running the Haskell tutorial.  
+You can use these commands:
+\\{ht-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map ht-mode-map)
+  (setq major-mode 'haskell-tutorial-mode)
+  (setq mode-name "Haskell Tutorial")
+  (set-syntax-table haskell-mode-syntax-table)
+  (run-hooks 'haskell-mode-hook))
+
+
+(defun haskell-tutorial ()
+  "Run the haskell tutorial."
+  (interactive)
+  (ht-load-tutorial)
+  (ht-make-buffer)
+  (ht-display-page)
+  (haskell-maybe-create-process)
+  (haskell-send-to-process ":(emacs-set-printers '(interactive))")
+  )
+
+
+;;; Load the tutorial file into a read-only buffer.  Do not display this
+;;; buffer.
+
+(defun ht-load-tutorial ()
+  (let ((buffer  (get-buffer *ht-file-buffer*)))
+    (if buffer
+       (save-excursion
+         (set-buffer buffer)
+         (beginning-of-buffer))
+       (save-excursion
+         (set-buffer (setq buffer (get-buffer-create *ht-file-buffer*)))
+         (let ((fname (substitute-in-file-name *ht-source-file*)))
+           (if (file-readable-p fname)
+               (ht-load-tutorial-aux fname)
+               (call-interactively 'ht-load-tutorial-aux)))))))
+
+(defun ht-load-tutorial-aux (filename)
+  (interactive "fTutorial file: ")
+  (insert-file filename)
+  (set-buffer-modified-p nil)
+  (setq buffer-read-only t)
+  (beginning-of-buffer))
+
+
+;;; Create a buffer to use for messing about with each page of the tutorial.
+;;; Put the buffer into haskell-tutorial-mode.
+
+(defun ht-make-buffer ()
+  (find-file (concat "/tmp/" (make-temp-name "ht") ".lhs"))
+  (setq *ht-temp-buffer* (buffer-name))
+  (haskell-tutorial-mode))
+
+
+;;; Commands for loading text into the tutorial pad buffer
+
+(defun ht-next-page ()
+  "Go to the next tutorial page."
+  (interactive)
+  (if (ht-goto-next-page)
+      (ht-display-page)
+      (beep)))
+
+(defun ht-goto-next-page ()
+  (let ((buff  (current-buffer)))
+    (unwind-protect
+       (progn
+         (set-buffer *ht-file-buffer*)
+         (search-forward "\C-l" nil t))
+      (set-buffer buff))))
+
+(defun ht-prev-page ()
+  "Go to the previous tutorial page."
+  (interactive)
+  (if (ht-goto-prev-page)
+      (ht-display-page)
+      (beep)))
+
+(defun ht-goto-prev-page ()
+  (let ((buff  (current-buffer)))
+    (unwind-protect
+       (progn
+         (set-buffer *ht-file-buffer*)
+         (search-backward "\C-l" nil t))
+      (set-buffer buff))))
+
+(defun ht-goto-page (arg)
+  "Go to the tutorial page specified as the argument."
+  (interactive "sGo to page: ")
+  (if (ht-searchfor-page (format "Page: %s " arg))
+      (ht-display-page)
+      (beep)))
+
+(defun ht-goto-section (arg)
+  "Go to the tutorial section specified as the argument."
+  (interactive "sGo to section: ")
+  (if (ht-searchfor-page (format "Section: %s " arg))
+      (ht-display-page)
+      (beep)))
+
+(defun ht-searchfor-page (search-string)
+  (let ((buff           (current-buffer)))
+    (unwind-protect
+       (progn
+         (set-buffer *ht-file-buffer*)
+         (let ((point  (point)))
+           (beginning-of-buffer)
+           (if (search-forward search-string nil t)
+               t
+               (progn
+                 (goto-char point)
+                 nil))))
+      (set-buffer buff))))
+
+(defun ht-restore-page ()
+  (interactive)
+  (let ((old-point  (point)))
+    (ht-display-page)
+    (goto-char old-point)))
+
+(defun ht-display-page ()
+  (set-buffer *ht-file-buffer*)
+  (let* ((beg   (progn
+                (if (search-backward "\C-l" nil t)
+                    (forward-line 1)
+                    (beginning-of-buffer))
+                (point)))
+        (end   (progn
+                 (if (search-forward "\C-l" nil t)
+                     (beginning-of-line)
+                     (end-of-buffer))
+                 (point)))
+        (text  (buffer-substring beg end)))
+    (set-buffer *ht-temp-buffer*)
+    (erase-buffer)
+    (insert text)
+    (beginning-of-buffer)))
+
+
+\f
+;;;======================================================================
+;;; Menu bar stuff
+;;;======================================================================
+
+;;; This only works in Emacs version 19, so it's in a separate file for now.
+
+(if (featurep 'menu-bar)
+    (load-library "haskell-menu"))
diff --git a/ghc/CONTRIB/haskell-modes/yale/original/optimizer-help.txt b/ghc/CONTRIB/haskell-modes/yale/original/optimizer-help.txt
new file mode 100644 (file)
index 0000000..c18ac5d
--- /dev/null
@@ -0,0 +1,6 @@
+Optimizer switches
+      inline         Aggressively inline functions
+      constant       Hoist constant expressions to top-level
+      foldr          Perform foldr/build deforestation
+      lisp           Tell the Lisp compiler to work hard to produce best code
+      delays         Try to make delays out-of-line for more compact code
diff --git a/ghc/CONTRIB/haskell-modes/yale/original/printer-help.txt b/ghc/CONTRIB/haskell-modes/yale/original/printer-help.txt
new file mode 100644 (file)
index 0000000..f8a6200
--- /dev/null
@@ -0,0 +1,26 @@
+General messages
+      compiling       Printed when the compilation system starts a compilation
+      loading         Printed when a previously compiled unit is loaded
+      reading         Prints the name of the file being parsed
+      pad             Enables printing within scratch pads
+      interactive     Print verbose messages in command loop
+      prompt          Print prompt in command loop
+Timings
+      time            Prints the time that it takes to execute a computation
+      phase-time      Prints the time of each phase of compilation
+Compiler passes
+      parse           Prints the program recreated from ast
+      import          Lists all symbols imported and exported for each module
+      scope           Print the program after scoping and precedence parsing
+      depend          Prints entire program in nested let's
+      type            Prints signatures during inference
+      cfn             Prints entire program after context free normalization
+      depend2         Like depend
+      flic            Prints entire program as flic code
+      optimize        Prints entire program as optimized flic code
+      optimize-extra  Prints extra verbose information during optimization
+      strictness      Print strictness of all functions and variables
+      codegen         Prints generated Lisp code
+      codegen-flic    Prints generated Lisp code and associated flic code
+      dumper          Prints the code in the interface
+      dump-stat       Prints statistics for the interface file
index 6d8f4c0..20af031 100644 (file)
@@ -438,6 +438,14 @@ codeGen/CgUpdate.lhs
 #define NATIVEGEN_SRCS_LHS /*none*/
 #else
 #define __omit_ncg_maybe /*none*/
 #define NATIVEGEN_SRCS_LHS /*none*/
 #else
 #define __omit_ncg_maybe /*none*/
+#if i386_TARGET_ARCH
+#define __machdep_nativegen_lhs \
+nativeGen/I386Desc.lhs \
+nativeGen/I386Code.lhs \
+nativeGen/I386Gen.lhs
+#define __ghci_machdep_nativegen_lhs \
+nativeGen/I386Code.lhs
+#endif
 #if sparc_TARGET_ARCH
 #define __machdep_nativegen_lhs \
 nativeGen/SparcDesc.lhs \
 #if sparc_TARGET_ARCH
 #define __machdep_nativegen_lhs \
 nativeGen/SparcDesc.lhs \
@@ -445,7 +453,8 @@ nativeGen/SparcCode.lhs \
 nativeGen/SparcGen.lhs
 #define __ghci_machdep_nativegen_lhs \
 nativeGen/SparcCode.lhs
 nativeGen/SparcGen.lhs
 #define __ghci_machdep_nativegen_lhs \
 nativeGen/SparcCode.lhs
-#else
+#endif
+#if alpha_TARGET_ARCH
 #define __machdep_nativegen_lhs \
 nativeGen/AlphaDesc.lhs \
 nativeGen/AlphaCode.lhs \
 #define __machdep_nativegen_lhs \
 nativeGen/AlphaDesc.lhs \
 nativeGen/AlphaCode.lhs \
@@ -833,7 +842,7 @@ compile_rec(envs/TyVarEnv,lhs,)
 
 compile(main/CmdLineOpts,lhs,-K2m)
 compile_rec(main/Errors,lhs,)
 
 compile(main/CmdLineOpts,lhs,-K2m)
 compile_rec(main/Errors,lhs,)
-compile_rec(main/ErrsTc,lhs,-H20m)
+compile_rec(main/ErrsTc,lhs,-H20m if_ghc26(-monly-4-regs))
 compile_rec(main/ErrsRn,lhs,)
 compile_rec(main/ErrUtils,lhs,)
 compile(main/Main,lhs,-H16m if_ghc(-fvia-C -fno-update-analysis)) /* ToDo: update */
 compile_rec(main/ErrsRn,lhs,)
 compile_rec(main/ErrUtils,lhs,)
 compile(main/Main,lhs,-H16m if_ghc(-fvia-C -fno-update-analysis)) /* ToDo: update */
@@ -850,22 +859,28 @@ compile(nativeGen/StixInfo,lhs,-I$(NATIVEGEN_DIR))
 compile(nativeGen/StixInteger,lhs,-H20m)
 compile(nativeGen/StixMacro,lhs,-I$(NATIVEGEN_DIR))
 compile(nativeGen/StixPrim,lhs,-H16m)
 compile(nativeGen/StixInteger,lhs,-H20m)
 compile(nativeGen/StixMacro,lhs,-I$(NATIVEGEN_DIR))
 compile(nativeGen/StixPrim,lhs,-H16m)
-#if sparc_TARGET_ARCH
+# if i386_TARGET_ARCH
+compile_rec(nativeGen/I386Desc,lhs,)
+compile(nativeGen/I386Code,lhs,-H20m -I$(NATIVEGEN_DIR) if_ghc(-monly-4-regs))
+compile(nativeGen/I386Gen,lhs,-H20m)
+# endif
+# if sparc_TARGET_ARCH
 compile_rec(nativeGen/SparcDesc,lhs,)
 compile(nativeGen/SparcCode,lhs,-H20m -I$(NATIVEGEN_DIR))
 compile(nativeGen/SparcGen,lhs,-H20m)
 compile_rec(nativeGen/SparcDesc,lhs,)
 compile(nativeGen/SparcCode,lhs,-H20m -I$(NATIVEGEN_DIR))
 compile(nativeGen/SparcGen,lhs,-H20m)
-#else
+# endif
+# if alpha_TARGET_ARCH
 compile_rec(nativeGen/AlphaDesc,lhs,)
 compile(nativeGen/AlphaCode,lhs,-H24m -K2m -I$(NATIVEGEN_DIR))
 compile_rec(nativeGen/AlphaDesc,lhs,)
 compile(nativeGen/AlphaCode,lhs,-H24m -K2m -I$(NATIVEGEN_DIR))
-compile(nativeGen/AlphaGen,lhs,-H24m)
-#endif
+compile(nativeGen/AlphaGen,lhs,-H24m -K2m)
+# endif
 #endif
 
 compile_rec(prelude/AbsPrel,lhs,-H16m -K2m if_ghc(-fno-omit-reexported-instances -fno-update-analysis))
 compile_rec(prelude/PrelFuns,lhs,)
 compile(prelude/PrelVals,lhs,)
 compile_rec(prelude/PrimKind,lhs,-I$(COMPINFO_DIR))
 #endif
 
 compile_rec(prelude/AbsPrel,lhs,-H16m -K2m if_ghc(-fno-omit-reexported-instances -fno-update-analysis))
 compile_rec(prelude/PrelFuns,lhs,)
 compile(prelude/PrelVals,lhs,)
 compile_rec(prelude/PrimKind,lhs,-I$(COMPINFO_DIR))
-compile_rec(prelude/PrimOps,lhs,-H16m -K2m)
+compile_rec(prelude/PrimOps,lhs,-H16m -K3m)
 compile(prelude/TysPrim,lhs,)
 compile(prelude/TysWiredIn,lhs,)
 
 compile(prelude/TysPrim,lhs,)
 compile(prelude/TysWiredIn,lhs,)
 
@@ -1349,7 +1364,3 @@ count_lines ::
 /* accumulate similar info about the sizes of object files */
 count_bytes ::
        ./count_bytes $(ALLSRCS_LHS) $(ALLSRCS_HS)
 /* accumulate similar info about the sizes of object files */
 count_bytes ::
        ./count_bytes $(ALLSRCS_LHS) $(ALLSRCS_HS)
-
-/* run the "resolve_ifaces" script (assuming you know what you are doing) */
-resolve_ifaces ::
-       ./resolve_ifaces $(ALLINTS)
index 26456a5..35a044e 100644 (file)
@@ -12,30 +12,19 @@ import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import Unique(Unique)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data AbstractC 
+data CAddrMode 
+data PrimKind 
+data SplitUniqSupply 
 amodeCanSurviveGC :: CAddrMode -> Bool
 amodeCanSurviveGC :: CAddrMode -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 flattenAbsC :: SplitUniqSupply -> AbstractC -> AbstractC
 flattenAbsC :: SplitUniqSupply -> AbstractC -> AbstractC
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 getAmodeKind :: CAddrMode -> PrimKind
 getAmodeKind :: CAddrMode -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 kindFromMagicId :: MagicId -> PrimKind
 kindFromMagicId :: MagicId -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mixedPtrLocn :: CAddrMode -> Bool
 mixedPtrLocn :: CAddrMode -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mixedTypeLocn :: CAddrMode -> Bool
 mixedTypeLocn :: CAddrMode -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkAbsCStmtList :: AbstractC -> [AbstractC]
 mkAbsCStmtList :: AbstractC -> [AbstractC]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: AbstractC) (u1 :: AbstractC) -> _!_ _ORIG_ AbsCSyn AbsCStmts [] [u0, u1] _N_ #-}
 mkAbstractCs :: [AbstractC] -> AbstractC
 mkAbstractCs :: [AbstractC] -> AbstractC
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: [AbstractC]) -> case u0 of { _ALG_ (:) (u1 :: AbstractC) (u2 :: [AbstractC]) -> _APP_  _TYAPP_  _ORIG_ PreludeList foldr1 { AbstractC } [ _ORIG_ AbsCFuns mkAbsCStmts, u0 ]; _NIL_  -> _!_ _ORIG_ AbsCSyn AbsCNop [] []; _NO_DEFLT_ } _N_ #-}
 mkAlgAltsCSwitch :: CAddrMode -> [(Int, AbstractC)] -> AbstractC -> AbstractC
 mkAlgAltsCSwitch :: CAddrMode -> [(Int, AbstractC)] -> AbstractC -> AbstractC
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _N_ _N_ _N_ #-}
 nonemptyAbsC :: AbstractC -> Labda AbstractC
 nonemptyAbsC :: AbstractC -> Labda AbstractC
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 448ac5b..2f55134 100644 (file)
@@ -190,7 +190,7 @@ kindFromMagicId SuB             = PtrKind
 kindFromMagicId Hp                 = PtrKind
 kindFromMagicId HpLim              = PtrKind
 kindFromMagicId LivenessReg        = IntKind
 kindFromMagicId Hp                 = PtrKind
 kindFromMagicId HpLim              = PtrKind
 kindFromMagicId LivenessReg        = IntKind
-kindFromMagicId ActivityReg        = IntKind
+--kindFromMagicId ActivityReg      = IntKind -- UNUSED
 kindFromMagicId StdUpdRetVecReg            = PtrKind
 kindFromMagicId StkStubReg         = PtrKind
 kindFromMagicId CurCostCentre      = CostCentreKind
 kindFromMagicId StdUpdRetVecReg            = PtrKind
 kindFromMagicId StkStubReg         = PtrKind
 kindFromMagicId CurCostCentre      = CostCentreKind
@@ -411,12 +411,12 @@ flatAbsC (AbsCStmts s1 s2)
     returnFlt (mkAbsCStmts inline_s1 inline_s2,
               mkAbsCStmts top_s1    top_s2)
 
     returnFlt (mkAbsCStmts inline_s1 inline_s2,
               mkAbsCStmts top_s1    top_s2)
 
-flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast upd descr)
+flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast upd descr liveness)
   = flatAbsC slow              `thenFlt` \ (slow_heres, slow_tops) ->
     flat_maybe maybe_fast      `thenFlt` \ (fast_heres, fast_tops) ->
     flatAmode upd               `thenFlt` \ (upd_lbl,    upd_tops) ->
     returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops, upd_tops,
   = flatAbsC slow              `thenFlt` \ (slow_heres, slow_tops) ->
     flat_maybe maybe_fast      `thenFlt` \ (fast_heres, fast_tops) ->
     flatAmode upd               `thenFlt` \ (upd_lbl,    upd_tops) ->
     returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops, upd_tops,
-       CClosureInfoAndCode cl_info slow_heres fast_heres upd_lbl descr]
+       CClosureInfoAndCode cl_info slow_heres fast_heres upd_lbl descr liveness]
     )
   where
     flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
     )
   where
     flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
index 3ba2bf9..8fb00be 100644 (file)
@@ -4,29 +4,25 @@ import AbsCFuns(amodeCanSurviveGC, flattenAbsC, getAmodeKind, kindFromMagicId, m
 import BasicLit(BasicLit(..), mkMachInt, mkMachWord)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
 import BasicLit(BasicLit(..), mkMachInt, mkMachWord)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
-import Class(Class)
-import ClosureInfo(ClosureInfo, LambdaFormInfo, StandardFormInfo)
+import ClosureInfo(ClosureInfo, LambdaFormInfo)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
+import CostCentre(CostCentre)
 import HeapOffs(HeapOffset, HpRelOffset(..), SpARelOffset(..), SpBRelOffset(..), VirtualHeapOffset(..), VirtualSpAOffset(..), VirtualSpBOffset(..), addOff, fixedHdrSize, intOff, intOffsetIntoGoods, isZeroOff, maxOff, possiblyEqualHeapOffset, pprHeapOffset, subOff, totHdrSize, varHdrSize, zeroOff)
 import HeapOffs(HeapOffset, HpRelOffset(..), SpARelOffset(..), SpBRelOffset(..), VirtualHeapOffset(..), VirtualSpAOffset(..), VirtualSpBOffset(..), addOff, fixedHdrSize, intOff, intOffsetIntoGoods, isZeroOff, maxOff, possiblyEqualHeapOffset, pprHeapOffset, subOff, totHdrSize, varHdrSize, zeroOff)
-import Id(ConTag(..), Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(ConTag(..), Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PprAbsC(dumpRealC, writeRealC)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PprAbsC(dumpRealC, writeRealC)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind(..))
 import PrimOps(PrimOp)
 import PrimKind(PrimKind(..))
 import PrimOps(PrimOp)
-import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
+import SMRep(SMRep)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Stdio(_FILE)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Stdio(_FILE)
-import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgExpr, UpdateFlag)
+import StgSyn(StgAtom, StgExpr, UpdateFlag)
 import TyCon(TyCon)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
@@ -34,52 +30,29 @@ import Unique(Unique)
 import Unpretty(Unpretty(..))
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 import Unpretty(Unpretty(..))
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data AbstractC   = AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker
+data AbstractC   = AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] Int | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker
 data BasicLit   = MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer)
 data CAddrMode   = CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool
 data CExprMacro   = INFO_PTR | ENTRY_CODE | INFO_TAG | EVAL_TAG
 data CLabel 
 data BasicLit   = MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer)
 data CAddrMode   = CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool
 data CExprMacro   = INFO_PTR | ENTRY_CODE | INFO_TAG | EVAL_TAG
 data CLabel 
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
+data CSeq 
 data CStmtMacro   = ARGS_CHK_A_LOAD_NODE | ARGS_CHK_A | ARGS_CHK_B_LOAD_NODE | ARGS_CHK_B | HEAP_CHK | STK_CHK | UPD_CAF | UPD_IND | UPD_INPLACE_NOPTRS | UPD_INPLACE_PTRS | UPD_BH_UPDATABLE | UPD_BH_SINGLE_ENTRY | PUSH_STD_UPD_FRAME | POP_STD_UPD_FRAME | SET_ARITY | CHK_ARITY | SET_TAG
 data CStmtMacro   = ARGS_CHK_A_LOAD_NODE | ARGS_CHK_A | ARGS_CHK_B_LOAD_NODE | ARGS_CHK_B | HEAP_CHK | STK_CHK | UPD_CAF | UPD_IND | UPD_INPLACE_NOPTRS | UPD_INPLACE_PTRS | UPD_BH_UPDATABLE | UPD_BH_SINGLE_ENTRY | PUSH_STD_UPD_FRAME | POP_STD_UPD_FRAME | SET_ARITY | CHK_ARITY | SET_TAG
-data ClosureInfo       {-# GHC_PRAGMA MkClosureInfo Id LambdaFormInfo SMRep #-}
-data LambdaFormInfo    {-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data SimplifierSwitch  {-# GHC_PRAGMA SimplOkToDupCode | SimplFloatLetsExposingWHNF | SimplOkToFloatPrimOps | SimplAlwaysFloatLetsFromLets | SimplDoCaseElim | SimplReuseCon | SimplCaseOfCase | SimplLetToCase | SimplMayDeleteConjurableIds | SimplPedanticBottoms | SimplDoArityExpand | SimplDoFoldrBuild | SimplDoNewOccurAnal | SimplDoInlineFoldrBuild | IgnoreINLINEPragma | SimplDoLambdaEtaExpansion | SimplDoEtaReduction | EssentialUnfoldingsOnly | ShowSimplifierProgress | MaxSimplifierIterations Int | SimplUnfoldingUseThreshold Int | SimplUnfoldingCreationThreshold Int | KeepSpecPragmaIds | KeepUnusedBindings #-}
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
+data ClosureInfo 
+data LambdaFormInfo 
+data GlobalSwitch 
+data SimplifierSwitch 
+data CostCentre 
 data HeapOffset 
 type HpRelOffset = HeapOffset
 data MagicId   = BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg
 data HeapOffset 
 type HpRelOffset = HeapOffset
 data MagicId   = BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg
@@ -91,243 +64,86 @@ type VirtualHeapOffset = HeapOffset
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 type ConTag = Int
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 type ConTag = Int
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Id 
+data Labda a 
+data ExportFlag 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
+data PrettyRep 
 data PrimKind   = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
 data PrimKind   = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data StgAtom a         {-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
-data UpdateFlag        {-# GHC_PRAGMA ReEntrant | Updatable | SingleEntry #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data PrimOp 
+data SMRep 
+data SplitUniqSupply 
+data SrcLoc 
+data StgAtom a 
+data StgExpr a b 
+data UpdateFlag 
+data TyCon 
+data UniType 
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 type Unpretty = CSeq
 amodeCanSurviveGC :: CAddrMode -> Bool
 type Unpretty = CSeq
 amodeCanSurviveGC :: CAddrMode -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 flattenAbsC :: SplitUniqSupply -> AbstractC -> AbstractC
 flattenAbsC :: SplitUniqSupply -> AbstractC -> AbstractC
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 getAmodeKind :: CAddrMode -> PrimKind
 getAmodeKind :: CAddrMode -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 kindFromMagicId :: MagicId -> PrimKind
 kindFromMagicId :: MagicId -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mixedPtrLocn :: CAddrMode -> Bool
 mixedPtrLocn :: CAddrMode -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mixedTypeLocn :: CAddrMode -> Bool
 mixedTypeLocn :: CAddrMode -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkAbsCStmtList :: AbstractC -> [AbstractC]
 mkAbsCStmtList :: AbstractC -> [AbstractC]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: AbstractC) (u1 :: AbstractC) -> _!_ _ORIG_ AbsCSyn AbsCStmts [] [u0, u1] _N_ #-}
 mkAbstractCs :: [AbstractC] -> AbstractC
 mkAbstractCs :: [AbstractC] -> AbstractC
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: [AbstractC]) -> case u0 of { _ALG_ (:) (u1 :: AbstractC) (u2 :: [AbstractC]) -> _APP_  _TYAPP_  _ORIG_ PreludeList foldr1 { AbstractC } [ _ORIG_ AbsCFuns mkAbsCStmts, u0 ]; _NIL_  -> _!_ _ORIG_ AbsCSyn AbsCNop [] []; _NO_DEFLT_ } _N_ #-}
 mkAlgAltsCSwitch :: CAddrMode -> [(Int, AbstractC)] -> AbstractC -> AbstractC
 mkAlgAltsCSwitch :: CAddrMode -> [(Int, AbstractC)] -> AbstractC -> AbstractC
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _N_ _N_ _N_ #-}
 nonemptyAbsC :: AbstractC -> Labda AbstractC
 nonemptyAbsC :: AbstractC -> Labda AbstractC
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkMachInt :: Integer -> BasicLit
 mkMachInt :: Integer -> BasicLit
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkMachWord :: Integer -> BasicLit
 mkMachWord :: Integer -> BasicLit
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 addOff :: HeapOffset -> HeapOffset -> HeapOffset
 addOff :: HeapOffset -> HeapOffset -> HeapOffset
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 fixedHdrSize :: HeapOffset
 fixedHdrSize :: HeapOffset
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 dumpRealC :: (GlobalSwitch -> Bool) -> AbstractC -> [Char]
 dumpRealC :: (GlobalSwitch -> Bool) -> AbstractC -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 infoptr :: MagicId
 infoptr :: MagicId
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intOff :: Int -> HeapOffset
 intOff :: Int -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 intOffsetIntoGoods :: HeapOffset -> Labda Int
 intOffsetIntoGoods :: HeapOffset -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isVolatileReg :: MagicId -> Bool
 isVolatileReg :: MagicId -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: MagicId) -> _!_ True [] [] _N_ #-}
 isZeroOff :: HeapOffset -> Bool
 isZeroOff :: HeapOffset -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maxOff :: HeapOffset -> HeapOffset -> HeapOffset
 maxOff :: HeapOffset -> HeapOffset -> HeapOffset
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 mkCCostCentre :: CostCentre -> CAddrMode
 mkCCostCentre :: CostCentre -> CAddrMode
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkIntCLit :: Int -> CAddrMode
 mkIntCLit :: Int -> CAddrMode
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 node :: MagicId
 node :: MagicId
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
 possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 pprHeapOffset :: PprStyle -> HeapOffset -> CSeq
 pprHeapOffset :: PprStyle -> HeapOffset -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 subOff :: HeapOffset -> HeapOffset -> HeapOffset
 subOff :: HeapOffset -> HeapOffset -> HeapOffset
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 totHdrSize :: SMRep -> HeapOffset
 totHdrSize :: SMRep -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 varHdrSize :: SMRep -> HeapOffset
 varHdrSize :: SMRep -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 zeroOff :: HeapOffset
 zeroOff :: HeapOffset
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 writeRealC :: (GlobalSwitch -> Bool) -> _FILE -> AbstractC -> _State _RealWorld -> ((), _State _RealWorld)
 writeRealC :: (GlobalSwitch -> Bool) -> _FILE -> AbstractC -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LU(P)LL" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq MagicId
 instance Eq MagicId
-       {-# GHC_PRAGMA _M_ AbsCSyn {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(MagicId -> MagicId -> Bool), (MagicId -> MagicId -> Bool)] [_CONSTM_ Eq (==) (MagicId), _CONSTM_ Eq (/=) (MagicId)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq BasicLit
 instance Eq BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool)] [_CONSTM_ Eq (==) (BasicLit), _CONSTM_ Eq (/=) (BasicLit)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq CLabel
 instance Eq CLabel
-       {-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool)] [_CONSTM_ Eq (==) (CLabel), _CONSTM_ Eq (/=) (CLabel)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq GlobalSwitch
 instance Eq GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool)] [_CONSTM_ Eq (==) (GlobalSwitch), _CONSTM_ Eq (/=) (GlobalSwitch)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq SimplifierSwitch
 instance Eq SimplifierSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool)] [_CONSTM_ Eq (==) (SimplifierSwitch), _CONSTM_ Eq (/=) (SimplifierSwitch)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq PrimKind
 instance Eq PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool)] [_CONSTM_ Eq (==) (PrimKind), _CONSTM_ Eq (/=) (PrimKind)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq PrimOp
 instance Eq PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord BasicLit
 instance Ord BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq BasicLit}}, (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> _CMP_TAG)] [_DFUN_ Eq (BasicLit), _CONSTM_ Ord (<) (BasicLit), _CONSTM_ Ord (<=) (BasicLit), _CONSTM_ Ord (>=) (BasicLit), _CONSTM_ Ord (>) (BasicLit), _CONSTM_ Ord max (BasicLit), _CONSTM_ Ord min (BasicLit), _CONSTM_ Ord _tagCmp (BasicLit)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord CLabel
 instance Ord CLabel
-       {-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq CLabel}}, (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> _CMP_TAG)] [_DFUN_ Eq (CLabel), _CONSTM_ Ord (<) (CLabel), _CONSTM_ Ord (<=) (CLabel), _CONSTM_ Ord (>=) (CLabel), _CONSTM_ Ord (>) (CLabel), _CONSTM_ Ord max (CLabel), _CONSTM_ Ord min (CLabel), _CONSTM_ Ord _tagCmp (CLabel)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord GlobalSwitch
 instance Ord GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq GlobalSwitch}}, (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> _CMP_TAG)] [_DFUN_ Eq (GlobalSwitch), _CONSTM_ Ord (<) (GlobalSwitch), _CONSTM_ Ord (<=) (GlobalSwitch), _CONSTM_ Ord (>=) (GlobalSwitch), _CONSTM_ Ord (>) (GlobalSwitch), _CONSTM_ Ord max (GlobalSwitch), _CONSTM_ Ord min (GlobalSwitch), _CONSTM_ Ord _tagCmp (GlobalSwitch)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord SimplifierSwitch
 instance Ord SimplifierSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq SimplifierSwitch}}, (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> SimplifierSwitch), (SimplifierSwitch -> SimplifierSwitch -> SimplifierSwitch), (SimplifierSwitch -> SimplifierSwitch -> _CMP_TAG)] [_DFUN_ Eq (SimplifierSwitch), _CONSTM_ Ord (<) (SimplifierSwitch), _CONSTM_ Ord (<=) (SimplifierSwitch), _CONSTM_ Ord (>=) (SimplifierSwitch), _CONSTM_ Ord (>) (SimplifierSwitch), _CONSTM_ Ord max (SimplifierSwitch), _CONSTM_ Ord min (SimplifierSwitch), _CONSTM_ Ord _tagCmp (SimplifierSwitch)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord PrimKind
 instance Ord PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq PrimKind}}, (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> _CMP_TAG)] [_DFUN_ Eq (PrimKind), _CONSTM_ Ord (<) (PrimKind), _CONSTM_ Ord (<=) (PrimKind), _CONSTM_ Ord (>=) (PrimKind), _CONSTM_ Ord (>) (PrimKind), _CONSTM_ Ord max (PrimKind), _CONSTM_ Ord min (PrimKind), _CONSTM_ Ord _tagCmp (PrimKind)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (a, b)
 instance (Outputable a, Outputable b) => Outputable (a, b)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-}
 instance Outputable BasicLit
 instance Outputable BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BasicLit) _N_
-        ppr = _A_ 0 _U_ 2122 _N_ _N_ _N_ _N_ #-}
 instance Outputable Bool
 instance Outputable Bool
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable PrimKind
 instance Outputable PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (PrimKind) _N_
-        ppr = _A_ 2 _U_ 0120 _N_ _S_ "AL" {_A_ 1 _U_ 120 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable PrimOp
 instance Outputable PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-}
 instance Outputable a => Outputable (StgAtom a)
 instance Outputable a => Outputable (StgAtom a)
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _F_ _IF_ARGS_ 1 3 XXC 8 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: StgAtom u0) -> case u3 of { _ALG_ _ORIG_ StgSyn StgVarAtom (u4 :: u0) -> _APP_  u1 [ u2, u4 ]; _ORIG_ StgSyn StgLitAtom (u5 :: BasicLit) -> _APP_  _CONSTM_ Outputable ppr (BasicLit) [ u2, u5 ]; _NO_DEFLT_ } _N_ #-}
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgExpr a b)
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgExpr a b)
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable [a]
 instance Outputable a => Outputable [a]
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Text CExprMacro
 instance Text CExprMacro
-       {-# GHC_PRAGMA _M_ AbsCSyn {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CExprMacro, [Char])]), (Int -> CExprMacro -> [Char] -> [Char]), ([Char] -> [([CExprMacro], [Char])]), ([CExprMacro] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CExprMacro), _CONSTM_ Text showsPrec (CExprMacro), _CONSTM_ Text readList (CExprMacro), _CONSTM_ Text showList (CExprMacro)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CExprMacro, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text CStmtMacro
 instance Text CStmtMacro
-       {-# GHC_PRAGMA _M_ AbsCSyn {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CStmtMacro, [Char])]), (Int -> CStmtMacro -> [Char] -> [Char]), ([Char] -> [([CStmtMacro], [Char])]), ([CStmtMacro] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CStmtMacro), _CONSTM_ Text showsPrec (CStmtMacro), _CONSTM_ Text readList (CStmtMacro), _CONSTM_ Text showList (CStmtMacro)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CStmtMacro, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index e66f7a7..23e7220 100644 (file)
@@ -216,6 +216,9 @@ stored in a mixed type location.)
                        -- ClosureInfo, because the latter refers to the *right* hand
                        -- side of a defn, whereas the "description" refers to *left*
                        -- hand side
                        -- ClosureInfo, because the latter refers to the *right* hand
                        -- side of a defn, whereas the "description" refers to *left*
                        -- hand side
+       Int             -- Liveness info; this is here because it is
+                       -- easy to produce w/in the CgMonad; hard
+                       -- thereafter.  (WDP 95/11)
 
   | CRetVector                 -- Return vector with "holes"
                                -- (Nothings) for the default
 
   | CRetVector                 -- Return vector with "holes"
                                -- (Nothings) for the default
@@ -542,7 +545,7 @@ data MagicId
   | LivenessReg        -- (parallel only) used when we need to record explicitly
                -- what registers are live
 
   | LivenessReg        -- (parallel only) used when we need to record explicitly
                -- what registers are live
 
-  | ActivityReg                -- mentioned only in nativeGen
+  | ActivityReg                -- mentioned only in nativeGen (UNUSED)
   | StdUpdRetVecReg    -- mentioned only in nativeGen
   | StkStubReg         -- register holding STK_STUB_closure (for stubbing dead stack slots)
 
   | StdUpdRetVecReg    -- mentioned only in nativeGen
   | StkStubReg         -- register holding STK_STUB_closure (for stubbing dead stack slots)
 
@@ -589,7 +592,7 @@ tagOf_MagicId SuB           = ILIT(7)
 tagOf_MagicId Hp               = ILIT(8)
 tagOf_MagicId HpLim            = ILIT(9)
 tagOf_MagicId LivenessReg      = ILIT(10)
 tagOf_MagicId Hp               = ILIT(8)
 tagOf_MagicId HpLim            = ILIT(9)
 tagOf_MagicId LivenessReg      = ILIT(10)
-tagOf_MagicId ActivityReg      = ILIT(11)
+--tagOf_MagicId ActivityReg    = ILIT(11) -- UNUSED
 tagOf_MagicId StdUpdRetVecReg  = ILIT(12)
 tagOf_MagicId StkStubReg       = ILIT(13)
 tagOf_MagicId CurCostCentre    = ILIT(14)
 tagOf_MagicId StdUpdRetVecReg  = ILIT(12)
 tagOf_MagicId StkStubReg       = ILIT(13)
 tagOf_MagicId CurCostCentre    = ILIT(14)
index 0142894..9d50cf1 100644 (file)
@@ -4,29 +4,9 @@ import AbsCSyn(AbstractC, CAddrMode)
 data CostRes   = Cost (Int, Int, Int, Int, Int)
 data Side   = Lhs | Rhs
 addrModeCosts :: CAddrMode -> Side -> CostRes
 data CostRes   = Cost (Int, Int, Int, Int, Int)
 data Side   = Lhs | Rhs
 addrModeCosts :: CAddrMode -> Side -> CostRes
-       {-# GHC_PRAGMA _A_ 2 _U_ 00 _N_ _S_ "AA" {_A_ 0 _N_ _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: CAddrMode) (u1 :: Side) -> _ORIG_ Costs nullCosts _N_ #-}
 costs :: AbstractC -> CostRes
 costs :: AbstractC -> CostRes
-       {-# GHC_PRAGMA _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: AbstractC) -> _ORIG_ Costs nullCosts _N_ #-}
 nullCosts :: CostRes
 nullCosts :: CostRes
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instance Eq CostRes
 instance Eq CostRes
-       {-# GHC_PRAGMA _M_ Costs {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(CostRes -> CostRes -> Bool), (CostRes -> CostRes -> Bool)] [_CONSTM_ Eq (==) (CostRes), _CONSTM_ Eq (/=) (CostRes)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: CostRes) (u1 :: CostRes) -> _APP_  _TYAPP_  patError# { (CostRes -> CostRes -> Bool) } [ _NOREP_S_ "%DPreludeCore.Eq.(==)\"", u0, u1 ] _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Num CostRes
 instance Num CostRes
-       {-# GHC_PRAGMA _M_ Costs {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [{{Eq CostRes}}, {{Text CostRes}}, (CostRes -> CostRes -> CostRes), (CostRes -> CostRes -> CostRes), (CostRes -> CostRes -> CostRes), (CostRes -> CostRes), (CostRes -> CostRes), (CostRes -> CostRes), (Integer -> CostRes), (Int -> CostRes)] [_DFUN_ Eq (CostRes), _DFUN_ Text (CostRes), _CONSTM_ Num (+) (CostRes), _CONSTM_ Num (-) (CostRes), _CONSTM_ Num (*) (CostRes), _CONSTM_ Num negate (CostRes), _CONSTM_ Num abs (CostRes), _CONSTM_ Num signum (CostRes), _CONSTM_ Num fromInteger (CostRes), _CONSTM_ Num fromInt (CostRes)] _N_
-        (+) = _A_ 2 _U_ 00 _N_ _S_ "AA" {_A_ 0 _N_ _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: CostRes) (u1 :: CostRes) -> _ORIG_ Costs nullCosts _N_,
-        (-) = _A_ 2 _U_ 00 _N_ _S_ "AA" {_A_ 0 _N_ _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: CostRes) (u1 :: CostRes) -> _ORIG_ Costs nullCosts _N_,
-        (*) = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: CostRes) (u1 :: CostRes) -> _APP_  _TYAPP_  patError# { (CostRes -> CostRes -> CostRes) } [ _NOREP_S_ "%DPreludeCore.Num.(*)\"", u0, u1 ] _N_,
-        negate = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: CostRes) -> _APP_  _TYAPP_  patError# { (CostRes -> CostRes) } [ _NOREP_S_ "%DPreludeCore.Num.negate\"", u0 ] _N_,
-        abs = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: CostRes) -> _APP_  _TYAPP_  patError# { (CostRes -> CostRes) } [ _NOREP_S_ "%DPreludeCore.Num.abs\"", u0 ] _N_,
-        signum = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: CostRes) -> _APP_  _TYAPP_  patError# { (CostRes -> CostRes) } [ _NOREP_S_ "%DPreludeCore.Num.signum\"", u0 ] _N_,
-        fromInteger = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Integer) -> _APP_  _TYAPP_  patError# { (Integer -> CostRes) } [ _NOREP_S_ "%DPreludeCore.Num.fromInteger\"", u0 ] _N_,
-        fromInt = _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 instance Text CostRes
 instance Text CostRes
-       {-# GHC_PRAGMA _M_ Costs {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CostRes, [Char])]), (Int -> CostRes -> [Char] -> [Char]), ([Char] -> [([CostRes], [Char])]), ([CostRes] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CostRes), _CONSTM_ Text showsPrec (CostRes), _CONSTM_ Text readList (CostRes), _CONSTM_ Text showList (CostRes)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CostRes, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: CostRes) (u2 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> CostRes -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 1b16d6d..7b486b4 100644 (file)
@@ -238,7 +238,7 @@ costs absC =
 
    CStaticClosure _ _ _ _    -> nullCosts
                             
 
    CStaticClosure _ _ _ _    -> nullCosts
                             
-   CClosureInfoAndCode _ _ _ _ _ -> nullCosts
+   CClosureInfoAndCode _ _ _ _ _ _ -> nullCosts
                             
    CRetVector _ _ _          -> nullCosts
                             
                             
    CRetVector _ _ _          -> nullCosts
                             
@@ -449,7 +449,6 @@ primOpCosts (CCallOp _ _ _ _ _) = SAVE_COSTS + CCALL_COSTS_GUESS +
 
 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
 
 primOpCosts IntMulOp  = Cost (3, 1, 0, 0, 0)  + umul_costs
 primOpCosts IntQuotOp = Cost (3, 1, 0, 0, 0)  + div_costs
-primOpCosts IntDivOp  = Cost (3, 1, 0, 0, 0) -- div dclosure already costed
 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 primOpCosts IntAbsOp  = Cost (0, 1, 0, 0, 0) -- abs closure already costed
 primOpCosts IntRemOp  = Cost (3, 1, 0, 0, 0)  + rem_costs
 primOpCosts IntNegOp  = Cost (1, 1, 0, 0, 0) -- translates into 1 sub
 primOpCosts IntAbsOp  = Cost (0, 1, 0, 0, 0) -- abs closure already costed
@@ -539,7 +538,7 @@ data PrimOp
     -- but these take more than that; see special cases in primOpCosts
     -- I counted the generated ass. instructions for these -> checked
     | IntMulOp | IntQuotOp
     -- but these take more than that; see special cases in primOpCosts
     -- I counted the generated ass. instructions for these -> checked
     | IntMulOp | IntQuotOp
-    | IntDivOp | IntRemOp | IntNegOp | IntAbsOp
+    | IntRemOp | IntNegOp | IntAbsOp
 
     -- Rest is unchecked so far -- HWL
 
 
     -- Rest is unchecked so far -- HWL
 
index 5e06692..3506ac8 100644 (file)
@@ -1,6 +1,7 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface HeapOffs where
 import CharSeq(CSeq)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface HeapOffs where
 import CharSeq(CSeq)
+import MachDesc(Target)
 import Maybes(Labda)
 import Pretty(PprStyle)
 import SMRep(SMRep)
 import Maybes(Labda)
 import Pretty(PprStyle)
 import SMRep(SMRep)
@@ -12,27 +13,16 @@ type VirtualHeapOffset = HeapOffset
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 addOff :: HeapOffset -> HeapOffset -> HeapOffset
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 addOff :: HeapOffset -> HeapOffset -> HeapOffset
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 fixedHdrSize :: HeapOffset
 fixedHdrSize :: HeapOffset
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+hpRelToInt :: Target -> HeapOffset -> Int
 intOff :: Int -> HeapOffset
 intOff :: Int -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 intOffsetIntoGoods :: HeapOffset -> Labda Int
 intOffsetIntoGoods :: HeapOffset -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isZeroOff :: HeapOffset -> Bool
 isZeroOff :: HeapOffset -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maxOff :: HeapOffset -> HeapOffset -> HeapOffset
 maxOff :: HeapOffset -> HeapOffset -> HeapOffset
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
 possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 pprHeapOffset :: PprStyle -> HeapOffset -> CSeq
 pprHeapOffset :: PprStyle -> HeapOffset -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 subOff :: HeapOffset -> HeapOffset -> HeapOffset
 subOff :: HeapOffset -> HeapOffset -> HeapOffset
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 totHdrSize :: SMRep -> HeapOffset
 totHdrSize :: SMRep -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 varHdrSize :: SMRep -> HeapOffset
 varHdrSize :: SMRep -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 zeroOff :: HeapOffset
 zeroOff :: HeapOffset
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index c5f6fe4..92aab86 100644 (file)
@@ -15,13 +15,12 @@ import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import Stdio(_FILE)
 import Unique(Unique)
 import PrimOps(PrimOp)
 import Stdio(_FILE)
 import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data AbstractC 
+data CAddrMode 
+data MagicId 
+data CSeq 
+data PprStyle 
 dumpRealC :: (GlobalSwitch -> Bool) -> AbstractC -> [Char]
 dumpRealC :: (GlobalSwitch -> Bool) -> AbstractC -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+pprAmode :: PprStyle -> CAddrMode -> CSeq
 writeRealC :: (GlobalSwitch -> Bool) -> _FILE -> AbstractC -> _State _RealWorld -> ((), _State _RealWorld)
 writeRealC :: (GlobalSwitch -> Bool) -> _FILE -> AbstractC -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LU(P)LL" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 0d4f390..876f291 100644 (file)
@@ -337,7 +337,7 @@ pprAbsC sty stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
        };
 -}
 
        };
 -}
 
-pprAbsC sty stmt@(CClosureInfoAndCode cl_info slow maybe_fast upd cl_descr) _
+pprAbsC sty stmt@(CClosureInfoAndCode cl_info slow maybe_fast upd cl_descr liveness) _
   = uppAboves [
         uppBesides [
            pp_info_rep,
   = uppAboves [
         uppBesides [
            pp_info_rep,
@@ -350,13 +350,13 @@ pprAbsC sty stmt@(CClosureInfoAndCode cl_info slow maybe_fast upd cl_descr) _
            then uppBeside (pprCLabel sty (closureLabelFromCI cl_info)) uppComma
            else uppNil,
 
            then uppBeside (pprCLabel sty (closureLabelFromCI cl_info)) uppComma
            else uppNil,
 
-           pprCLabel sty slow_lbl,             uppComma,
-           pprAmode sty upd,                   uppComma,
-            uppInt (dataConLiveness cl_info),  uppComma,
+           pprCLabel sty slow_lbl,     uppComma,
+           pprAmode sty upd,           uppComma,
+            uppInt liveness,           uppComma,
 
 
-           pp_tag,                             uppComma,
-           pp_size,                            uppComma,
-           pp_ptr_wds,                         uppComma,
+           pp_tag,                     uppComma,
+           pp_size,                    uppComma,
+           pp_ptr_wds,                 uppComma,
 
            ppLocalness info_lbl,                               uppComma,
            ppLocalnessMacro True{-function-} slow_lbl,         uppComma,
 
            ppLocalness info_lbl,                               uppComma,
            ppLocalnessMacro True{-function-} slow_lbl,         uppComma,
@@ -508,7 +508,7 @@ pp_basic_saves
        uppPStr SLIT("CALLER_SAVE_SpB"),
        uppPStr SLIT("CALLER_SAVE_SuB"),
        uppPStr SLIT("CALLER_SAVE_Ret"),
        uppPStr SLIT("CALLER_SAVE_SpB"),
        uppPStr SLIT("CALLER_SAVE_SuB"),
        uppPStr SLIT("CALLER_SAVE_Ret"),
-       uppPStr SLIT("CALLER_SAVE_Activity"),
+--     uppPStr SLIT("CALLER_SAVE_Activity"),
        uppPStr SLIT("CALLER_SAVE_Hp"),
        uppPStr SLIT("CALLER_SAVE_HpLim") ]
 
        uppPStr SLIT("CALLER_SAVE_Hp"),
        uppPStr SLIT("CALLER_SAVE_HpLim") ]
 
@@ -520,7 +520,7 @@ pp_basic_restores
        uppPStr SLIT("CALLER_RESTORE_SpB"),
        uppPStr SLIT("CALLER_RESTORE_SuB"),
        uppPStr SLIT("CALLER_RESTORE_Ret"),
        uppPStr SLIT("CALLER_RESTORE_SpB"),
        uppPStr SLIT("CALLER_RESTORE_SuB"),
        uppPStr SLIT("CALLER_RESTORE_Ret"),
-       uppPStr SLIT("CALLER_RESTORE_Activity"),
+--     uppPStr SLIT("CALLER_RESTORE_Activity"),
        uppPStr SLIT("CALLER_RESTORE_Hp"),
        uppPStr SLIT("CALLER_RESTORE_HpLim"),
        uppPStr SLIT("CALLER_RESTORE_StdUpdRetVec"),
        uppPStr SLIT("CALLER_RESTORE_Hp"),
        uppPStr SLIT("CALLER_RESTORE_HpLim"),
        uppPStr SLIT("CALLER_RESTORE_StdUpdRetVec"),
@@ -1086,7 +1086,7 @@ pprMagicId sty SuB                    = uppPStr SLIT("SuB")
 pprMagicId sty Hp                  = uppPStr SLIT("Hp")
 pprMagicId sty HpLim               = uppPStr SLIT("HpLim")
 pprMagicId sty LivenessReg         = uppPStr SLIT("LivenessReg")
 pprMagicId sty Hp                  = uppPStr SLIT("Hp")
 pprMagicId sty HpLim               = uppPStr SLIT("HpLim")
 pprMagicId sty LivenessReg         = uppPStr SLIT("LivenessReg")
-pprMagicId sty ActivityReg         = uppPStr SLIT("ActivityReg")
+--UNUSED pprMagicId sty ActivityReg        = uppPStr SLIT("ActivityReg")
 pprMagicId sty StdUpdRetVecReg      = uppPStr SLIT("StdUpdRetVecReg")
 pprMagicId sty StkStubReg          = uppPStr SLIT("StkStubReg")
 pprMagicId sty CurCostCentre       = uppPStr SLIT("CCC")
 pprMagicId sty StdUpdRetVecReg      = uppPStr SLIT("StdUpdRetVecReg")
 pprMagicId sty StkStubReg          = uppPStr SLIT("StkStubReg")
 pprMagicId sty CurCostCentre       = uppPStr SLIT("CCC")
@@ -1325,7 +1325,7 @@ ppr_decls_AbsC (CStaticClosure closure_lbl closure_info cost_centre amodes)
        -- ToDo: strictly speaking, should chk "cost_centre" amode
   = ppr_decls_Amodes amodes
 
        -- ToDo: strictly speaking, should chk "cost_centre" amode
   = ppr_decls_Amodes amodes
 
-ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast upd_lbl closure_descr)
+ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast upd_lbl _ _)
   = ppr_decls_Amodes [entry_lbl, upd_lbl]      `thenTE` \ p1 ->
     ppr_decls_AbsC slow                                `thenTE` \ p2 ->
     (case maybe_fast of
   = ppr_decls_Amodes [entry_lbl, upd_lbl]      `thenTE` \ p1 ->
     ppr_decls_AbsC slow                                `thenTE` \ p2 ->
     (case maybe_fast of
index ad4aab0..7124b91 100644 (file)
@@ -3,12 +3,11 @@ interface AbsSyn where
 import AbsSynFuns(cmpInstanceTypes, collectBinders, collectMonoBinders, collectMonoBindersAndLocs, collectPatBinders, collectQualBinders, collectTopLevelBinders, collectTypedBinders, collectTypedPatBinders, extractMonoTyNames, getNonPrelOuterTyCon, mkDictApp, mkDictLam, mkTyApp, mkTyLam)
 import Bag(Bag)
 import BasicLit(BasicLit)
 import AbsSynFuns(cmpInstanceTypes, collectBinders, collectMonoBinders, collectMonoBindersAndLocs, collectPatBinders, collectQualBinders, collectTopLevelBinders, collectTypedBinders, collectTypedPatBinders, extractMonoTyNames, getNonPrelOuterTyCon, mkDictApp, mkDictLam, mkTyApp, mkTyLam)
 import Bag(Bag)
 import BasicLit(BasicLit)
-import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
+import BinderInfo(BinderInfo)
 import CharSeq(CSeq)
 import CharSeq(CSeq)
-import Class(Class, ClassOp, cmpClass)
+import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CmdLineOpts(GlobalSwitch)
-import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
-import CostCentre(CostCentre)
+import CoreSyn(CoreAtom, CoreExpr)
 import FiniteMap(FiniteMap)
 import HsBinds(Bind(..), Binds(..), MonoBinds(..), ProtoNameBind(..), ProtoNameBinds(..), ProtoNameClassOpSig(..), ProtoNameMonoBinds(..), ProtoNameSig(..), RenamedBind(..), RenamedBinds(..), RenamedClassOpSig(..), RenamedMonoBinds(..), RenamedSig(..), Sig(..), TypecheckedBind(..), TypecheckedBinds(..), TypecheckedMonoBinds(..), nullBinds, nullMonoBinds)
 import HsCore(UfCostCentre, UfId, UnfoldingCoreAlts, UnfoldingCoreAtom, UnfoldingCoreBinding, UnfoldingCoreExpr, UnfoldingPrimOp)
 import FiniteMap(FiniteMap)
 import HsBinds(Bind(..), Binds(..), MonoBinds(..), ProtoNameBind(..), ProtoNameBinds(..), ProtoNameClassOpSig(..), ProtoNameMonoBinds(..), ProtoNameSig(..), RenamedBind(..), RenamedBinds(..), RenamedClassOpSig(..), RenamedMonoBinds(..), RenamedSig(..), Sig(..), TypecheckedBind(..), TypecheckedBinds(..), TypecheckedMonoBinds(..), nullBinds, nullMonoBinds)
 import HsCore(UfCostCentre, UfId, UnfoldingCoreAlts, UnfoldingCoreAtom, UnfoldingCoreBinding, UnfoldingCoreExpr, UnfoldingPrimOp)
@@ -20,85 +19,54 @@ import HsMatches(GRHS(..), GRHSsAndBinds(..), Match(..), ProtoNameGRHS(..), Prot
 import HsPat(InPat(..), ProtoNamePat(..), RenamedPat(..), TypecheckedPat(..), irrefutablePat, isConPat, isLitPat, patsAreAllCons, patsAreAllLits, typeOfPat, unfailablePat, unfailablePats)
 import HsPragmas(ClassOpPragmas, ClassPragmas, DataPragmas, GenPragmas, ImpStrictness, ImpUnfolding, InstancePragmas, ProtoNameClassOpPragmas(..), ProtoNameClassPragmas(..), ProtoNameDataPragmas(..), ProtoNameGenPragmas(..), ProtoNameInstancePragmas(..), RenamedClassOpPragmas(..), RenamedClassPragmas(..), RenamedDataPragmas(..), RenamedGenPragmas(..), RenamedInstancePragmas(..), TypePragmas)
 import HsTypes(ClassAssertion(..), Context(..), MonoType(..), PolyType(..), ProtoNameContext(..), ProtoNameMonoType(..), ProtoNamePolyType(..), RenamedContext(..), RenamedMonoType(..), RenamedPolyType(..), cmpPolyType, eqMonoType, pprContext)
 import HsPat(InPat(..), ProtoNamePat(..), RenamedPat(..), TypecheckedPat(..), irrefutablePat, isConPat, isLitPat, patsAreAllCons, patsAreAllLits, typeOfPat, unfailablePat, unfailablePats)
 import HsPragmas(ClassOpPragmas, ClassPragmas, DataPragmas, GenPragmas, ImpStrictness, ImpUnfolding, InstancePragmas, ProtoNameClassOpPragmas(..), ProtoNameClassPragmas(..), ProtoNameDataPragmas(..), ProtoNameGenPragmas(..), ProtoNameInstancePragmas(..), RenamedClassOpPragmas(..), RenamedClassPragmas(..), RenamedDataPragmas(..), RenamedGenPragmas(..), RenamedInstancePragmas(..), TypePragmas)
 import HsTypes(ClassAssertion(..), Context(..), MonoType(..), PolyType(..), ProtoNameContext(..), ProtoNameMonoType(..), ProtoNamePolyType(..), RenamedContext(..), RenamedMonoType(..), RenamedPolyType(..), cmpPolyType, eqMonoType, pprContext)
-import Id(DictVar(..), Id, IdDetails)
+import Id(DictVar(..), Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo)
-import Inst(Inst, InstOrigin, OverloadedLit)
-import InstEnv(InstTemplate)
+import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, StrictnessInfo, UpdateInfo)
+import Inst(Inst)
 import Maybes(Labda)
 import Name(Name(..))
 import Maybes(Labda)
 import Name(Name(..))
-import NameTypes(FullName, Provenance, ShortName)
+import NameTypes(FullName, ShortName)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
-import PrimOps(PrimOp, pprPrimOp)
+import PrimOps(PrimOp)
 import ProtoName(ProtoName)
 import RenameAuxFuns(PreludeNameFun(..))
 import ProtoName(ProtoName)
 import RenameAuxFuns(PreludeNameFun(..))
-import SimplEnv(UnfoldingDetails, UnfoldingGuidance)
+import SimplEnv(UnfoldingGuidance)
 import SrcLoc(SrcLoc)
 import SrcLoc(SrcLoc)
-import TyCon(Arity(..), TyCon, cmpTyCon)
-import TyVar(TyVar, TyVarTemplate, cmpTyVar)
-import UniType(TauType(..), UniType, cmpUniType)
+import TyCon(Arity(..), TyCon)
+import TyVar(TyVar)
+import UniType(TauType(..), UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 class OptIdInfo a where
        noInfo :: a
 import UniqFM(UniqFM)
 import Unique(Unique)
 class OptIdInfo a where
        noInfo :: a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) -> _APP_  _TYAPP_  patError# { u0 } [ _NOREP_S_ "%DIdInfo.OptIdInfo.noInfo\"" ] _N_ #-}
        getInfo :: IdInfo -> a
        getInfo :: IdInfo -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.getInfo\"", u2 ] _N_ #-}
        addInfo :: IdInfo -> a -> IdInfo
        addInfo :: IdInfo -> a -> IdInfo
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) (u3 :: u0) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0 -> IdInfo) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.addInfo\"", u2, u3 ] _N_ #-}
        ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
        ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 6 _U_ 022222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 6 XXXXXX 7 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: PprStyle) (u3 :: Id -> Id) (u4 :: u0) (u5 :: Int) (u6 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.ppInfo\"", u2, u3, u4, u5, u6 ] _N_ #-}
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
+data Bag a 
+data BasicLit 
+data BinderInfo 
+data Class 
+data ClassOp 
+data CoreAtom a 
+data CoreExpr a b 
+data FiniteMap a b 
 data Bind a b   = EmptyBind | NonRecBind (MonoBinds a b) | RecBind (MonoBinds a b)
 data Binds a b   = EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b)
 data MonoBinds a b   = EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc
 data Bind a b   = EmptyBind | NonRecBind (MonoBinds a b) | RecBind (MonoBinds a b)
 data Binds a b   = EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b)
 data MonoBinds a b   = EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc
@@ -116,10 +84,10 @@ data Sig a   = Sig a (PolyType a) (GenPragmas a) SrcLoc | ClassOpSig a (PolyType
 type TypecheckedBind = Bind Id TypecheckedPat
 type TypecheckedBinds = Binds Id TypecheckedPat
 type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat
 type TypecheckedBind = Bind Id TypecheckedPat
 type TypecheckedBinds = Binds Id TypecheckedPat
 type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat
-data UfCostCentre a    {-# GHC_PRAGMA UfPreludeDictsCC Bool | UfAllDictsCC _PackedString _PackedString Bool | UfUserCC _PackedString _PackedString _PackedString Bool Bool | UfAutoCC (UfId a) _PackedString _PackedString Bool Bool | UfDictCC (UfId a) _PackedString _PackedString Bool Bool #-}
-data UnfoldingCoreAtom a       {-# GHC_PRAGMA UfCoVarAtom (UfId a) | UfCoLitAtom BasicLit #-}
-data UnfoldingCoreExpr a       {-# GHC_PRAGMA UfCoVar (UfId a) | UfCoLit BasicLit | UfCoCon a [PolyType a] [UnfoldingCoreAtom a] | UfCoPrim (UnfoldingPrimOp a) [PolyType a] [UnfoldingCoreAtom a] | UfCoLam [(a, PolyType a)] (UnfoldingCoreExpr a) | UfCoTyLam a (UnfoldingCoreExpr a) | UfCoApp (UnfoldingCoreExpr a) (UnfoldingCoreAtom a) | UfCoTyApp (UnfoldingCoreExpr a) (PolyType a) | UfCoCase (UnfoldingCoreExpr a) (UnfoldingCoreAlts a) | UfCoLet (UnfoldingCoreBinding a) (UnfoldingCoreExpr a) | UfCoSCC (UfCostCentre a) (UnfoldingCoreExpr a) #-}
-data UnfoldingPrimOp a         {-# GHC_PRAGMA UfCCallOp _PackedString Bool Bool [PolyType a] (PolyType a) | UfOtherOp PrimOp #-}
+data UfCostCentre a 
+data UnfoldingCoreAtom a 
+data UnfoldingCoreExpr a 
+data UnfoldingPrimOp a 
 data ClassDecl a b   = ClassDecl [(a, a)] a a [Sig a] (MonoBinds a b) (ClassPragmas a) SrcLoc
 data ConDecl a   = ConDecl a [MonoType a] SrcLoc
 data DataTypeSig a   = AbstractTypeSig a SrcLoc | SpecDataSig a (MonoType a) SrcLoc
 data ClassDecl a b   = ClassDecl [(a, a)] a a [Sig a] (MonoBinds a b) (ClassPragmas a) SrcLoc
 data ConDecl a   = ConDecl a [MonoType a] SrcLoc
 data DataTypeSig a   = AbstractTypeSig a SrcLoc | SpecDataSig a (MonoType a) SrcLoc
@@ -183,11 +151,11 @@ data InPat a   = WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a)
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
 data TypecheckedPat   = WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat)
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
 data TypecheckedPat   = WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat)
-data ClassOpPragmas a  {-# GHC_PRAGMA NoClassOpPragmas | ClassOpPragmas (GenPragmas a) (GenPragmas a) #-}
-data ClassPragmas a    {-# GHC_PRAGMA NoClassPragmas | SuperDictPragmas [GenPragmas a] #-}
-data DataPragmas a     {-# GHC_PRAGMA DataPragmas [ConDecl a] [[Labda (MonoType a)]] #-}
-data GenPragmas a      {-# GHC_PRAGMA NoGenPragmas | GenPragmas (Labda Int) (Labda UpdateInfo) DeforestInfo (ImpStrictness a) (ImpUnfolding a) [([Labda (MonoType a)], Int, GenPragmas a)] #-}
-data InstancePragmas a         {-# GHC_PRAGMA NoInstancePragmas | SimpleInstancePragma (GenPragmas a) | ConstantInstancePragma (GenPragmas a) [(a, GenPragmas a)] | SpecialisedInstancePragma (GenPragmas a) [([Labda (MonoType a)], Int, InstancePragmas a)] #-}
+data ClassOpPragmas a 
+data ClassPragmas a 
+data DataPragmas a 
+data GenPragmas a 
+data InstancePragmas a 
 type ProtoNameClassOpPragmas = ClassOpPragmas ProtoName
 type ProtoNameClassPragmas = ClassPragmas ProtoName
 type ProtoNameDataPragmas = DataPragmas ProtoName
 type ProtoNameClassOpPragmas = ClassOpPragmas ProtoName
 type ProtoNameClassPragmas = ClassPragmas ProtoName
 type ProtoNameDataPragmas = DataPragmas ProtoName
@@ -198,7 +166,7 @@ type RenamedClassPragmas = ClassPragmas Name
 type RenamedDataPragmas = DataPragmas Name
 type RenamedGenPragmas = GenPragmas Name
 type RenamedInstancePragmas = InstancePragmas Name
 type RenamedDataPragmas = DataPragmas Name
 type RenamedGenPragmas = GenPragmas Name
 type RenamedInstancePragmas = InstancePragmas Name
-data TypePragmas       {-# GHC_PRAGMA NoTypePragmas | AbstractTySynonym #-}
+data TypePragmas 
 type ClassAssertion a = (a, a)
 type Context a = [(a, a)]
 data MonoType a   = MonoTyVar a | MonoTyCon a [MonoType a] | FunMonoTy (MonoType a) (MonoType a) | ListMonoTy (MonoType a) | TupleMonoTy [PolyType a] | MonoTyVarTemplate a | MonoDict a (MonoType a)
 type ClassAssertion a = (a, a)
 type Context a = [(a, a)]
 data MonoType a   = MonoTyVar a | MonoTyCon a [MonoType a] | FunMonoTy (MonoType a) (MonoType a) | ListMonoTy (MonoType a) | TupleMonoTy [PolyType a] | MonoTyVarTemplate a | MonoDict a (MonoType a)
@@ -210,589 +178,181 @@ type RenamedContext = [(Name, Name)]
 type RenamedMonoType = MonoType Name
 type RenamedPolyType = PolyType Name
 type DictVar = Id
 type RenamedMonoType = MonoType Name
 type RenamedPolyType = PolyType Name
 type DictVar = Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data ArgUsage  {-# GHC_PRAGMA ArgUsage Int | UnknownArgUsage #-}
-data ArgUsageInfo      {-# GHC_PRAGMA NoArgUsageInfo | SomeArgUsageInfo [ArgUsage] #-}
-data ArityInfo         {-# GHC_PRAGMA UnknownArity | ArityExactly Int #-}
-data DeforestInfo      {-# GHC_PRAGMA Don'tDeforest | DoDeforest #-}
-data Demand    {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-}
-data DemandInfo        {-# GHC_PRAGMA UnknownDemand | DemandedAsPer Demand #-}
-data FBConsum  {-# GHC_PRAGMA FBGoodConsum | FBBadConsum #-}
-data FBProd    {-# GHC_PRAGMA FBGoodProd | FBBadProd #-}
-data FBType    {-# GHC_PRAGMA FBType [FBConsum] FBProd #-}
-data FBTypeInfo        {-# GHC_PRAGMA NoFBTypeInfo | SomeFBTypeInfo FBType #-}
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data ArgUsage 
+data ArgUsageInfo 
+data ArityInfo 
+data DeforestInfo 
+data Demand 
+data DemandInfo 
+data FBConsum 
+data FBProd 
+data FBType 
+data FBTypeInfo 
+data IdInfo 
+data Inst 
+data Labda a 
 data Name   = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString
 data Name   = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
+data FullName 
+data ExportFlag 
 data Module a b   = Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc
 data Module a b   = Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data PrimKind 
+data PrimOp 
+data ProtoName 
 type PreludeNameFun = _PackedString -> Labda Name
 type Arity = Int
 type ProtoNameModule = Module ProtoName (InPat ProtoName)
 type RenamedModule = Module Name (InPat Name)
 type PreludeNameFun = _PackedString -> Labda Name
 type Arity = Int
 type ProtoNameModule = Module ProtoName (InPat ProtoName)
 type RenamedModule = Module Name (InPat Name)
-data SpecEnv   {-# GHC_PRAGMA SpecEnv [SpecInfo] #-}
-data StrictnessInfo    {-# GHC_PRAGMA NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id) #-}
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
+data SpecEnv 
+data StrictnessInfo 
+data ShortName 
+data SrcLoc 
+data TyCon 
+data TyVar 
 type TauType = UniType
 type TypecheckedModule = Module Id TypecheckedPat
 type TauType = UniType
 type TypecheckedModule = Module Id TypecheckedPat
-data UpdateInfo        {-# GHC_PRAGMA NoUpdateInfo | SomeUpdateInfo [Int] #-}
-data UnfoldingGuidance         {-# GHC_PRAGMA UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UpdateInfo 
+data UnfoldingGuidance 
+data UniType 
+data UniqFM a 
+data Unique 
 cmpInstanceTypes :: MonoType ProtoName -> MonoType ProtoName -> Int#
 cmpInstanceTypes :: MonoType ProtoName -> MonoType ProtoName -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 collectBinders :: Bind a (InPat a) -> [a]
 collectBinders :: Bind a (InPat a) -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectMonoBinders :: MonoBinds a (InPat a) -> [a]
 collectMonoBinders :: MonoBinds a (InPat a) -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectMonoBindersAndLocs :: MonoBinds a (InPat a) -> [(a, SrcLoc)]
 collectMonoBindersAndLocs :: MonoBinds a (InPat a) -> [(a, SrcLoc)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectPatBinders :: InPat a -> [a]
 collectPatBinders :: InPat a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectQualBinders :: [Qual Name (InPat Name)] -> [Name]
 collectQualBinders :: [Qual Name (InPat Name)] -> [Name]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectTopLevelBinders :: Binds a (InPat a) -> [a]
 collectTopLevelBinders :: Binds a (InPat a) -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectTypedBinders :: Bind Id TypecheckedPat -> [Id]
 collectTypedBinders :: Bind Id TypecheckedPat -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectTypedPatBinders :: TypecheckedPat -> [Id]
 collectTypedPatBinders :: TypecheckedPat -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractMonoTyNames :: (a -> a -> Bool) -> MonoType a -> [a]
 extractMonoTyNames :: (a -> a -> Bool) -> MonoType a -> [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 getNonPrelOuterTyCon :: MonoType ProtoName -> Labda ProtoName
 getNonPrelOuterTyCon :: MonoType ProtoName -> Labda ProtoName
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: MonoType ProtoName) -> case u0 of { _ALG_ _ORIG_ HsTypes MonoTyCon (u1 :: ProtoName) (u2 :: [MonoType ProtoName]) -> _!_ _ORIG_ Maybes Ni [ProtoName] [u1]; (u3 :: MonoType ProtoName) -> _!_ _ORIG_ Maybes Hamna [ProtoName] [] } _N_ #-}
 mkDictApp :: Expr Id TypecheckedPat -> [Id] -> Expr Id TypecheckedPat
 mkDictApp :: Expr Id TypecheckedPat -> [Id] -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [Id]) -> case u1 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictApp [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u0; _NO_DEFLT_ } _N_ #-}
 mkDictLam :: [Id] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
 mkDictLam :: [Id] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [Id]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictLam [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkTyApp :: Expr Id TypecheckedPat -> [UniType] -> Expr Id TypecheckedPat
 mkTyApp :: Expr Id TypecheckedPat -> [UniType] -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [UniType]) -> case u1 of { _ALG_ (:) (u2 :: UniType) (u3 :: [UniType]) -> _!_ _ORIG_ HsExpr TyApp [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u0; _NO_DEFLT_ } _N_ #-}
 mkTyLam :: [TyVar] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
 mkTyLam :: [TyVar] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [TyVar]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: TyVar) (u3 :: [TyVar]) -> _!_ _ORIG_ HsExpr TyLam [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
-cmpClass :: Class -> Class -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 nullBinds :: Binds a b -> Bool
 nullBinds :: Binds a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 nullMonoBinds :: MonoBinds a b -> Bool
 nullMonoBinds :: MonoBinds a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 eqConDecls :: [ConDecl ProtoName] -> [ConDecl ProtoName] -> Bool
 eqConDecls :: [ConDecl ProtoName] -> [ConDecl ProtoName] -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 getIEStrings :: [IE] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())
 getIEStrings :: [IE] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getRawIEStrings :: [IE] -> ([(_PackedString, ExportFlag)], [_PackedString])
 getRawIEStrings :: [IE] -> ([(_PackedString, ExportFlag)], [_PackedString])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 negLiteral :: Literal -> Literal
 negLiteral :: Literal -> Literal
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 irrefutablePat :: TypecheckedPat -> Bool
 irrefutablePat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isConPat :: TypecheckedPat -> Bool
 isConPat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isLitPat :: TypecheckedPat -> Bool
 isLitPat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 patsAreAllCons :: [TypecheckedPat] -> Bool
 patsAreAllCons :: [TypecheckedPat] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 patsAreAllLits :: [TypecheckedPat] -> Bool
 patsAreAllLits :: [TypecheckedPat] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 typeOfPat :: TypecheckedPat -> UniType
 typeOfPat :: TypecheckedPat -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unfailablePat :: TypecheckedPat -> Bool
 unfailablePat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unfailablePats :: [TypecheckedPat] -> Bool
 unfailablePats :: [TypecheckedPat] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 cmpPolyType :: (a -> a -> Int#) -> PolyType a -> PolyType a -> Int#
 cmpPolyType :: (a -> a -> Int#) -> PolyType a -> PolyType a -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 eqMonoType :: MonoType ProtoName -> MonoType ProtoName -> Bool
 eqMonoType :: MonoType ProtoName -> MonoType ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 pprContext :: Outputable a => PprStyle -> [(a, a)] -> Int -> Bool -> PrettyRep
 pprContext :: Outputable a => PprStyle -> [(a, a)] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-}
-pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
-cmpTyCon :: TyCon -> TyCon -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpTyVar :: TyVar -> TyVar -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpUniType :: Bool -> UniType -> UniType -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 instance Eq BasicLit
 instance Eq BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool)] [_CONSTM_ Eq (==) (BasicLit), _CONSTM_ Eq (/=) (BasicLit)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq Class
 instance Eq Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Class -> Class -> Bool), (Class -> Class -> Bool)] [_CONSTM_ Eq (==) (Class), _CONSTM_ Eq (/=) (Class)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ eqInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Eq (/=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq ClassOp
 instance Eq ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool)] [_CONSTM_ Eq (==) (ClassOp), _CONSTM_ Eq (/=) (ClassOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq Demand
 instance Eq Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Demand -> Demand -> Bool), (Demand -> Demand -> Bool)] [_CONSTM_ Eq (==) (Demand), _CONSTM_ Eq (/=) (Demand)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq FBConsum
 instance Eq FBConsum
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBConsum -> FBConsum -> Bool), (FBConsum -> FBConsum -> Bool)] [_CONSTM_ Eq (==) (FBConsum), _CONSTM_ Eq (/=) (FBConsum)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq FBProd
 instance Eq FBProd
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBProd -> FBProd -> Bool), (FBProd -> FBProd -> Bool)] [_CONSTM_ Eq (==) (FBProd), _CONSTM_ Eq (/=) (FBProd)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq FBType
 instance Eq FBType
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBType -> FBType -> Bool), (FBType -> FBType -> Bool)] [_CONSTM_ Eq (==) (FBType), _CONSTM_ Eq (/=) (FBType)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(LL)U(LL)" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(LL)U(LL)" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq UpdateInfo
 instance Eq UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool)] [_CONSTM_ Eq (==) (UpdateInfo), _CONSTM_ Eq (/=) (UpdateInfo)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq Name
 instance Eq Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Name -> Name -> Bool), (Name -> Name -> Bool)] [_CONSTM_ Eq (==) (Name), _CONSTM_ Eq (/=) (Name)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_  _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_  _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq PrimKind
 instance Eq PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool)] [_CONSTM_ Eq (==) (PrimKind), _CONSTM_ Eq (/=) (PrimKind)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq PrimOp
 instance Eq PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq TyCon
 instance Eq TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVar
 instance Eq TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool)] [_CONSTM_ Eq (==) (TyVar), _CONSTM_ Eq (/=) (TyVar)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance OptIdInfo ArgUsageInfo
 instance OptIdInfo ArgUsageInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [ArgUsageInfo, (IdInfo -> ArgUsageInfo), (IdInfo -> ArgUsageInfo -> IdInfo), (PprStyle -> (Id -> Id) -> ArgUsageInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (ArgUsageInfo), _CONSTM_ OptIdInfo getInfo (ArgUsageInfo), _CONSTM_ OptIdInfo addInfo (ArgUsageInfo), _CONSTM_ OptIdInfo ppInfo (ArgUsageInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoArgUsageInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArgUsageInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u8; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo ArityInfo
 instance OptIdInfo ArityInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [ArityInfo, (IdInfo -> ArityInfo), (IdInfo -> ArityInfo -> IdInfo), (PprStyle -> (Id -> Id) -> ArityInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (ArityInfo), _CONSTM_ OptIdInfo getInfo (ArityInfo), _CONSTM_ OptIdInfo addInfo (ArityInfo), _CONSTM_ OptIdInfo ppInfo (ArityInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownArity [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(SAAAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArityInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u1; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo DeforestInfo
 instance OptIdInfo DeforestInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [DeforestInfo, (IdInfo -> DeforestInfo), (IdInfo -> DeforestInfo -> IdInfo), (PprStyle -> (Id -> Id) -> DeforestInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (DeforestInfo), _CONSTM_ OptIdInfo getInfo (DeforestInfo), _CONSTM_ OptIdInfo addInfo (DeforestInfo), _CONSTM_ OptIdInfo ppInfo (DeforestInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo Don'tDeforest [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAEAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DeforestInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u7; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)E" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAE" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo DemandInfo
 instance OptIdInfo DemandInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [DemandInfo, (IdInfo -> DemandInfo), (IdInfo -> DemandInfo -> IdInfo), (PprStyle -> (Id -> Id) -> DemandInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (DemandInfo), _CONSTM_ OptIdInfo getInfo (DemandInfo), _CONSTM_ OptIdInfo addInfo (DemandInfo), _CONSTM_ OptIdInfo ppInfo (DemandInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownDemand [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(ASAAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DemandInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u2; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LALLLLLLLL)L" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 10122 _N_ _S_ "SAL" {_A_ 2 _U_ 1122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo FBTypeInfo
 instance OptIdInfo FBTypeInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [FBTypeInfo, (IdInfo -> FBTypeInfo), (IdInfo -> FBTypeInfo -> IdInfo), (PprStyle -> (Id -> Id) -> FBTypeInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (FBTypeInfo), _CONSTM_ OptIdInfo getInfo (FBTypeInfo), _CONSTM_ OptIdInfo addInfo (FBTypeInfo), _CONSTM_ OptIdInfo ppInfo (FBTypeInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoFBTypeInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: FBTypeInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u9; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20222 _N_ _S_ "SAS" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo SpecEnv
 instance OptIdInfo SpecEnv
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [SpecEnv, (IdInfo -> SpecEnv), (IdInfo -> SpecEnv -> IdInfo), (PprStyle -> (Id -> Id) -> SpecEnv -> Int -> Bool -> PrettyRep)] [_ORIG_ IdInfo nullSpecEnv, _CONSTM_ OptIdInfo getInfo (SpecEnv), _CONSTM_ OptIdInfo addInfo (SpecEnv), _CONSTM_ OptIdInfo ppInfo (SpecEnv)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ IdInfo nullSpecEnv _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAU(L)AAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [SpecInfo]) -> _!_ _ORIG_ IdInfo SpecEnv [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u3; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 11 _N_ _S_ "U(LLU(L)LLLLLLL)U(L)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        ppInfo = _A_ 3 _U_ 22122 _N_ _S_ "LLU(S)" {_A_ 3 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo StrictnessInfo
 instance OptIdInfo StrictnessInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [StrictnessInfo, (IdInfo -> StrictnessInfo), (IdInfo -> StrictnessInfo -> IdInfo), (PprStyle -> (Id -> Id) -> StrictnessInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (StrictnessInfo), _CONSTM_ OptIdInfo getInfo (StrictnessInfo), _CONSTM_ OptIdInfo addInfo (StrictnessInfo), _CONSTM_ OptIdInfo ppInfo (StrictnessInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoStrictnessInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAASAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StrictnessInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-}
 instance OptIdInfo UpdateInfo
 instance OptIdInfo UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [UpdateInfo, (IdInfo -> UpdateInfo), (IdInfo -> UpdateInfo -> IdInfo), (PprStyle -> (Id -> Id) -> UpdateInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (UpdateInfo), _CONSTM_ OptIdInfo getInfo (UpdateInfo), _CONSTM_ OptIdInfo addInfo (UpdateInfo), _CONSTM_ OptIdInfo ppInfo (UpdateInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoUpdateInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAASAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UpdateInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord BasicLit
 instance Ord BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq BasicLit}}, (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> _CMP_TAG)] [_DFUN_ Eq (BasicLit), _CONSTM_ Ord (<) (BasicLit), _CONSTM_ Ord (<=) (BasicLit), _CONSTM_ Ord (>=) (BasicLit), _CONSTM_ Ord (>) (BasicLit), _CONSTM_ Ord max (BasicLit), _CONSTM_ Ord min (BasicLit), _CONSTM_ Ord _tagCmp (BasicLit)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Class
 instance Ord Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Class}}, (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Class), (Class -> Class -> Class), (Class -> Class -> _CMP_TAG)] [_DFUN_ Eq (Class), _CONSTM_ Ord (<) (Class), _CONSTM_ Ord (<=) (Class), _CONSTM_ Ord (>=) (Class), _CONSTM_ Ord (>) (Class), _CONSTM_ Ord max (Class), _CONSTM_ Ord min (Class), _CONSTM_ Ord _tagCmp (Class)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ ltInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ leInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord ClassOp
 instance Ord ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq ClassOp}}, (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> _CMP_TAG)] [_DFUN_ Eq (ClassOp), _CONSTM_ Ord (<) (ClassOp), _CONSTM_ Ord (<=) (ClassOp), _CONSTM_ Ord (>=) (ClassOp), _CONSTM_ Ord (>) (ClassOp), _CONSTM_ Ord max (ClassOp), _CONSTM_ Ord min (ClassOp), _CONSTM_ Ord _tagCmp (ClassOp)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ ltInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ leInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ geInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ geInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ gtInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ gtInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord Demand
 instance Ord Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Demand}}, (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Demand), (Demand -> Demand -> Demand), (Demand -> Demand -> _CMP_TAG)] [_DFUN_ Eq (Demand), _CONSTM_ Ord (<) (Demand), _CONSTM_ Ord (<=) (Demand), _CONSTM_ Ord (>=) (Demand), _CONSTM_ Ord (>) (Demand), _CONSTM_ Ord max (Demand), _CONSTM_ Ord min (Demand), _CONSTM_ Ord _tagCmp (Demand)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord UpdateInfo
 instance Ord UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq UpdateInfo}}, (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> UpdateInfo), (UpdateInfo -> UpdateInfo -> UpdateInfo), (UpdateInfo -> UpdateInfo -> _CMP_TAG)] [_DFUN_ Eq (UpdateInfo), _CONSTM_ Ord (<) (UpdateInfo), _CONSTM_ Ord (<=) (UpdateInfo), _CONSTM_ Ord (>=) (UpdateInfo), _CONSTM_ Ord (>) (UpdateInfo), _CONSTM_ Ord max (UpdateInfo), _CONSTM_ Ord min (UpdateInfo), _CONSTM_ Ord _tagCmp (UpdateInfo)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Name
 instance Ord Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Name}}, (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Name), (Name -> Name -> Name), (Name -> Name -> _CMP_TAG)] [_DFUN_ Eq (Name), _CONSTM_ Ord (<) (Name), _CONSTM_ Ord (<=) (Name), _CONSTM_ Ord (>=) (Name), _CONSTM_ Ord (>) (Name), _CONSTM_ Ord max (Name), _CONSTM_ Ord min (Name), _CONSTM_ Ord _tagCmp (Name)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord PrimKind
 instance Ord PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq PrimKind}}, (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> _CMP_TAG)] [_DFUN_ Eq (PrimKind), _CONSTM_ Ord (<) (PrimKind), _CONSTM_ Ord (<=) (PrimKind), _CONSTM_ Ord (>=) (PrimKind), _CONSTM_ Ord (>) (PrimKind), _CONSTM_ Ord max (PrimKind), _CONSTM_ Ord min (PrimKind), _CONSTM_ Ord _tagCmp (PrimKind)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Ord TyCon
 instance Ord TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVar
 instance Ord TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVar}}, (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> _CMP_TAG)] [_DFUN_ Eq (TyVar), _CONSTM_ Ord (<) (TyVar), _CONSTM_ Ord (<=) (TyVar), _CONSTM_ Ord (>=) (TyVar), _CONSTM_ Ord (>) (TyVar), _CONSTM_ Ord max (TyVar), _CONSTM_ Ord min (TyVar), _CONSTM_ Ord _tagCmp (TyVar)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Class
 instance NamedThing Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Class -> ExportFlag), (Class -> Bool), (Class -> (_PackedString, _PackedString)), (Class -> _PackedString), (Class -> [_PackedString]), (Class -> SrcLoc), (Class -> Unique), (Class -> Bool), (Class -> UniType), (Class -> Bool)] [_CONSTM_ NamedThing getExportFlag (Class), _CONSTM_ NamedThing isLocallyDefined (Class), _CONSTM_ NamedThing getOrigName (Class), _CONSTM_ NamedThing getOccurrenceName (Class), _CONSTM_ NamedThing getInformingModules (Class), _CONSTM_ NamedThing getSrcLoc (Class), _CONSTM_ NamedThing getTheUnique (Class), _CONSTM_ NamedThing hasType (Class), _CONSTM_ NamedThing getType (Class), _CONSTM_ NamedThing fromPreludeCore (Class)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(LLAAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [ub, uc]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(ALSAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAAAS)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ug; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Unique) } [ _NOREP_S_ "NamedThing.Class.getTheUnique", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Bool) } [ _NOREP_S_ "NamedThing.Class.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> UniType) } [ _NOREP_S_ "NamedThing.Class.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing a => NamedThing (InPat a)
 instance NamedThing a => NamedThing (InPat a)
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 0 _N_ _N_ _N_ _N_ #-}
 instance NamedThing TypecheckedPat
 instance NamedThing TypecheckedPat
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TypecheckedPat -> ExportFlag), (TypecheckedPat -> Bool), (TypecheckedPat -> (_PackedString, _PackedString)), (TypecheckedPat -> _PackedString), (TypecheckedPat -> [_PackedString]), (TypecheckedPat -> SrcLoc), (TypecheckedPat -> Unique), (TypecheckedPat -> Bool), (TypecheckedPat -> UniType), (TypecheckedPat -> Bool)] [_CONSTM_ NamedThing getExportFlag (TypecheckedPat), _CONSTM_ NamedThing isLocallyDefined (TypecheckedPat), _CONSTM_ NamedThing getOrigName (TypecheckedPat), _CONSTM_ NamedThing getOccurrenceName (TypecheckedPat), _CONSTM_ NamedThing getInformingModules (TypecheckedPat), _CONSTM_ NamedThing getSrcLoc (TypecheckedPat), _CONSTM_ NamedThing getTheUnique (TypecheckedPat), _CONSTM_ NamedThing hasType (TypecheckedPat), _ORIG_ HsPat typeOfPat, _CONSTM_ NamedThing fromPreludeCore (TypecheckedPat)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u0 ] _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u0 ] _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TypecheckedPat) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ HsPat typeOfPat _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Name
 instance NamedThing Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Name -> ExportFlag), (Name -> Bool), (Name -> (_PackedString, _PackedString)), (Name -> _PackedString), (Name -> [_PackedString]), (Name -> SrcLoc), (Name -> Unique), (Name -> Bool), (Name -> UniType), (Name -> Bool)] [_CONSTM_ NamedThing getExportFlag (Name), _CONSTM_ NamedThing isLocallyDefined (Name), _CONSTM_ NamedThing getOrigName (Name), _CONSTM_ NamedThing getOccurrenceName (Name), _CONSTM_ NamedThing getInformingModules (Name), _CONSTM_ NamedThing getSrcLoc (Name), _CONSTM_ NamedThing getTheUnique (Name), _CONSTM_ NamedThing hasType (Name), _CONSTM_ NamedThing getType (Name), _CONSTM_ NamedThing fromPreludeCore (Name)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Name" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Name) -> _!_ False [] [] _N_,
-        getType = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_  _TYAPP_  _ORIG_ Util panic { UniType } [ _NOREP_S_ "NamedThing.Name.getType" ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance NamedThing FullName
 instance NamedThing FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(FullName -> ExportFlag), (FullName -> Bool), (FullName -> (_PackedString, _PackedString)), (FullName -> _PackedString), (FullName -> [_PackedString]), (FullName -> SrcLoc), (FullName -> Unique), (FullName -> Bool), (FullName -> UniType), (FullName -> Bool)] [_CONSTM_ NamedThing getExportFlag (FullName), _CONSTM_ NamedThing isLocallyDefined (FullName), _CONSTM_ NamedThing getOrigName (FullName), _CONSTM_ NamedThing getOccurrenceName (FullName), _CONSTM_ NamedThing getInformingModules (FullName), _CONSTM_ NamedThing getSrcLoc (FullName), _CONSTM_ NamedThing getTheUnique (FullName), _CONSTM_ NamedThing hasType (FullName), _CONSTM_ NamedThing getType (FullName), _CONSTM_ NamedThing fromPreludeCore (FullName)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAEAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ThisModule  -> _!_ True [] []; _ORIG_ NameTypes InventedInThisModule  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LLAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [u1, u2]; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(ALSAAA)" {_A_ 2 _U_ 11 _N_ _N_ _F_ _IF_ARGS_ 0 2 XC 10 \ (u0 :: _PackedString) (u1 :: Provenance) -> case u1 of { _ALG_ _ORIG_ NameTypes OtherPrelude (u2 :: _PackedString) -> u2; _ORIG_ NameTypes OtherModule (u3 :: _PackedString) (u4 :: [_PackedString]) -> u3; (u5 :: Provenance) -> u0 } _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ExportedByPreludeCore  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 instance NamedThing ShortName
 instance NamedThing ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ShortName -> ExportFlag), (ShortName -> Bool), (ShortName -> (_PackedString, _PackedString)), (ShortName -> _PackedString), (ShortName -> [_PackedString]), (ShortName -> SrcLoc), (ShortName -> Unique), (ShortName -> Bool), (ShortName -> UniType), (ShortName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ShortName), _CONSTM_ NamedThing isLocallyDefined (ShortName), _CONSTM_ NamedThing getOrigName (ShortName), _CONSTM_ NamedThing getOccurrenceName (ShortName), _CONSTM_ NamedThing getInformingModules (ShortName), _CONSTM_ NamedThing getSrcLoc (ShortName), _CONSTM_ NamedThing getTheUnique (ShortName), _CONSTM_ NamedThing hasType (ShortName), _CONSTM_ NamedThing getType (ShortName), _CONSTM_ NamedThing fromPreludeCore (ShortName)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(SA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u1; _NO_DEFLT_ } _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u2; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AA)" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 instance NamedThing ProtoName
 instance NamedThing ProtoName
-       {-# GHC_PRAGMA _M_ ProtoName {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ProtoName -> ExportFlag), (ProtoName -> Bool), (ProtoName -> (_PackedString, _PackedString)), (ProtoName -> _PackedString), (ProtoName -> [_PackedString]), (ProtoName -> SrcLoc), (ProtoName -> Unique), (ProtoName -> Bool), (ProtoName -> UniType), (ProtoName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ProtoName), _CONSTM_ NamedThing isLocallyDefined (ProtoName), _CONSTM_ NamedThing getOrigName (ProtoName), _CONSTM_ NamedThing getOccurrenceName (ProtoName), _CONSTM_ NamedThing getInformingModules (ProtoName), _CONSTM_ NamedThing getSrcLoc (ProtoName), _CONSTM_ NamedThing getTheUnique (ProtoName), _CONSTM_ NamedThing hasType (ProtoName), _CONSTM_ NamedThing getType (ProtoName), _CONSTM_ NamedThing fromPreludeCore (ProtoName)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: ProtoName) -> case u0 of { _ALG_ _ORIG_ ProtoName Unk (u1 :: _PackedString) -> u1; _ORIG_ ProtoName Imp (u2 :: _PackedString) (u3 :: _PackedString) (u4 :: [_PackedString]) (u5 :: _PackedString) -> u5; _ORIG_ ProtoName Prel (u6 :: Name) -> _APP_  _CONSTM_ NamedThing getOccurrenceName (Name) [ u6 ]; _NO_DEFLT_ } _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ProtoName) -> _!_ False [] [] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-}
 instance NamedThing TyCon
 instance NamedThing TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance NamedThing TyVar
 instance NamedThing TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVar -> ExportFlag), (TyVar -> Bool), (TyVar -> (_PackedString, _PackedString)), (TyVar -> _PackedString), (TyVar -> [_PackedString]), (TyVar -> SrcLoc), (TyVar -> Unique), (TyVar -> Bool), (TyVar -> UniType), (TyVar -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVar), _CONSTM_ NamedThing isLocallyDefined (TyVar), _CONSTM_ NamedThing getOrigName (TyVar), _CONSTM_ NamedThing getOccurrenceName (TyVar), _CONSTM_ NamedThing getInformingModules (TyVar), _CONSTM_ NamedThing getSrcLoc (TyVar), _CONSTM_ NamedThing getTheUnique (TyVar), _CONSTM_ NamedThing hasType (TyVar), _CONSTM_ NamedThing getType (TyVar), _CONSTM_ NamedThing fromPreludeCore (TyVar)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVar" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar UserTyVar (u1 :: Unique) (u2 :: ShortName) -> case u2 of { _ALG_ _ORIG_ NameTypes ShortName (u3 :: _PackedString) (u4 :: SrcLoc) -> u4; _NO_DEFLT_ }; (u5 :: TyVar) -> _ORIG_ SrcLoc mkUnknownSrcLoc } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar PolySysTyVar (u1 :: Unique) -> u1; _ORIG_ TyVar PrimSysTyVar (u2 :: Unique) -> u2; _ORIG_ TyVar OpenSysTyVar (u3 :: Unique) -> u3; _ORIG_ TyVar UserTyVar (u4 :: Unique) (u5 :: ShortName) -> u4; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ False [] [] _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (a, b)
 instance (Outputable a, Outputable b) => Outputable (a, b)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Module a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Module a b)
-       {-# GHC_PRAGMA _M_ AbsSyn {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable BasicLit
 instance Outputable BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BasicLit) _N_
-        ppr = _A_ 0 _U_ 2122 _N_ _N_ _N_ _N_ #-}
 instance Outputable Bool
 instance Outputable Bool
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Class
 instance Outputable Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Class) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(AU(LLLLAA)AAAAAAAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ClassOp
 instance Outputable ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable a => Outputable (FiniteMap a b)
 instance Outputable a => Outputable (FiniteMap a b)
-       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Bind a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Bind a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (MonoBinds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (MonoBinds a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (Sig a)
 instance Outputable a => Outputable (Sig a)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (UnfoldingCoreAtom a)
 instance Outputable a => Outputable (UnfoldingCoreAtom a)
-       {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (UnfoldingCoreExpr a)
 instance Outputable a => Outputable (UnfoldingCoreExpr a)
-       {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (UnfoldingPrimOp a)
 instance Outputable a => Outputable (UnfoldingPrimOp a)
-       {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ClassDecl a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ClassDecl a b)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (ConDecl a)
 instance (NamedThing a, Outputable a) => Outputable (ConDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (DataTypeSig a)
 instance (NamedThing a, Outputable a) => Outputable (DataTypeSig a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (DefaultDecl a)
 instance (NamedThing a, Outputable a) => Outputable (DefaultDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (FixityDecl a)
 instance (NamedThing a, Outputable a) => Outputable (FixityDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (InstDecl a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (InstDecl a b)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (SpecialisedInstanceSig a)
 instance (NamedThing a, Outputable a) => Outputable (SpecialisedInstanceSig a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (TyDecl a)
 instance (NamedThing a, Outputable a) => Outputable (TyDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ArithSeqInfo a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ArithSeqInfo a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Qual a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Qual a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable IE
 instance Outputable IE
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IE) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable IfaceImportDecl
 instance Outputable IfaceImportDecl
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IfaceImportDecl) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LU(LLLA)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ImportedInterface a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ImportedInterface a b)
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Interface a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Interface a b)
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable Renaming
 instance Outputable Renaming
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Renaming) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AU(LL)" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Literal
 instance Outputable Literal
-       {-# GHC_PRAGMA _M_ HsLit {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Literal) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHS u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: GRHSs", u8, u9 ] _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHSsAndBinds u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr:GRHSsAndBinds", u8, u9 ] _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Match a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Match a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: Match u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: Match", u8, u9 ] _N_ #-}
 instance Outputable a => Outputable (InPat a)
 instance Outputable a => Outputable (InPat a)
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable TypecheckedPat
 instance Outputable TypecheckedPat
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (ClassOpPragmas a)
 instance Outputable a => Outputable (ClassOpPragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (ClassPragmas a)
 instance Outputable a => Outputable (ClassPragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (GenPragmas a)
 instance Outputable a => Outputable (GenPragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (InstancePragmas a)
 instance Outputable a => Outputable (InstancePragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (MonoType a)
 instance Outputable a => Outputable (MonoType a)
-       {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (PolyType a)
 instance Outputable a => Outputable (PolyType a)
-       {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable Demand
 instance Outputable Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Demand) _N_
-        ppr = _A_ 2 _U_ 0220 _N_ _S_ "AL" {_A_ 1 _U_ 220 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Inst
 instance Outputable Inst
-       {-# GHC_PRAGMA _M_ Inst {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Inst) _N_
-        ppr = _A_ 2 _U_ 1222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable Name
 instance Outputable Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Name) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 instance Outputable FullName
 instance Outputable FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FullName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LLLLAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ShortName
 instance Outputable ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ShortName) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AU(LA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable PrimKind
 instance Outputable PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (PrimKind) _N_
-        ppr = _A_ 2 _U_ 0120 _N_ _S_ "AL" {_A_ 1 _U_ 120 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable PrimOp
 instance Outputable PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-}
 instance Outputable ProtoName
 instance Outputable ProtoName
-       {-# GHC_PRAGMA _M_ ProtoName {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ProtoName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 instance Outputable SrcLoc
 instance Outputable SrcLoc
-       {-# GHC_PRAGMA _M_ SrcLoc {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (SrcLoc) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyCon
 instance Outputable TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVar
 instance Outputable TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVar) _N_
-        ppr = _A_ 2 _U_ 1122 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable a => Outputable [a]
 instance Outputable a => Outputable [a]
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Text Demand
 instance Text Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Demand, [Char])]), (Int -> Demand -> [Char] -> [Char]), ([Char] -> [([Demand], [Char])]), ([Demand] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Demand), _CONSTM_ Text showsPrec (Demand), _CONSTM_ Text readList (Demand), _CONSTM_ Text showList (Demand)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(Demand, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Demand) (u2 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> Demand -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_,
-        readList = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        showList = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instance Text UpdateInfo
 instance Text UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(UpdateInfo, [Char])]), (Int -> UpdateInfo -> [Char] -> [Char]), ([Char] -> [([UpdateInfo], [Char])]), ([UpdateInfo] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (UpdateInfo), _CONSTM_ Text showsPrec (UpdateInfo), _CONSTM_ Text readList (UpdateInfo), _CONSTM_ Text showList (UpdateInfo)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AS" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: UpdateInfo) (u2 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> UpdateInfo -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index b34015c..6f2cf46 100644 (file)
@@ -17,35 +17,19 @@ import TyVar(TyVar)
 import UniType(UniType)
 type PreludeNameFun = _PackedString -> Labda Name
 cmpInstanceTypes :: MonoType ProtoName -> MonoType ProtoName -> Int#
 import UniType(UniType)
 type PreludeNameFun = _PackedString -> Labda Name
 cmpInstanceTypes :: MonoType ProtoName -> MonoType ProtoName -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 collectBinders :: Bind a (InPat a) -> [a]
 collectBinders :: Bind a (InPat a) -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectMonoBinders :: MonoBinds a (InPat a) -> [a]
 collectMonoBinders :: MonoBinds a (InPat a) -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectMonoBindersAndLocs :: MonoBinds a (InPat a) -> [(a, SrcLoc)]
 collectMonoBindersAndLocs :: MonoBinds a (InPat a) -> [(a, SrcLoc)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectPatBinders :: InPat a -> [a]
 collectPatBinders :: InPat a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectQualBinders :: [Qual Name (InPat Name)] -> [Name]
 collectQualBinders :: [Qual Name (InPat Name)] -> [Name]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectTopLevelBinders :: Binds a (InPat a) -> [a]
 collectTopLevelBinders :: Binds a (InPat a) -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectTypedBinders :: Bind Id TypecheckedPat -> [Id]
 collectTypedBinders :: Bind Id TypecheckedPat -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 collectTypedPatBinders :: TypecheckedPat -> [Id]
 collectTypedPatBinders :: TypecheckedPat -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractMonoTyNames :: (a -> a -> Bool) -> MonoType a -> [a]
 extractMonoTyNames :: (a -> a -> Bool) -> MonoType a -> [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 getMentionedVars :: (_PackedString -> Labda Name) -> [IE] -> [FixityDecl ProtoName] -> [ClassDecl ProtoName (InPat ProtoName)] -> [InstDecl ProtoName (InPat ProtoName)] -> Binds ProtoName (InPat ProtoName) -> (Bool, [_PackedString])
 getMentionedVars :: (_PackedString -> Labda Name) -> [IE] -> [FixityDecl ProtoName] -> [ClassDecl ProtoName (InPat ProtoName)] -> [InstDecl ProtoName (InPat ProtoName)] -> Binds ProtoName (InPat ProtoName) -> (Bool, [_PackedString])
-       {-# GHC_PRAGMA _A_ 6 _U_ 210111 _N_ _S_ "LSALLL" {_A_ 5 _U_ 21111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getNonPrelOuterTyCon :: MonoType ProtoName -> Labda ProtoName
 getNonPrelOuterTyCon :: MonoType ProtoName -> Labda ProtoName
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: MonoType ProtoName) -> case u0 of { _ALG_ _ORIG_ HsTypes MonoTyCon (u1 :: ProtoName) (u2 :: [MonoType ProtoName]) -> _!_ _ORIG_ Maybes Ni [ProtoName] [u1]; (u3 :: MonoType ProtoName) -> _!_ _ORIG_ Maybes Hamna [ProtoName] [] } _N_ #-}
 mkDictApp :: Expr Id TypecheckedPat -> [Id] -> Expr Id TypecheckedPat
 mkDictApp :: Expr Id TypecheckedPat -> [Id] -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [Id]) -> case u1 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictApp [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u0; _NO_DEFLT_ } _N_ #-}
 mkDictLam :: [Id] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
 mkDictLam :: [Id] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [Id]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictLam [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkTyApp :: Expr Id TypecheckedPat -> [UniType] -> Expr Id TypecheckedPat
 mkTyApp :: Expr Id TypecheckedPat -> [UniType] -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [UniType]) -> case u1 of { _ALG_ (:) (u2 :: UniType) (u3 :: [UniType]) -> _!_ _ORIG_ HsExpr TyApp [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u0; _NO_DEFLT_ } _N_ #-}
 mkTyLam :: [TyVar] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
 mkTyLam :: [TyVar] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [TyVar]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: TyVar) (u3 :: [TyVar]) -> _!_ _ORIG_ HsExpr TyLam [Id, TypecheckedPat] [u0, u1]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 
 
index 29ce3af..f161e8c 100644 (file)
@@ -33,19 +33,11 @@ type TypecheckedBind = Bind Id TypecheckedPat
 type TypecheckedBinds = Binds Id TypecheckedPat
 type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat
 bindIsRecursive :: Bind Id TypecheckedPat -> Bool
 type TypecheckedBinds = Binds Id TypecheckedPat
 type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat
 bindIsRecursive :: Bind Id TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: Bind Id TypecheckedPat) -> case u0 of { _ALG_ _ORIG_ HsBinds EmptyBind  -> _!_ False [] []; _ORIG_ HsBinds NonRecBind (u1 :: MonoBinds Id TypecheckedPat) -> _!_ False [] []; _ORIG_ HsBinds RecBind (u2 :: MonoBinds Id TypecheckedPat) -> _!_ True [] []; _NO_DEFLT_ } _N_ #-}
 nullBind :: Bind a b -> Bool
 nullBind :: Bind a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 nullBinds :: Binds a b -> Bool
 nullBinds :: Binds a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 nullMonoBinds :: MonoBinds a b -> Bool
 nullMonoBinds :: MonoBinds a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Bind a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Bind a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (MonoBinds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (MonoBinds a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (Sig a)
 instance Outputable a => Outputable (Sig a)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index cd79024..327c11e 100644 (file)
@@ -17,11 +17,7 @@ data UnfoldingCoreExpr a   = UfCoVar (UfId a) | UfCoLit BasicLit | UfCoCon a [Po
 data UnfoldingPrimOp a   = UfCCallOp _PackedString Bool Bool [PolyType a] (PolyType a) | UfOtherOp PrimOp
 type UnfoldingType a = PolyType a
 eqUfExpr :: UnfoldingCoreExpr ProtoName -> UnfoldingCoreExpr ProtoName -> Bool
 data UnfoldingPrimOp a   = UfCCallOp _PackedString Bool Bool [PolyType a] (PolyType a) | UfOtherOp PrimOp
 type UnfoldingType a = PolyType a
 eqUfExpr :: UnfoldingCoreExpr ProtoName -> UnfoldingCoreExpr ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable a => Outputable (UnfoldingCoreAtom a)
 instance Outputable a => Outputable (UnfoldingCoreAtom a)
-       {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (UnfoldingCoreExpr a)
 instance Outputable a => Outputable (UnfoldingCoreExpr a)
-       {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (UnfoldingPrimOp a)
 instance Outputable a => Outputable (UnfoldingPrimOp a)
-       {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 76524b7..9b3fe5a 100644 (file)
@@ -34,21 +34,12 @@ type RenamedTyDecl = TyDecl Name
 data SpecialisedInstanceSig a   = InstSpecSig a (MonoType a) SrcLoc
 data TyDecl a   = TyData [(a, a)] a [a] [ConDecl a] [a] (DataPragmas a) SrcLoc | TySynonym a [a] (MonoType a) TypePragmas SrcLoc
 eqConDecls :: [ConDecl ProtoName] -> [ConDecl ProtoName] -> Bool
 data SpecialisedInstanceSig a   = InstSpecSig a (MonoType a) SrcLoc
 data TyDecl a   = TyData [(a, a)] a [a] [ConDecl a] [a] (DataPragmas a) SrcLoc | TySynonym a [a] (MonoType a) TypePragmas SrcLoc
 eqConDecls :: [ConDecl ProtoName] -> [ConDecl ProtoName] -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ClassDecl a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ClassDecl a b)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (ConDecl a)
 instance (NamedThing a, Outputable a) => Outputable (ConDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (DataTypeSig a)
 instance (NamedThing a, Outputable a) => Outputable (DataTypeSig a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (DefaultDecl a)
 instance (NamedThing a, Outputable a) => Outputable (DefaultDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (FixityDecl a)
 instance (NamedThing a, Outputable a) => Outputable (FixityDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (InstDecl a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (InstDecl a b)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (SpecialisedInstanceSig a)
 instance (NamedThing a, Outputable a) => Outputable (SpecialisedInstanceSig a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a) => Outputable (TyDecl a)
 instance (NamedThing a, Outputable a) => Outputable (TyDecl a)
-       {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 8f21886..97cc395 100644 (file)
@@ -26,13 +26,8 @@ type TypecheckedArithSeqInfo = ArithSeqInfo Id TypecheckedPat
 type TypecheckedExpr = Expr Id TypecheckedPat
 type TypecheckedQual = Qual Id TypecheckedPat
 pprExpr :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Expr a b -> Int -> Bool -> PrettyRep
 type TypecheckedExpr = Expr Id TypecheckedPat
 type TypecheckedQual = Qual Id TypecheckedPat
 pprExpr :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Expr a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 22222222 _N_ _N_ _N_ _N_ #-}
 pprParendExpr :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Expr a b -> Int -> Bool -> PrettyRep
 pprParendExpr :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Expr a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 22222222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ArithSeqInfo a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ArithSeqInfo a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Qual a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Qual a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 
 
index df2f2e6..c71e78e 100644 (file)
@@ -21,22 +21,11 @@ type RenamedImportedInterface = ImportedInterface Name (InPat Name)
 type RenamedInterface = Interface Name (InPat Name)
 data Renaming   = MkRenaming _PackedString _PackedString
 getIEStrings :: [IE] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())
 type RenamedInterface = Interface Name (InPat Name)
 data Renaming   = MkRenaming _PackedString _PackedString
 getIEStrings :: [IE] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getRawIEStrings :: [IE] -> ([(_PackedString, ExportFlag)], [_PackedString])
 getRawIEStrings :: [IE] -> ([(_PackedString, ExportFlag)], [_PackedString])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 pprRenamings :: PprStyle -> [Renaming] -> Int -> Bool -> PrettyRep
 pprRenamings :: PprStyle -> [Renaming] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 instance Outputable IE
 instance Outputable IE
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IE) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable IfaceImportDecl
 instance Outputable IfaceImportDecl
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IfaceImportDecl) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LU(LLLA)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ImportedInterface a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ImportedInterface a b)
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Interface a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Interface a b)
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable Renaming
 instance Outputable Renaming
-       {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Renaming) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AU(LL)" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index c19a0d3..624fd8a 100644 (file)
@@ -6,8 +6,5 @@ import PreludeRatio(Ratio(..))
 import UniType(UniType)
 data Literal   = CharLit Char | CharPrimLit Char | StringLit _PackedString | StringPrimLit _PackedString | IntLit Integer | FracLit (Ratio Integer) | LitLitLitIn _PackedString | LitLitLit _PackedString UniType | IntPrimLit Integer | FloatPrimLit (Ratio Integer) | DoublePrimLit (Ratio Integer)
 negLiteral :: Literal -> Literal
 import UniType(UniType)
 data Literal   = CharLit Char | CharPrimLit Char | StringLit _PackedString | StringPrimLit _PackedString | IntLit Integer | FracLit (Ratio Integer) | LitLitLitIn _PackedString | LitLitLit _PackedString UniType | IntPrimLit Integer | FloatPrimLit (Ratio Integer) | DoublePrimLit (Ratio Integer)
 negLiteral :: Literal -> Literal
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance Outputable Literal
 instance Outputable Literal
-       {-# GHC_PRAGMA _M_ HsLit {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Literal) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index bec156c..23f5f1c 100644 (file)
@@ -23,17 +23,10 @@ type TypecheckedGRHS = GRHS Id TypecheckedPat
 type TypecheckedGRHSsAndBinds = GRHSsAndBinds Id TypecheckedPat
 type TypecheckedMatch = Match Id TypecheckedPat
 pprGRHS :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> GRHS a b -> Int -> Bool -> PrettyRep
 type TypecheckedGRHSsAndBinds = GRHSsAndBinds Id TypecheckedPat
 type TypecheckedMatch = Match Id TypecheckedPat
 pprGRHS :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> GRHS a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222221122 _N_ _N_ _N_ _N_ #-}
 pprGRHSsAndBinds :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> GRHSsAndBinds a b -> Int -> Bool -> PrettyRep
 pprGRHSsAndBinds :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> GRHSsAndBinds a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222122 _N_ _N_ _N_ _N_ #-}
 pprMatch :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> Match a b -> Int -> Bool -> PrettyRep
 pprMatch :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> Match a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 7 _U_ 222222122 _N_ _S_ "LLLLLLS" _N_ _N_ #-}
 pprMatches :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> (Bool, Int -> Bool -> PrettyRep) -> [Match a b] -> Int -> Bool -> PrettyRep
 pprMatches :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> (Bool, Int -> Bool -> PrettyRep) -> [Match a b] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222221222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHS u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: GRHSs", u8, u9 ] _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHSsAndBinds u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr:GRHSsAndBinds", u8, u9 ] _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Match a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Match a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: Match u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: Match", u8, u9 ] _N_ #-}
 
 
index 94da9f2..ce80504 100644 (file)
@@ -13,46 +13,19 @@ type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
 data TypecheckedPat   = WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat)
 irrefutablePat :: TypecheckedPat -> Bool
 type RenamedPat = InPat Name
 data TypecheckedPat   = WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat)
 irrefutablePat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isConPat :: TypecheckedPat -> Bool
 isConPat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isLitPat :: TypecheckedPat -> Bool
 isLitPat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 only_con :: Id -> Bool
 only_con :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 patsAreAllCons :: [TypecheckedPat] -> Bool
 patsAreAllCons :: [TypecheckedPat] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 patsAreAllLits :: [TypecheckedPat] -> Bool
 patsAreAllLits :: [TypecheckedPat] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 pprConPatTy :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
 pprConPatTy :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 pprInPat :: Outputable a => PprStyle -> InPat a -> Int -> Bool -> PrettyRep
 pprInPat :: Outputable a => PprStyle -> InPat a -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 22122 _N_ _N_ _N_ _N_ #-}
 pprTypecheckedPat :: PprStyle -> TypecheckedPat -> Int -> Bool -> PrettyRep
 pprTypecheckedPat :: PprStyle -> TypecheckedPat -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 typeOfPat :: TypecheckedPat -> UniType
 typeOfPat :: TypecheckedPat -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unfailablePat :: TypecheckedPat -> Bool
 unfailablePat :: TypecheckedPat -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unfailablePats :: [TypecheckedPat] -> Bool
 unfailablePats :: [TypecheckedPat] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance NamedThing a => NamedThing (InPat a)
 instance NamedThing a => NamedThing (InPat a)
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 0 _N_ _N_ _N_ _N_ #-}
 instance NamedThing TypecheckedPat
 instance NamedThing TypecheckedPat
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TypecheckedPat -> ExportFlag), (TypecheckedPat -> Bool), (TypecheckedPat -> (_PackedString, _PackedString)), (TypecheckedPat -> _PackedString), (TypecheckedPat -> [_PackedString]), (TypecheckedPat -> SrcLoc), (TypecheckedPat -> Unique), (TypecheckedPat -> Bool), (TypecheckedPat -> UniType), (TypecheckedPat -> Bool)] [_CONSTM_ NamedThing getExportFlag (TypecheckedPat), _CONSTM_ NamedThing isLocallyDefined (TypecheckedPat), _CONSTM_ NamedThing getOrigName (TypecheckedPat), _CONSTM_ NamedThing getOccurrenceName (TypecheckedPat), _CONSTM_ NamedThing getInformingModules (TypecheckedPat), _CONSTM_ NamedThing getSrcLoc (TypecheckedPat), _CONSTM_ NamedThing getTheUnique (TypecheckedPat), _CONSTM_ NamedThing hasType (TypecheckedPat), _ORIG_ HsPat typeOfPat, _CONSTM_ NamedThing fromPreludeCore (TypecheckedPat)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u0 ] _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u0 ] _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TypecheckedPat) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ HsPat typeOfPat _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_  _TYAPP_  patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-}
 instance Outputable a => Outputable (InPat a)
 instance Outputable a => Outputable (InPat a)
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable TypecheckedPat
 instance Outputable TypecheckedPat
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 
 
index 12bd519..77661fd 100644 (file)
@@ -31,11 +31,7 @@ type RenamedImpStrictness = ImpStrictness Name
 type RenamedInstancePragmas = InstancePragmas Name
 data TypePragmas   = NoTypePragmas | AbstractTySynonym
 instance Outputable a => Outputable (ClassOpPragmas a)
 type RenamedInstancePragmas = InstancePragmas Name
 data TypePragmas   = NoTypePragmas | AbstractTySynonym
 instance Outputable a => Outputable (ClassOpPragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (ClassPragmas a)
 instance Outputable a => Outputable (ClassPragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (GenPragmas a)
 instance Outputable a => Outputable (GenPragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (InstancePragmas a)
 instance Outputable a => Outputable (InstancePragmas a)
-       {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 51cad26..115d9a1 100644 (file)
@@ -15,19 +15,11 @@ type RenamedContext = [(Name, Name)]
 type RenamedMonoType = MonoType Name
 type RenamedPolyType = PolyType Name
 cmpList :: (a -> a -> Int#) -> [a] -> [a] -> Int#
 type RenamedMonoType = MonoType Name
 type RenamedPolyType = PolyType Name
 cmpList :: (a -> a -> Int#) -> [a] -> [a] -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LSS" _N_ _N_ #-}
 cmpMonoType :: (a -> a -> Int#) -> MonoType a -> MonoType a -> Int#
 cmpMonoType :: (a -> a -> Int#) -> MonoType a -> MonoType a -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 cmpPolyType :: (a -> a -> Int#) -> PolyType a -> PolyType a -> Int#
 cmpPolyType :: (a -> a -> Int#) -> PolyType a -> PolyType a -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 eqMonoType :: MonoType ProtoName -> MonoType ProtoName -> Bool
 eqMonoType :: MonoType ProtoName -> MonoType ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 pprContext :: Outputable a => PprStyle -> [(a, a)] -> Int -> Bool -> PrettyRep
 pprContext :: Outputable a => PprStyle -> [(a, a)] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-}
 pprParendMonoType :: Outputable a => PprStyle -> MonoType a -> Int -> Bool -> PrettyRep
 pprParendMonoType :: Outputable a => PprStyle -> MonoType a -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 22122 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (MonoType a)
 instance Outputable a => Outputable (MonoType a)
-       {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (PolyType a)
 instance Outputable a => Outputable (PolyType a)
-       {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index f292571..9e65c2c 100644 (file)
@@ -1,66 +1,27 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Name where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Name where
-import Class(Class)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Maybes(Labda)
-import NameTypes(FullName, Provenance, ShortName)
-import Outputable(ExportFlag, NamedThing, Outputable)
+import Id(Id)
+import NameTypes(FullName, ShortName)
+import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PreludePS(_PackedString)
-import PrimKind(PrimKind)
-import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
 import Unique(Unique)
 import Unique(Unique)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
+data Id 
+data FullName 
 data Name   = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString
 data Name   = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data ShortName 
+data TyCon 
+data Unique 
 cmpName :: Name -> Name -> Int#
 cmpName :: Name -> Name -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 eqName :: Name -> Name -> Bool
 eqName :: Name -> Name -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_  _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
 getTagFromClassOpName :: Name -> Int
 getTagFromClassOpName :: Name -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 invisibleName :: Name -> Bool
 invisibleName :: Name -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isClassName :: Name -> Bool
 isClassName :: Name -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 14 \ (u0 :: Name) -> case u0 of { _ALG_ _ORIG_ Name PreludeClass (u1 :: Unique) (u2 :: FullName) -> _!_ True [] []; _ORIG_ Name OtherClass (u3 :: Unique) (u4 :: FullName) (u5 :: [Name]) -> _!_ True [] []; (u6 :: Name) -> _!_ False [] [] } _N_ #-}
 isClassOpName :: Name -> Name -> Bool
 isClassOpName :: Name -> Name -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 isTyConName :: Name -> Bool
 isTyConName :: Name -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 15 \ (u0 :: Name) -> case u0 of { _ALG_ _ORIG_ Name WiredInTyCon (u1 :: TyCon) -> _!_ True [] []; _ORIG_ Name PreludeTyCon (u2 :: Unique) (u3 :: FullName) (u4 :: Int) (u5 :: Bool) -> _!_ True [] []; _ORIG_ Name OtherTyCon (u6 :: Unique) (u7 :: FullName) (u8 :: Int) (u9 :: Bool) (ua :: [Name]) -> _!_ True [] []; (ub :: Name) -> _!_ False [] [] } _N_ #-}
 isUnboundName :: Name -> Bool
 isUnboundName :: Name -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 13 \ (u0 :: Name) -> case u0 of { _ALG_ _ORIG_ Name Unbound (u1 :: _PackedString) -> _!_ True [] []; (u2 :: Name) -> _!_ False [] [] } _N_ #-}
 instance Eq Name
 instance Eq Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Name -> Name -> Bool), (Name -> Name -> Bool)] [_CONSTM_ Eq (==) (Name), _CONSTM_ Eq (/=) (Name)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_  _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_  _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Ord Name
 instance Ord Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Name}}, (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Name), (Name -> Name -> Name), (Name -> Name -> _CMP_TAG)] [_DFUN_ Eq (Name), _CONSTM_ Ord (<) (Name), _CONSTM_ Ord (<=) (Name), _CONSTM_ Ord (>=) (Name), _CONSTM_ Ord (>) (Name), _CONSTM_ Ord max (Name), _CONSTM_ Ord min (Name), _CONSTM_ Ord _tagCmp (Name)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance NamedThing Name
 instance NamedThing Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Name -> ExportFlag), (Name -> Bool), (Name -> (_PackedString, _PackedString)), (Name -> _PackedString), (Name -> [_PackedString]), (Name -> SrcLoc), (Name -> Unique), (Name -> Bool), (Name -> UniType), (Name -> Bool)] [_CONSTM_ NamedThing getExportFlag (Name), _CONSTM_ NamedThing isLocallyDefined (Name), _CONSTM_ NamedThing getOrigName (Name), _CONSTM_ NamedThing getOccurrenceName (Name), _CONSTM_ NamedThing getInformingModules (Name), _CONSTM_ NamedThing getSrcLoc (Name), _CONSTM_ NamedThing getTheUnique (Name), _CONSTM_ NamedThing hasType (Name), _CONSTM_ NamedThing getType (Name), _CONSTM_ NamedThing fromPreludeCore (Name)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Name" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Name) -> _!_ False [] [] _N_,
-        getType = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_  _TYAPP_  _ORIG_ Util panic { UniType } [ _NOREP_S_ "NamedThing.Name.getType" ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance Outputable Name
 instance Outputable Name
-       {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Name) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index b8be5aa..e4c717a 100644 (file)
@@ -302,16 +302,20 @@ instance Outputable Name where
     ppr sty (OtherTopId u n)      = ppr sty n
 
     ppr sty (ClassOpName u c s i)
     ppr sty (OtherTopId u n)      = ppr sty n
 
     ppr sty (ClassOpName u c s i)
-       = case sty of
-               PprForUser     -> ppPStr s
-               PprInterface _ -> ppPStr s
-               other          -> ppBesides [ppPStr s, ppChar '{',
-                                        ppSep [pprUnique u,
-                                               ppStr "op", ppInt i,
-                                               ppStr "cls", ppr sty c],
-                                        ppChar '}']
-
-    ppr sty (Unbound s)                = ppStr ("*UNBOUND*"++ _UNPK_ s)
+      = let
+           ps = ppPStr s
+       in
+       case sty of
+         PprForUser     -> ps
+         PprInterface _ -> ps
+         PprDebug       -> ps
+         other          -> ppBesides [ps, ppChar '{',
+                                      ppSep [pprUnique u,
+                                             ppStr "op", ppInt i,
+                                             ppStr "cls", ppr sty c],
+                                      ppChar '}']
+
+    ppr sty (Unbound s) = ppStr ("*UNBOUND*"++ _UNPK_ s)
 
 pp_debug uniq thing
   = ppBesides [ppr PprDebug thing, ppStr "{-", pprUnique uniq, ppStr "-}" ]
 
 pp_debug uniq thing
   = ppBesides [ppr PprDebug thing, ppStr "{-", pprUnique uniq, ppStr "-}" ]
index 4b9fdbb..4152591 100644 (file)
@@ -1,45 +1,22 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface BasicLit where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface BasicLit where
-import Class(Class)
 import Outputable(Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import Outputable(Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(PprStyle)
 import PrimKind(PrimKind)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 data BasicLit   = MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer)
 import UniType(UniType)
 data BasicLit   = MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer)
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data PrimKind 
+data UniType 
 isLitLitLit :: BasicLit -> Bool
 isLitLitLit :: BasicLit -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 12 \ (u0 :: BasicLit) -> case u0 of { _ALG_ _ORIG_ BasicLit MachLitLit (u1 :: _PackedString) (u2 :: PrimKind) -> _!_ True [] []; (u3 :: BasicLit) -> _!_ False [] [] } _N_ #-}
 isNoRepLit :: BasicLit -> Bool
 isNoRepLit :: BasicLit -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 14 \ (u0 :: BasicLit) -> case u0 of { _ALG_ _ORIG_ BasicLit NoRepStr (u1 :: _PackedString) -> _!_ True [] []; _ORIG_ BasicLit NoRepInteger (u2 :: Integer) -> _!_ True [] []; _ORIG_ BasicLit NoRepRational (u3 :: Ratio Integer) -> _!_ True [] []; (u4 :: BasicLit) -> _!_ False [] [] } _N_ #-}
 kindOfBasicLit :: BasicLit -> PrimKind
 kindOfBasicLit :: BasicLit -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkMachInt :: Integer -> BasicLit
 mkMachInt :: Integer -> BasicLit
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkMachWord :: Integer -> BasicLit
 mkMachWord :: Integer -> BasicLit
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 showBasicLit :: PprStyle -> BasicLit -> [Char]
 showBasicLit :: PprStyle -> BasicLit -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 typeOfBasicLit :: BasicLit -> UniType
 typeOfBasicLit :: BasicLit -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance Eq BasicLit
 instance Eq BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool)] [_CONSTM_ Eq (==) (BasicLit), _CONSTM_ Eq (/=) (BasicLit)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord BasicLit
 instance Ord BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq BasicLit}}, (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> _CMP_TAG)] [_DFUN_ Eq (BasicLit), _CONSTM_ Ord (<) (BasicLit), _CONSTM_ Ord (<=) (BasicLit), _CONSTM_ Ord (>=) (BasicLit), _CONSTM_ Ord (>) (BasicLit), _CONSTM_ Ord max (BasicLit), _CONSTM_ Ord min (BasicLit), _CONSTM_ Ord _tagCmp (BasicLit)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable BasicLit
 instance Outputable BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BasicLit) _N_
-        ppr = _A_ 0 _U_ 2122 _N_ _N_ _N_ _N_ #-}
 
 
index 748ab69..0a37bc4 100644 (file)
@@ -1,99 +1,48 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CLabelInfo where
 import CharSeq(CSeq)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CLabelInfo where
 import CharSeq(CSeq)
-import Class(Class)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Maybes(Labda)
-import NameTypes(FullName)
+import Id(Id)
 import PreludePS(_PackedString)
 import Pretty(PprStyle, PrettyRep)
 import PreludePS(_PackedString)
 import Pretty(PprStyle, PrettyRep)
-import PrimKind(PrimKind)
 import TyCon(TyCon)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
 import Unique(Unique)
 data CLabel 
 import Unique(Unique)
 data CLabel 
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Id 
+data TyCon 
+data Unique 
 cSEP :: _PackedString
 cSEP :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charToC :: Char -> [Char]
 charToC :: Char -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 charToEasyHaskell :: Char -> [Char]
 charToEasyHaskell :: Char -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 externallyVisibleCLabel :: CLabel -> Bool
 externallyVisibleCLabel :: CLabel -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 identToC :: _PackedString -> Int -> Bool -> PrettyRep
 identToC :: _PackedString -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 isAsmTemp :: CLabel -> Bool
 isAsmTemp :: CLabel -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isReadOnly :: CLabel -> Bool
 isReadOnly :: CLabel -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkAltLabel :: Unique -> Int -> CLabel
 mkAltLabel :: Unique -> Int -> CLabel
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkAsmTempLabel :: Unique -> CLabel
 mkAsmTempLabel :: Unique -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkBlackHoleInfoTableLabel :: CLabel
 mkBlackHoleInfoTableLabel :: CLabel
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkClosureLabel :: Id -> CLabel
 mkClosureLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkConEntryLabel :: Id -> CLabel
 mkConEntryLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkConUpdCodePtrVecLabel :: TyCon -> Int -> CLabel
 mkConUpdCodePtrVecLabel :: TyCon -> Int -> CLabel
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkDefaultLabel :: Unique -> CLabel
 mkDefaultLabel :: Unique -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkErrorStdEntryLabel :: CLabel
 mkErrorStdEntryLabel :: CLabel
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkFastEntryLabel :: Id -> Int -> CLabel
 mkFastEntryLabel :: Id -> Int -> CLabel
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkInfoTableLabel :: Id -> CLabel
 mkInfoTableLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkInfoTableVecTblLabel :: TyCon -> CLabel
 mkInfoTableVecTblLabel :: TyCon -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkPhantomInfoTableLabel :: Id -> CLabel
 mkPhantomInfoTableLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkRednCountsLabel :: Id -> CLabel
 mkRednCountsLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkReturnPtLabel :: Unique -> CLabel
 mkReturnPtLabel :: Unique -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStaticConEntryLabel :: Id -> CLabel
 mkStaticConEntryLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStaticInfoTableLabel :: Id -> CLabel
 mkStaticInfoTableLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStdEntryLabel :: Id -> CLabel
 mkStdEntryLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStdUpdCodePtrVecLabel :: TyCon -> Int -> CLabel
 mkStdUpdCodePtrVecLabel :: TyCon -> Int -> CLabel
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkStdUpdVecTblLabel :: TyCon -> CLabel
 mkStdUpdVecTblLabel :: TyCon -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkVapEntryLabel :: Id -> Bool -> CLabel
 mkVapEntryLabel :: Id -> Bool -> CLabel
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkVapInfoTableLabel :: Id -> Bool -> CLabel
 mkVapInfoTableLabel :: Id -> Bool -> CLabel
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkVecTblLabel :: Unique -> CLabel
 mkVecTblLabel :: Unique -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 modnameToC :: _PackedString -> _PackedString
 modnameToC :: _PackedString -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 needsCDecl :: CLabel -> Bool
 needsCDecl :: CLabel -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 pprCLabel :: PprStyle -> CLabel -> CSeq
 pprCLabel :: PprStyle -> CLabel -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 stringToC :: [Char] -> [Char]
 stringToC :: [Char] -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance Eq CLabel
 instance Eq CLabel
-       {-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool)] [_CONSTM_ Eq (==) (CLabel), _CONSTM_ Eq (/=) (CLabel)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord CLabel
 instance Ord CLabel
-       {-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq CLabel}}, (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> _CMP_TAG)] [_DFUN_ Eq (CLabel), _CONSTM_ Ord (<) (CLabel), _CONSTM_ Ord (<=) (CLabel), _CONSTM_ Ord (>=) (CLabel), _CONSTM_ Ord (>) (CLabel), _CONSTM_ Ord max (CLabel), _CONSTM_ Ord min (CLabel), _CONSTM_ Ord _tagCmp (CLabel)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 
 
index 0e490e2..b2bb2b9 100644 (file)
@@ -222,7 +222,7 @@ data RtsLabelInfo
 mkClosureLabel         id              = IdLabel (CLabelId id) Closure
 mkInfoTableLabel       id              = IdLabel (CLabelId id) InfoTbl
 mkStdEntryLabel                id              = IdLabel (CLabelId id) EntryStd
 mkClosureLabel         id              = IdLabel (CLabelId id) Closure
 mkInfoTableLabel       id              = IdLabel (CLabelId id) InfoTbl
 mkStdEntryLabel                id              = IdLabel (CLabelId id) EntryStd
-mkFastEntryLabel       id arity        = --false:ASSERT(arity > 0)
+mkFastEntryLabel       id arity        = ASSERT(arity > 0)
                                          IdLabel (CLabelId id) (EntryFast arity)
 mkConEntryLabel                id              = IdLabel (CLabelId id) ConEntry
 mkStaticConEntryLabel  id              = IdLabel (CLabelId id) StaticConEntry
                                          IdLabel (CLabelId id) (EntryFast arity)
 mkConEntryLabel                id              = IdLabel (CLabelId id) ConEntry
 mkStaticConEntryLabel  id              = IdLabel (CLabelId id) StaticConEntry
index caf5365..c803556 100644 (file)
@@ -7,260 +7,145 @@ import CharSeq(CSeq)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreAtom, CoreExpr)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreAtom, CoreExpr)
-import IdInfo(ArgUsageInfo, ArityInfo, DeforestInfo, DemandInfo, FBTypeInfo, IdInfo, SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo, bottomIsGuaranteed, getInfo_UF, nullSpecEnv)
+import IdInfo(ArgUsageInfo, ArityInfo, DemandInfo, FBTypeInfo, IdInfo, SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo, nullSpecEnv)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import Inst(Inst, InstOrigin, OverloadedLit)
-import InstEnv(InstTemplate, InstTy)
+import InstEnv(InstTemplate)
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import Name(Name)
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import Name(Name)
-import NameTypes(FullName, Provenance, ShortName)
-import Outputable(ExportFlag, NamedThing, Outputable)
-import PreludeGlaST(_MutableArray)
+import NameTypes(FullName, ShortName)
+import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
 import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
 import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance)
-import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TyCon(Arity(..), TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import TyVarEnv(TypeEnv(..))
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TyCon(Arity(..), TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import TyVarEnv(TypeEnv(..))
-import UniTyFuns(getMentionedTyConsAndClassesFromUniType)
 import UniType(TauType(..), ThetaType(..), UniType)
 import UniqFM(UniqFM)
 import Unique(Unique, UniqueSupply)
 import UniType(TauType(..), ThetaType(..), UniType)
 import UniqFM(UniqFM)
 import Unique(Unique, UniqueSupply)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
+data Bag a 
+data Class 
+data ClassOp 
 type ConTag = Int
 type DataCon = Id
 type DictFun = Id
 type DictVar = Id
 type ConTag = Int
 type DataCon = Id
 type DictFun = Id
 type DictVar = Id
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data SpecEnv   {-# GHC_PRAGMA SpecEnv [SpecInfo] #-}
-data SpecInfo  {-# GHC_PRAGMA SpecInfo [Labda UniType] Int Id #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data IdDetails         {-# GHC_PRAGMA LocalId ShortName Bool | SysLocalId ShortName Bool | SpecPragmaId ShortName (Labda SpecInfo) Bool | ImportedId FullName | PreludeId FullName | TopLevId FullName | DataConId FullName Int [TyVarTemplate] [(Class, UniType)] [UniType] TyCon | TupleConId Int | SuperDictSelId Class Class | ClassOpId Class ClassOp | DefaultMethodId Class ClassOp Bool | DictFunId Class UniType Bool | ConstMethodId Class UniType ClassOp Bool | InstId Inst | SpecId Id [Labda UniType] Bool | WorkerId Id #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data GlobalSwitch 
+data IdInfo 
+data SpecEnv 
+data SpecInfo 
+data Inst 
+data InstTemplate 
+data Labda a 
+data Name 
+data FullName 
+data Id 
+data IdDetails 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data UnfoldingDetails  {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
+data PrettyRep 
+data PrimKind 
+data UnfoldingDetails 
+data SrcLoc 
+data Subst 
 type Arity = Int
 type Arity = Int
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type TypeEnv = UniqFM UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type TypeEnv = UniqFM UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data UniType 
+data UniqFM a 
+data Unique 
+data UniqueSupply 
 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdArity :: Id -> Int -> Id
 addIdArity :: Id -> Int -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdDemandInfo :: Id -> DemandInfo -> Id
 addIdDemandInfo :: Id -> DemandInfo -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdSpecialisation :: Id -> SpecEnv -> Id
 addIdSpecialisation :: Id -> SpecEnv -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdStrictness :: Id -> StrictnessInfo -> Id
 addIdStrictness :: Id -> StrictnessInfo -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdUnfolding :: Id -> UnfoldingDetails -> Id
 addIdUnfolding :: Id -> UnfoldingDetails -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addIdUpdateInfo :: Id -> UpdateInfo -> Id
 addIdUpdateInfo :: Id -> UpdateInfo -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 applySubstToId :: Subst -> Id -> (Subst, Id)
 applySubstToId :: Subst -> Id -> (Subst, Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LSU(LLU(S)LLLLLLL)S)" {_A_ 5 _U_ 22212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 applyTypeEnvToId :: UniqFM UniType -> Id -> Id
 applyTypeEnvToId :: UniqFM UniType -> Id -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLLS)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-bottomIsGuaranteed :: StrictnessInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: StrictnessInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo BottomGuaranteed  -> _!_ True [] []; (u1 :: StrictnessInfo) -> _!_ False [] [] } _N_ #-}
 cmpId :: Id -> Id -> Int#
 cmpId :: Id -> Id -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 cmpId_withSpecDataCon :: Id -> Id -> Int#
 cmpId_withSpecDataCon :: Id -> Id -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAL)U(U(P)AAL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 eqId :: Id -> Id -> Bool
 eqId :: Id -> Id -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
 externallyVisibleId :: Id -> Bool
 externallyVisibleId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fIRST_TAG :: Int
 fIRST_TAG :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 getDataConArity :: Id -> Int
 getDataConArity :: Id -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLU(SLLLLLLLLL)L)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getDataConSig :: Id -> ([TyVarTemplate], [(Class, UniType)], [UniType], TyCon)
 getDataConSig :: Id -> ([TyVarTemplate], [(Class, UniType)], [UniType], TyCon)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getDataConTag :: Id -> Int
 getDataConTag :: Id -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getDataConTyCon :: Id -> TyCon
 getDataConTyCon :: Id -> TyCon
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getIdArgUsageInfo :: Id -> ArgUsageInfo
 getIdArgUsageInfo :: Id -> ArgUsageInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAAAAASAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArgUsageInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> uc; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdArity :: Id -> ArityInfo
 getIdArity :: Id -> ArityInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(SAAAAAAAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArityInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> u5; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdDemandInfo :: Id -> DemandInfo
 getIdDemandInfo :: Id -> DemandInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(ASAAAAAAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DemandInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> u6; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdFBTypeInfo :: Id -> FBTypeInfo
 getIdFBTypeInfo :: Id -> FBTypeInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAAAAAASA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: FBTypeInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> ud; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdInfo :: Id -> IdInfo
 getIdInfo :: Id -> IdInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(LLLLLLLLLL)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: IdInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u3; _NO_DEFLT_ } _N_ #-}
 getIdKind :: Id -> PrimKind
 getIdKind :: Id -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: UniType) -> case u0 of { _ALG_ (u1 :: UniType) -> _APP_  _ORIG_ UniTyFuns kindFromType [ u1 ] } _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Id) -> let {(u5 :: UniType) = case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ }} in _APP_  _ORIG_ UniTyFuns kindFromType [ u5 ] _N_ #-}
 getIdSpecialisation :: Id -> SpecEnv
 getIdSpecialisation :: Id -> SpecEnv
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAU(L)AAAAAAA)A)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [SpecInfo]) -> _!_ _ORIG_ IdInfo SpecEnv [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> u7; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdStrictness :: Id -> StrictnessInfo
 getIdStrictness :: Id -> StrictnessInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAASAAAAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StrictnessInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> u8; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdUnfolding :: Id -> UnfoldingDetails
 getIdUnfolding :: Id -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAASAAAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UnfoldingDetails) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> u9; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getIdUniType :: Id -> UniType
 getIdUniType :: Id -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_ #-}
 getIdUpdateInfo :: Id -> UpdateInfo
 getIdUpdateInfo :: Id -> UpdateInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAAASAAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UpdateInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> ua; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
-getInfo_UF :: IdInfo -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAASAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UnfoldingDetails) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u5; _NO_DEFLT_ } _N_ #-}
 getInstNamePieces :: Bool -> Inst -> [_PackedString]
 getInstNamePieces :: Bool -> Inst -> [_PackedString]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 getInstantiatedDataConSig :: Id -> [UniType] -> ([UniType], [UniType], UniType)
 getInstantiatedDataConSig :: Id -> [UniType] -> ([UniType], [UniType], UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _N_ _N_ _N_ #-}
 getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: UniType) -> case u0 of { _ALG_ (u1 :: UniType) -> _APP_  _ORIG_ UniTyFuns getMentionedTyConsAndClassesFromUniType [ u1 ] } _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Id) -> let {(u5 :: UniType) = case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ }} in _APP_  _ORIG_ UniTyFuns getMentionedTyConsAndClassesFromUniType [ u5 ] _N_ #-}
-getMentionedTyConsAndClassesFromUniType :: UniType -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 idWantsToBeINLINEd :: Id -> Bool
 idWantsToBeINLINEd :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAASAAAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: UnfoldingDetails) -> case u0 of { _ALG_ _ORIG_ SimplEnv IWantToBeINLINEd (u1 :: UnfoldingGuidance) -> _!_ True [] []; (u2 :: UnfoldingDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isBottomingId :: Id -> Bool
 isBottomingId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAASAAAAAA)A)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: StrictnessInfo) -> case u0 of { _ALG_ (u1 :: StrictnessInfo) -> _APP_  _ORIG_ IdInfo bottomIsGuaranteed [ u1 ] } _N_} _N_ _N_ #-}
 isClassOpId :: Id -> Bool
 isClassOpId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id ClassOpId (u1 :: Class) (u2 :: ClassOp) -> _!_ True [] []; (u3 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isConstMethodId :: Id -> Bool
 isConstMethodId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id ConstMethodId (u1 :: Class) (u2 :: UniType) (u3 :: ClassOp) (u4 :: Bool) -> _!_ True [] []; (u5 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isDataCon :: Id -> Bool
 isDataCon :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isDefaultMethodId :: Id -> Bool
 isDefaultMethodId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id DefaultMethodId (u1 :: Class) (u2 :: ClassOp) (u3 :: Bool) -> _!_ True [] []; (u4 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isDictFunId :: Id -> Bool
 isDictFunId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id DictFunId (u1 :: Class) (u2 :: UniType) (u3 :: Bool) -> _!_ True [] []; (u4 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isImportedId :: Id -> Bool
 isImportedId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id ImportedId (u1 :: FullName) -> _!_ True [] []; (u2 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isInstId_maybe :: Id -> Labda Inst
 isInstId_maybe :: Id -> Labda Inst
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 19 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id InstId (u1 :: Inst) -> _!_ _ORIG_ Maybes Ni [Inst] [u1]; (u2 :: IdDetails) -> _!_ _ORIG_ Maybes Hamna [Inst] [] } _N_} _N_ _N_ #-}
 isNullaryDataCon :: Id -> Bool
 isNullaryDataCon :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isSpecId_maybe :: Id -> Labda (Id, [Labda UniType])
 isSpecId_maybe :: Id -> Labda (Id, [Labda UniType])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isSpecPragmaId_maybe :: Id -> Labda (Labda SpecInfo)
 isSpecPragmaId_maybe :: Id -> Labda (Labda SpecInfo)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 19 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id SpecPragmaId (u1 :: ShortName) (u2 :: Labda SpecInfo) (u3 :: Bool) -> _!_ _ORIG_ Maybes Ni [(Labda SpecInfo)] [u2]; (u4 :: IdDetails) -> _!_ _ORIG_ Maybes Hamna [(Labda SpecInfo)] [] } _N_} _N_ _N_ #-}
 isSuperDictSelId_maybe :: Id -> Labda (Class, Class)
 isSuperDictSelId_maybe :: Id -> Labda (Class, Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isSysLocalId :: Id -> Bool
 isSysLocalId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id SysLocalId (u1 :: ShortName) (u2 :: Bool) -> _!_ True [] []; (u3 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isTopLevId :: Id -> Bool
 isTopLevId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id TopLevId (u1 :: FullName) -> _!_ True [] []; (u2 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isTupleCon :: Id -> Bool
 isTupleCon :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isWorkerId :: Id -> Bool
 isWorkerId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 18 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id WorkerId (u1 :: Id) -> _!_ True [] []; (u2 :: IdDetails) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 isWrapperId :: Id -> Bool
 isWrapperId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAASAAAAAA)A)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: StrictnessInfo) -> case u0 of { _ALG_ (u1 :: StrictnessInfo) -> _APP_  _ORIG_ IdInfo workerExists [ u1 ] } _N_} _N_ _N_ #-}
 localiseId :: Id -> Id
 localiseId :: Id -> Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLLL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkClassOpId :: Unique -> Class -> ClassOp -> UniType -> IdInfo -> Id
 mkClassOpId :: Unique -> Class -> ClassOp -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkConstMethodId :: Unique -> Class -> ClassOp -> UniType -> UniType -> Bool -> IdInfo -> Id
 mkConstMethodId :: Unique -> Class -> ClassOp -> UniType -> UniType -> Bool -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 mkDataCon :: Unique -> FullName -> [TyVarTemplate] -> [(Class, UniType)] -> [UniType] -> TyCon -> SpecEnv -> Id
 mkDataCon :: Unique -> FullName -> [TyVarTemplate] -> [(Class, UniType)] -> [UniType] -> TyCon -> SpecEnv -> Id
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 mkDefaultMethodId :: Unique -> Class -> ClassOp -> Bool -> UniType -> IdInfo -> Id
 mkDefaultMethodId :: Unique -> Class -> ClassOp -> Bool -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 mkDictFunId :: Unique -> Class -> UniType -> UniType -> Bool -> IdInfo -> Id
 mkDictFunId :: Unique -> Class -> UniType -> UniType -> Bool -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 mkId :: Name -> UniType -> IdInfo -> Id
 mkId :: Name -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 mkIdWithNewUniq :: Id -> Unique -> Id
 mkIdWithNewUniq :: Id -> Unique -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(ALLL)L" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkImported :: Unique -> FullName -> UniType -> IdInfo -> Id
 mkImported :: Unique -> FullName -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 mkInstId :: Inst -> Id
 mkInstId :: Inst -> Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkPreludeId :: Unique -> FullName -> UniType -> IdInfo -> Id
 mkPreludeId :: Unique -> FullName -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 mkSameSpecCon :: [Labda UniType] -> Id -> Id
 mkSameSpecCon :: [Labda UniType] -> Id -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkSpecId :: Unique -> Id -> [Labda UniType] -> UniType -> IdInfo -> Id
 mkSpecId :: Unique -> Id -> [Labda UniType] -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkSpecPragmaId :: _PackedString -> Unique -> UniType -> Labda SpecInfo -> SrcLoc -> Id
 mkSpecPragmaId :: _PackedString -> Unique -> UniType -> Labda SpecInfo -> SrcLoc -> Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkSuperDictSelId :: Unique -> Class -> Class -> UniType -> IdInfo -> Id
 mkSuperDictSelId :: Unique -> Class -> Class -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkSysLocal :: _PackedString -> Unique -> UniType -> SrcLoc -> Id
 mkSysLocal :: _PackedString -> Unique -> UniType -> SrcLoc -> Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 mkTemplateLocals :: [UniType] -> [Id]
 mkTemplateLocals :: [UniType] -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkTupleCon :: Int -> Id
 mkTupleCon :: Int -> Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkUserLocal :: _PackedString -> Unique -> UniType -> SrcLoc -> Id
 mkUserLocal :: _PackedString -> Unique -> UniType -> SrcLoc -> Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 mkWorkerId :: Unique -> Id -> UniType -> IdInfo -> Id
 mkWorkerId :: Unique -> Id -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 myWrapperMaybe :: Id -> Labda Id
 myWrapperMaybe :: Id -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 19 \ (u0 :: IdDetails) -> case u0 of { _ALG_ _ORIG_ Id WorkerId (u1 :: Id) -> _!_ _ORIG_ Maybes Ni [Id] [u1]; (u2 :: IdDetails) -> _!_ _ORIG_ Maybes Hamna [Id] [] } _N_} _N_ _N_ #-}
 nullSpecEnv :: SpecEnv
 nullSpecEnv :: SpecEnv
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pprIdInUnfolding :: UniqFM Id -> Id -> Int -> Bool -> PrettyRep
 pprIdInUnfolding :: UniqFM Id -> Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "SU(U(P)LLL)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 replaceIdInfo :: Id -> IdInfo -> Id
 replaceIdInfo :: Id -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLAL)L" {_A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: UniType) (u2 :: IdDetails) (u3 :: IdInfo) -> _!_ _ORIG_ Id Id [] [u0, u1, u3, u2] _N_} _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: Id) (u1 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ Id Id (u2 :: Unique) (u3 :: UniType) (u4 :: IdInfo) (u5 :: IdDetails) -> _!_ _ORIG_ Id Id [] [u2, u3, u1, u5]; _NO_DEFLT_ } _N_ #-}
 showId :: PprStyle -> Id -> [Char]
 showId :: PprStyle -> Id -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 toplevelishId :: Id -> Bool
 toplevelishId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 unfoldingUnfriendlyId :: Id -> Bool
 unfoldingUnfriendlyId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 unlocaliseId :: _PackedString -> Id -> Labda Id
 unlocaliseId :: _PackedString -> Id -> Labda Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLLS)" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 updateIdType :: Id -> UniType -> Id
 updateIdType :: Id -> UniType -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LALL)L" {_A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: IdInfo) (u2 :: IdDetails) (u3 :: UniType) -> _!_ _ORIG_ Id Id [] [u0, u3, u1, u2] _N_} _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: Id) (u1 :: UniType) -> case u0 of { _ALG_ _ORIG_ Id Id (u2 :: Unique) (u3 :: UniType) (u4 :: IdInfo) (u5 :: IdDetails) -> _!_ _ORIG_ Id Id [] [u2, u1, u4, u5]; _NO_DEFLT_ } _N_ #-}
 whatsMentionedInId :: UniqFM Id -> Id -> (Bag Id, Bag TyCon, Bag Class)
 whatsMentionedInId :: UniqFM Id -> Id -> (Bag Id, Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 
 
index 9206d06..7b976de 100644 (file)
@@ -4,281 +4,139 @@ import Bag(Bag)
 import BasicLit(BasicLit)
 import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
 import CharSeq(CSeq)
 import BasicLit(BasicLit)
 import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
 import CharSeq(CSeq)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import CmdLineOpts(GlobalSwitch)
-import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
+import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import InstEnv(InstTemplate, InstTy)
+import InstEnv(InstTemplate)
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import Outputable(Outputable)
 import PlainCore(PlainCoreAtom(..), PlainCoreExpr(..))
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import Outputable(Outputable)
 import PlainCore(PlainCoreAtom(..), PlainCoreExpr(..))
-import PreludeGlaST(_MutableArray)
 import PreludePS(_PackedString)
 import PreludePS(_PackedString)
-import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
-import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import PrimOps(PrimOp)
-import SimplEnv(FormSummary, IdVal, InExpr(..), OutAtom(..), OutExpr(..), OutId(..), SimplEnv, UnfoldingDetails(..), UnfoldingGuidance(..))
-import SimplMonad(SimplCount)
-import SplitUniq(SplitUniqSupply)
-import SrcLoc(SrcLoc, mkUnknownSrcLoc)
+import SimplEnv(FormSummary, IdVal, InExpr(..), OutAtom(..), OutExpr(..), OutId(..), UnfoldingDetails(..), UnfoldingGuidance(..))
+import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TaggedCore(SimplifiableBinder(..), SimplifiableCoreExpr(..))
 import Subst(Subst)
 import TaggedCore(SimplifiableBinder(..), SimplifiableCoreExpr(..))
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(UniqSM(..), Unique, UniqueSupply)
 class OptIdInfo a where
        noInfo :: a
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(UniqSM(..), Unique, UniqueSupply)
 class OptIdInfo a where
        noInfo :: a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 1 _N_ _S_ "U(SAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) -> _APP_  _TYAPP_  patError# { u0 } [ _NOREP_S_ "%DIdInfo.OptIdInfo.noInfo\"" ] _N_ #-}
        getInfo :: IdInfo -> a
        getInfo :: IdInfo -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: IdInfo -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.getInfo\"", u2 ] _N_ #-}
        addInfo :: IdInfo -> a -> IdInfo
        addInfo :: IdInfo -> a -> IdInfo
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AASA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: IdInfo -> u0 -> IdInfo) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) (u3 :: u0) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0 -> IdInfo) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.addInfo\"", u2, u3 ] _N_ #-}
        ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
        ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122222 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 122222 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 6 _U_ 022222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 6 XXXXXX 7 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: PprStyle) (u3 :: Id -> Id) (u4 :: u0) (u5 :: Int) (u6 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.ppInfo\"", u2, u3, u4, u5, u6 ] _N_ #-}
 data ArgUsage   = ArgUsage Int | UnknownArgUsage
 data ArgUsage   = ArgUsage Int | UnknownArgUsage
-data ArgUsageInfo      {-# GHC_PRAGMA NoArgUsageInfo | SomeArgUsageInfo [ArgUsage] #-}
+data ArgUsageInfo 
 type ArgUsageType = [ArgUsage]
 type ArgUsageType = [ArgUsage]
-data ArityInfo         {-# GHC_PRAGMA UnknownArity | ArityExactly Int #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
+data ArityInfo 
+data Bag a 
+data BasicLit 
+data BinderInfo 
+data CoreAtom a 
+data CoreExpr a b 
 data DeforestInfo   = Don'tDeforest | DoDeforest
 data Demand   = WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum
 data DeforestInfo   = Don'tDeforest | DoDeforest
 data Demand   = WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum
-data DemandInfo        {-# GHC_PRAGMA UnknownDemand | DemandedAsPer Demand #-}
+data DemandInfo 
 data FBConsum   = FBGoodConsum | FBBadConsum
 data FBProd   = FBGoodProd | FBBadProd
 data FBType   = FBType [FBConsum] FBProd
 data FBConsum   = FBGoodConsum | FBBadConsum
 data FBProd   = FBGoodProd | FBBadProd
 data FBType   = FBType [FBConsum] FBProd
-data FBTypeInfo        {-# GHC_PRAGMA NoFBTypeInfo | SomeFBTypeInfo FBType #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data FBTypeInfo 
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
-data MagicUnfoldingFun         {-# GHC_PRAGMA MUF (SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)) #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data IdInfo 
+data InstTemplate 
+data MagicUnfoldingFun 
+data Labda a 
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreExpr = CoreExpr Id Id
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data FormSummary       {-# GHC_PRAGMA WhnfForm | BottomForm | OtherForm #-}
-data IdVal     {-# GHC_PRAGMA InlineIt (UniqFM IdVal) (UniqFM UniType) (CoreExpr (Id, BinderInfo) Id) | ItsAnAtom (CoreAtom Id) #-}
+data PrettyRep 
+data FormSummary 
+data IdVal 
 type InExpr = CoreExpr (Id, BinderInfo) Id
 type OutAtom = CoreAtom Id
 type OutExpr = CoreExpr Id Id
 type OutId = Id
 data UnfoldingDetails   = NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance
 data UnfoldingGuidance   = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int
 type InExpr = CoreExpr (Id, BinderInfo) Id
 type OutAtom = CoreAtom Id
 type OutExpr = CoreExpr Id Id
 type OutId = Id
 data UnfoldingDetails   = NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance
 data UnfoldingGuidance   = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
+data SrcLoc 
+data Subst 
 type SimplifiableBinder = (Id, BinderInfo)
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
 type SimplifiableBinder = (Id, BinderInfo)
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
-data SpecEnv   {-# GHC_PRAGMA SpecEnv [SpecInfo] #-}
+data SpecEnv 
 data SpecInfo   = SpecInfo [Labda UniType] Int Id
 data StrictnessInfo   = NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id)
 data SpecInfo   = SpecInfo [Labda UniType] Int Id
 data StrictnessInfo   = NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id)
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniType 
+data UniqFM a 
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
-data UpdateInfo        {-# GHC_PRAGMA NoUpdateInfo | SomeUpdateInfo [Int] #-}
+data Unique 
+data UniqueSupply 
+data UpdateInfo 
 type UpdateSpec = [Int]
 addInfo_UF :: IdInfo -> UnfoldingDetails -> IdInfo
 type UpdateSpec = [Int]
 addInfo_UF :: IdInfo -> UnfoldingDetails -> IdInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_ #-}
 addOneToSpecEnv :: SpecEnv -> SpecInfo -> SpecEnv
 addOneToSpecEnv :: SpecEnv -> SpecInfo -> SpecEnv
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(L)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 applySubstToIdInfo :: Subst -> IdInfo -> (Subst, IdInfo)
 applySubstToIdInfo :: Subst -> IdInfo -> (Subst, IdInfo)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLU(S)LLLLLLL)" _N_ _N_ #-}
 apply_to_IdInfo :: (UniType -> UniType) -> IdInfo -> IdInfo
 apply_to_IdInfo :: (UniType -> UniType) -> IdInfo -> IdInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLLLLLLLLL)" _N_ _N_ #-}
 arityMaybe :: ArityInfo -> Labda Int
 arityMaybe :: ArityInfo -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: ArityInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo UnknownArity  -> _!_ _ORIG_ Maybes Hamna [Int] []; _ORIG_ IdInfo ArityExactly (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; _NO_DEFLT_ } _N_ #-}
 boringIdInfo :: IdInfo -> Bool
 boringIdInfo :: IdInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(SLALLLLAAA)" _N_ _N_ #-}
 bottomIsGuaranteed :: StrictnessInfo -> Bool
 bottomIsGuaranteed :: StrictnessInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: StrictnessInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo BottomGuaranteed  -> _!_ True [] []; (u1 :: StrictnessInfo) -> _!_ False [] [] } _N_ #-}
 getArgUsage :: ArgUsageInfo -> [ArgUsage]
 getArgUsage :: ArgUsageInfo -> [ArgUsage]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: ArgUsageInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo NoArgUsageInfo  -> _!_ _NIL_ [ArgUsage] []; _ORIG_ IdInfo SomeArgUsageInfo (u1 :: [ArgUsage]) -> u1; _NO_DEFLT_ } _N_ #-}
 getFBType :: FBTypeInfo -> Labda FBType
 getFBType :: FBTypeInfo -> Labda FBType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: FBTypeInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo NoFBTypeInfo  -> _!_ _ORIG_ Maybes Hamna [FBType] []; _ORIG_ IdInfo SomeFBTypeInfo (u1 :: FBType) -> _!_ _ORIG_ Maybes Ni [FBType] [u1]; _NO_DEFLT_ } _N_ #-}
 getInfo_UF :: IdInfo -> UnfoldingDetails
 getInfo_UF :: IdInfo -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAASAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UnfoldingDetails) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u5; _NO_DEFLT_ } _N_ #-}
 getSrcLocIdInfo :: IdInfo -> SrcLoc
 getSrcLocIdInfo :: IdInfo -> SrcLoc
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> ua; _NO_DEFLT_ } _N_ #-}
 getWorkerId :: StrictnessInfo -> Id
 getWorkerId :: StrictnessInfo -> Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getWrapperArgTypeCategories :: UniType -> StrictnessInfo -> Labda [Char]
 getWrapperArgTypeCategories :: UniType -> StrictnessInfo -> Labda [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 iWantToBeINLINEd :: UnfoldingGuidance -> UnfoldingDetails
 iWantToBeINLINEd :: UnfoldingGuidance -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: UnfoldingGuidance) -> _!_ _ORIG_ SimplEnv IWantToBeINLINEd [] [u0] _N_ #-}
 indicatesWorker :: [Demand] -> Bool
 indicatesWorker :: [Demand] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 lookupConstMethodId :: SpecEnv -> UniType -> Labda Id
 lookupConstMethodId :: SpecEnv -> UniType -> Labda Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(S)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupSpecEnv :: SpecEnv -> [UniType] -> Labda (Id, [UniType], Int)
 lookupSpecEnv :: SpecEnv -> [UniType] -> Labda (Id, [UniType], Int)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(S)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupSpecId :: Id -> [Labda UniType] -> Id
 lookupSpecId :: Id -> [Labda UniType] -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLU(LLU(S)LLLLLLL)L)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkArgUsageInfo :: [ArgUsage] -> ArgUsageInfo
 mkArgUsageInfo :: [ArgUsage] -> ArgUsageInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [ArgUsage]) -> _!_ _ORIG_ IdInfo SomeArgUsageInfo [] [u0] _N_ #-}
 mkArityInfo :: Int -> ArityInfo
 mkArityInfo :: Int -> ArityInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ IdInfo ArityExactly [] [u0] _N_ #-}
 mkBottomStrictnessInfo :: StrictnessInfo
 mkBottomStrictnessInfo :: StrictnessInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo BottomGuaranteed [] [] _N_ #-}
 mkDemandInfo :: Demand -> DemandInfo
 mkDemandInfo :: Demand -> DemandInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Demand) -> _!_ _ORIG_ IdInfo DemandedAsPer [] [u0] _N_ #-}
 mkFBTypeInfo :: FBType -> FBTypeInfo
 mkFBTypeInfo :: FBType -> FBTypeInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: FBType) -> _!_ _ORIG_ IdInfo SomeFBTypeInfo [] [u0] _N_ #-}
 mkMagicUnfolding :: _PackedString -> UnfoldingDetails
 mkMagicUnfolding :: _PackedString -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkSpecEnv :: [SpecInfo] -> SpecEnv
 mkSpecEnv :: [SpecInfo] -> SpecEnv
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [SpecInfo]) -> _!_ _ORIG_ IdInfo SpecEnv [] [u0] _N_ #-}
 mkStrictnessInfo :: [Demand] -> Labda Id -> StrictnessInfo
 mkStrictnessInfo :: [Demand] -> Labda Id -> StrictnessInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [Demand]) (u1 :: Labda Id) -> case u0 of { _ALG_ (:) (u2 :: Demand) (u3 :: [Demand]) -> _!_ _ORIG_ IdInfo StrictnessInfo [] [u0, u1]; _NIL_  -> _!_ _ORIG_ IdInfo NoStrictnessInfo [] []; _NO_DEFLT_ } _N_ #-}
 mkUnfolding :: UnfoldingGuidance -> CoreExpr Id Id -> UnfoldingDetails
 mkUnfolding :: UnfoldingGuidance -> CoreExpr Id Id -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
-mkUnknownSrcLoc :: SrcLoc
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkUpdateInfo :: [Int] -> UpdateInfo
 mkUpdateInfo :: [Int] -> UpdateInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [Int]) -> _!_ _ORIG_ IdInfo SomeUpdateInfo [] [u0] _N_ #-}
 noIdInfo :: IdInfo
 noIdInfo :: IdInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _ORIG_ IdInfo IdInfo [] [_CONSTM_ OptIdInfo noInfo (ArityInfo), _CONSTM_ OptIdInfo noInfo (DemandInfo), _ORIG_ IdInfo nullSpecEnv, _CONSTM_ OptIdInfo noInfo (StrictnessInfo), _ORIG_ IdInfo noInfo_UF, _CONSTM_ OptIdInfo noInfo (UpdateInfo), _CONSTM_ OptIdInfo noInfo (DeforestInfo), _CONSTM_ OptIdInfo noInfo (ArgUsageInfo), _CONSTM_ OptIdInfo noInfo (FBTypeInfo), _ORIG_ SrcLoc mkUnknownSrcLoc] _N_ #-}
 noInfo_UF :: UnfoldingDetails
 noInfo_UF :: UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ SimplEnv NoUnfoldingDetails [] [] _N_ #-}
 nonAbsentArgs :: [Demand] -> Int
 nonAbsentArgs :: [Demand] -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 nullSpecEnv :: SpecEnv
 nullSpecEnv :: SpecEnv
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ppIdInfo :: PprStyle -> Id -> Bool -> (Id -> Id) -> UniqFM UnfoldingDetails -> IdInfo -> Int -> Bool -> PrettyRep
 ppIdInfo :: PprStyle -> Id -> Bool -> (Id -> Id) -> UniqFM UnfoldingDetails -> IdInfo -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 6 _U_ 22122222 _N_ _S_ "LLLLLU(SLLLLLLALA)" _N_ _N_ #-}
 unknownArity :: ArityInfo
 unknownArity :: ArityInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownArity [] [] _N_ #-}
 updateInfoMaybe :: UpdateInfo -> Labda [Int]
 updateInfoMaybe :: UpdateInfo -> Labda [Int]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 willBeDemanded :: DemandInfo -> Bool
 willBeDemanded :: DemandInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 workerExists :: StrictnessInfo -> Bool
 workerExists :: StrictnessInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 wwEnum :: Demand
 wwEnum :: Demand
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo WwEnum [] [] _N_ #-}
 wwLazy :: Demand
 wwLazy :: Demand
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wwPrim :: Demand
 wwPrim :: Demand
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo WwPrim [] [] _N_ #-}
 wwStrict :: Demand
 wwStrict :: Demand
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo WwStrict [] [] _N_ #-}
 wwUnpack :: [Demand] -> Demand
 wwUnpack :: [Demand] -> Demand
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [Demand]) -> _!_ _ORIG_ IdInfo WwUnpack [] [u0] _N_ #-}
 instance Eq Demand
 instance Eq Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Demand -> Demand -> Bool), (Demand -> Demand -> Bool)] [_CONSTM_ Eq (==) (Demand), _CONSTM_ Eq (/=) (Demand)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq FBConsum
 instance Eq FBConsum
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBConsum -> FBConsum -> Bool), (FBConsum -> FBConsum -> Bool)] [_CONSTM_ Eq (==) (FBConsum), _CONSTM_ Eq (/=) (FBConsum)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq FBProd
 instance Eq FBProd
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBProd -> FBProd -> Bool), (FBProd -> FBProd -> Bool)] [_CONSTM_ Eq (==) (FBProd), _CONSTM_ Eq (/=) (FBProd)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq FBType
 instance Eq FBType
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBType -> FBType -> Bool), (FBType -> FBType -> Bool)] [_CONSTM_ Eq (==) (FBType), _CONSTM_ Eq (/=) (FBType)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(LL)U(LL)" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(LL)U(LL)" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq UpdateInfo
 instance Eq UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool)] [_CONSTM_ Eq (==) (UpdateInfo), _CONSTM_ Eq (/=) (UpdateInfo)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance OptIdInfo ArgUsageInfo
 instance OptIdInfo ArgUsageInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [ArgUsageInfo, (IdInfo -> ArgUsageInfo), (IdInfo -> ArgUsageInfo -> IdInfo), (PprStyle -> (Id -> Id) -> ArgUsageInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (ArgUsageInfo), _CONSTM_ OptIdInfo getInfo (ArgUsageInfo), _CONSTM_ OptIdInfo addInfo (ArgUsageInfo), _CONSTM_ OptIdInfo ppInfo (ArgUsageInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoArgUsageInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArgUsageInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u8; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo ArityInfo
 instance OptIdInfo ArityInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [ArityInfo, (IdInfo -> ArityInfo), (IdInfo -> ArityInfo -> IdInfo), (PprStyle -> (Id -> Id) -> ArityInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (ArityInfo), _CONSTM_ OptIdInfo getInfo (ArityInfo), _CONSTM_ OptIdInfo addInfo (ArityInfo), _CONSTM_ OptIdInfo ppInfo (ArityInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownArity [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(SAAAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArityInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u1; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo DeforestInfo
 instance OptIdInfo DeforestInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [DeforestInfo, (IdInfo -> DeforestInfo), (IdInfo -> DeforestInfo -> IdInfo), (PprStyle -> (Id -> Id) -> DeforestInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (DeforestInfo), _CONSTM_ OptIdInfo getInfo (DeforestInfo), _CONSTM_ OptIdInfo addInfo (DeforestInfo), _CONSTM_ OptIdInfo ppInfo (DeforestInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo Don'tDeforest [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAEAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DeforestInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u7; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)E" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAE" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo DemandInfo
 instance OptIdInfo DemandInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [DemandInfo, (IdInfo -> DemandInfo), (IdInfo -> DemandInfo -> IdInfo), (PprStyle -> (Id -> Id) -> DemandInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (DemandInfo), _CONSTM_ OptIdInfo getInfo (DemandInfo), _CONSTM_ OptIdInfo addInfo (DemandInfo), _CONSTM_ OptIdInfo ppInfo (DemandInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownDemand [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(ASAAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DemandInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u2; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LALLLLLLLL)L" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 10122 _N_ _S_ "SAL" {_A_ 2 _U_ 1122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo FBTypeInfo
 instance OptIdInfo FBTypeInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [FBTypeInfo, (IdInfo -> FBTypeInfo), (IdInfo -> FBTypeInfo -> IdInfo), (PprStyle -> (Id -> Id) -> FBTypeInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (FBTypeInfo), _CONSTM_ OptIdInfo getInfo (FBTypeInfo), _CONSTM_ OptIdInfo addInfo (FBTypeInfo), _CONSTM_ OptIdInfo ppInfo (FBTypeInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoFBTypeInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: FBTypeInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u9; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20222 _N_ _S_ "SAS" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo SpecEnv
 instance OptIdInfo SpecEnv
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [SpecEnv, (IdInfo -> SpecEnv), (IdInfo -> SpecEnv -> IdInfo), (PprStyle -> (Id -> Id) -> SpecEnv -> Int -> Bool -> PrettyRep)] [_ORIG_ IdInfo nullSpecEnv, _CONSTM_ OptIdInfo getInfo (SpecEnv), _CONSTM_ OptIdInfo addInfo (SpecEnv), _CONSTM_ OptIdInfo ppInfo (SpecEnv)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ IdInfo nullSpecEnv _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAU(L)AAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [SpecInfo]) -> _!_ _ORIG_ IdInfo SpecEnv [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u3; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 11 _N_ _S_ "U(LLU(L)LLLLLLL)U(L)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        ppInfo = _A_ 3 _U_ 22122 _N_ _S_ "LLU(S)" {_A_ 3 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance OptIdInfo StrictnessInfo
 instance OptIdInfo StrictnessInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [StrictnessInfo, (IdInfo -> StrictnessInfo), (IdInfo -> StrictnessInfo -> IdInfo), (PprStyle -> (Id -> Id) -> StrictnessInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (StrictnessInfo), _CONSTM_ OptIdInfo getInfo (StrictnessInfo), _CONSTM_ OptIdInfo addInfo (StrictnessInfo), _CONSTM_ OptIdInfo ppInfo (StrictnessInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoStrictnessInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAASAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StrictnessInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-}
 instance OptIdInfo UpdateInfo
 instance OptIdInfo UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [UpdateInfo, (IdInfo -> UpdateInfo), (IdInfo -> UpdateInfo -> IdInfo), (PprStyle -> (Id -> Id) -> UpdateInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (UpdateInfo), _CONSTM_ OptIdInfo getInfo (UpdateInfo), _CONSTM_ OptIdInfo addInfo (UpdateInfo), _CONSTM_ OptIdInfo ppInfo (UpdateInfo)] _N_
-        noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoUpdateInfo [] [] _N_,
-        getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAASAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UpdateInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_,
-        ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord Demand
 instance Ord Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Demand}}, (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Demand), (Demand -> Demand -> Demand), (Demand -> Demand -> _CMP_TAG)] [_DFUN_ Eq (Demand), _CONSTM_ Ord (<) (Demand), _CONSTM_ Ord (<=) (Demand), _CONSTM_ Ord (>=) (Demand), _CONSTM_ Ord (>) (Demand), _CONSTM_ Ord max (Demand), _CONSTM_ Ord min (Demand), _CONSTM_ Ord _tagCmp (Demand)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord UpdateInfo
 instance Ord UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq UpdateInfo}}, (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> UpdateInfo), (UpdateInfo -> UpdateInfo -> UpdateInfo), (UpdateInfo -> UpdateInfo -> _CMP_TAG)] [_DFUN_ Eq (UpdateInfo), _CONSTM_ Ord (<) (UpdateInfo), _CONSTM_ Ord (<=) (UpdateInfo), _CONSTM_ Ord (>=) (UpdateInfo), _CONSTM_ Ord (>) (UpdateInfo), _CONSTM_ Ord max (UpdateInfo), _CONSTM_ Ord min (UpdateInfo), _CONSTM_ Ord _tagCmp (UpdateInfo)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable Demand
 instance Outputable Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Demand) _N_
-        ppr = _A_ 2 _U_ 0220 _N_ _S_ "AL" {_A_ 1 _U_ 220 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Text Demand
 instance Text Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Demand, [Char])]), (Int -> Demand -> [Char] -> [Char]), ([Char] -> [([Demand], [Char])]), ([Demand] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Demand), _CONSTM_ Text showsPrec (Demand), _CONSTM_ Text readList (Demand), _CONSTM_ Text showList (Demand)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(Demand, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Demand) (u2 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> Demand -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_,
-        readList = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        showList = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instance Text UpdateInfo
 instance Text UpdateInfo
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(UpdateInfo, [Char])]), (Int -> UpdateInfo -> [Char] -> [Char]), ([Char] -> [([UpdateInfo], [Char])]), ([UpdateInfo] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (UpdateInfo), _CONSTM_ Text showsPrec (UpdateInfo), _CONSTM_ Text readList (UpdateInfo), _CONSTM_ Text showList (UpdateInfo)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AS" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: UpdateInfo) (u2 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> UpdateInfo -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 1941fd5..b7968b2 100644 (file)
@@ -1,6 +1,5 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Inst where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Inst where
-import Bag(Bag)
 import Class(Class, ClassOp)
 import HsBinds(Binds)
 import HsExpr(ArithSeqInfo, Expr, Qual, RenamedArithSeqInfo(..), RenamedExpr(..))
 import Class(Class, ClassOp)
 import HsBinds(Binds)
 import HsExpr(ArithSeqInfo, Expr, Qual, RenamedArithSeqInfo(..), RenamedExpr(..))
@@ -8,14 +7,13 @@ import HsLit(Literal)
 import HsMatches(Match)
 import HsPat(InPat, RenamedPat(..))
 import HsTypes(PolyType)
 import HsMatches(Match)
 import HsPat(InPat, RenamedPat(..))
 import HsTypes(PolyType)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo, SpecEnv)
-import InstEnv(ClassInstEnv(..), InstTemplate, InstTy, InstanceMapper(..), MatchEnv(..))
+import Id(Id)
+import IdInfo(SpecEnv)
+import InstEnv(ClassInstEnv(..), InstTemplate, InstanceMapper(..), MatchEnv(..))
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(Outputable)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(Outputable)
-import PreludeGlaST(_MutableArray)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(PprStyle, PrettyRep)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(PprStyle, PrettyRep)
@@ -24,66 +22,47 @@ import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import Subst(Subst)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
-import UniTyFuns(isTyVarTy)
 import UniType(UniType)
 import Unique(Unique)
 import UniType(UniType)
 import Unique(Unique)
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data ArithSeqInfo a b  {-# GHC_PRAGMA From (Expr a b) | FromThen (Expr a b) (Expr a b) | FromTo (Expr a b) (Expr a b) | FromThenTo (Expr a b) (Expr a b) (Expr a b) #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
+data Class 
+data ClassOp 
+data ArithSeqInfo a b 
+data Expr a b 
 data Inst   = Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin
 data InstOrigin   = OccurrenceOf Id SrcLoc | InstanceDeclOrigin SrcLoc | LiteralOrigin Literal SrcLoc | ArithSeqOrigin (ArithSeqInfo Name (InPat Name)) SrcLoc | SignatureOrigin | ClassDeclOrigin SrcLoc | DerivingOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class Bool TyCon SrcLoc | InstanceSpecOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class UniType SrcLoc | DefaultDeclOrigin SrcLoc | ValSpecOrigin Name SrcLoc | CCallOrigin SrcLoc [Char] (Labda (Expr Name (InPat Name))) | LitLitOrigin SrcLoc [Char] | UnknownOrigin
 data OverloadedLit   = OverloadedIntegral Integer Id Id | OverloadedFractional (Ratio Integer) Id
 type RenamedArithSeqInfo = ArithSeqInfo Name (InPat Name)
 type RenamedExpr = Expr Name (InPat Name)
 data Inst   = Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin
 data InstOrigin   = OccurrenceOf Id SrcLoc | InstanceDeclOrigin SrcLoc | LiteralOrigin Literal SrcLoc | ArithSeqOrigin (ArithSeqInfo Name (InPat Name)) SrcLoc | SignatureOrigin | ClassDeclOrigin SrcLoc | DerivingOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class Bool TyCon SrcLoc | InstanceSpecOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class UniType SrcLoc | DefaultDeclOrigin SrcLoc | ValSpecOrigin Name SrcLoc | CCallOrigin SrcLoc [Char] (Labda (Expr Name (InPat Name))) | LitLitOrigin SrcLoc [Char] | UnknownOrigin
 data OverloadedLit   = OverloadedIntegral Integer Id Id | OverloadedFractional (Ratio Integer) Id
 type RenamedArithSeqInfo = ArithSeqInfo Name (InPat Name)
 type RenamedExpr = Expr Name (InPat Name)
-data Literal   {-# GHC_PRAGMA CharLit Char | CharPrimLit Char | StringLit _PackedString | StringPrimLit _PackedString | IntLit Integer | FracLit (Ratio Integer) | LitLitLitIn _PackedString | LitLitLit _PackedString UniType | IntPrimLit Integer | FloatPrimLit (Ratio Integer) | DoublePrimLit (Ratio Integer) #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data Literal 
+data InPat a 
 type RenamedPat = InPat Name
 type RenamedPat = InPat Name
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type ClassInstEnv = [(UniType, InstTemplate)]
 type ClassInstEnv = [(UniType, InstTemplate)]
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
+data InstTemplate 
 type InstanceMapper = Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)
 type MatchEnv a b = [(a, b)]
 type InstanceMapper = Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)
 type MatchEnv a b = [(a, b)]
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Name 
+data PrimKind 
+data SrcLoc 
+data Subst 
+data TyCon 
+data TyVar 
+data TyVarTemplate 
+data UniType 
+data Unique 
 applySubstToInst :: Subst -> Inst -> (Subst, Inst)
 applySubstToInst :: Subst -> Inst -> (Subst, Inst)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 apply_to_Inst :: (UniType -> UniType) -> Inst -> Inst
 apply_to_Inst :: (UniType -> UniType) -> Inst -> Inst
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 extractConstrainedTyVarsFromInst :: Inst -> [TyVar]
 extractConstrainedTyVarsFromInst :: Inst -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarsFromInst :: Inst -> [TyVar]
 extractTyVarsFromInst :: Inst -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getDictClassAndType :: Inst -> (Class, UniType)
 getDictClassAndType :: Inst -> (Class, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getInstOrigin :: Inst -> (SrcLoc, PprStyle -> Int -> Bool -> PrettyRep)
 getInstOrigin :: Inst -> (SrcLoc, PprStyle -> Int -> Bool -> PrettyRep)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getInstUniType :: Inst -> UniType
 getInstUniType :: Inst -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instBindingRequired :: Inst -> Bool
 instBindingRequired :: Inst -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instCanBeGeneralised :: Inst -> Bool
 instCanBeGeneralised :: Inst -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTyVarDict :: Inst -> Bool
 isTyVarDict :: Inst -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: Inst) -> case u0 of { _ALG_ _ORIG_ Inst Dict (u1 :: Unique) (u2 :: Class) (u3 :: UniType) (u4 :: InstOrigin) -> _APP_  _ORIG_ UniTyFuns isTyVarTy [ u3 ]; (u5 :: Inst) -> _!_ False [] [] } _N_ #-}
-isTyVarTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 matchesInst :: Inst -> Inst -> Bool
 matchesInst :: Inst -> Inst -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 mkDict :: Unique -> Class -> UniType -> InstOrigin -> Inst
 mkDict :: Unique -> Class -> UniType -> InstOrigin -> Inst
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: Class) (u2 :: UniType) (u3 :: InstOrigin) -> _!_ _ORIG_ Inst Dict [] [u0, u1, u2, u3] _N_ #-}
 mkLitInst :: Unique -> OverloadedLit -> UniType -> InstOrigin -> Inst
 mkLitInst :: Unique -> OverloadedLit -> UniType -> InstOrigin -> Inst
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: OverloadedLit) (u2 :: UniType) (u3 :: InstOrigin) -> _!_ _ORIG_ Inst LitInst [] [u0, u1, u2, u3] _N_ #-}
 mkMethod :: Unique -> Id -> [UniType] -> InstOrigin -> Inst
 mkMethod :: Unique -> Id -> [UniType] -> InstOrigin -> Inst
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: Id) (u2 :: [UniType]) (u3 :: InstOrigin) -> _!_ _ORIG_ Inst Method [] [u0, u1, u2, u3] _N_ #-}
 instance Outputable Inst
 instance Outputable Inst
-       {-# GHC_PRAGMA _M_ Inst {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Inst) _N_
-        ppr = _A_ 2 _U_ 1222 _N_ _S_ "SS" _N_ _N_ #-}
 
 
index d6bc211..40c55ae 100644 (file)
@@ -4,56 +4,22 @@ import Outputable(ExportFlag, NamedThing, Outputable)
 import PreludePS(_PackedString)
 import SrcLoc(SrcLoc)
 import Unique(Unique)
 import PreludePS(_PackedString)
 import SrcLoc(SrcLoc)
 import Unique(Unique)
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
+data ExportFlag 
+data FullName 
 data Provenance   = ThisModule | InventedInThisModule | ExportedByPreludeCore | OtherPrelude _PackedString | OtherModule _PackedString [_PackedString] | HereInPreludeCore | OtherInstance _PackedString [_PackedString]
 data Provenance   = ThisModule | InventedInThisModule | ExportedByPreludeCore | OtherPrelude _PackedString | OtherModule _PackedString [_PackedString] | HereInPreludeCore | OtherInstance _PackedString [_PackedString]
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data ShortName 
+data SrcLoc 
+data Unique 
 fromPrelude :: _PackedString -> Bool
 fromPrelude :: _PackedString -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 invisibleFullName :: FullName -> Bool
 invisibleFullName :: FullName -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAEA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Bool) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u5; _NO_DEFLT_ } _N_ #-}
 mkFullName :: _PackedString -> _PackedString -> Provenance -> ExportFlag -> SrcLoc -> FullName
 mkFullName :: _PackedString -> _PackedString -> Provenance -> ExportFlag -> SrcLoc -> FullName
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkPreludeCoreName :: _PackedString -> _PackedString -> FullName
 mkPreludeCoreName :: _PackedString -> _PackedString -> FullName
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkPrivateFullName :: _PackedString -> _PackedString -> Provenance -> ExportFlag -> SrcLoc -> FullName
 mkPrivateFullName :: _PackedString -> _PackedString -> Provenance -> ExportFlag -> SrcLoc -> FullName
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkShortName :: _PackedString -> SrcLoc -> ShortName
 mkShortName :: _PackedString -> SrcLoc -> ShortName
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: SrcLoc) -> _!_ _ORIG_ NameTypes ShortName [] [u0, u1] _N_ #-}
 unlocaliseFullName :: FullName -> FullName
 unlocaliseFullName :: FullName -> FullName
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLLALL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 unlocaliseShortName :: _PackedString -> Unique -> ShortName -> FullName
 unlocaliseShortName :: _PackedString -> Unique -> ShortName -> FullName
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LLU(LL)" {_A_ 4 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing FullName
 instance NamedThing FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(FullName -> ExportFlag), (FullName -> Bool), (FullName -> (_PackedString, _PackedString)), (FullName -> _PackedString), (FullName -> [_PackedString]), (FullName -> SrcLoc), (FullName -> Unique), (FullName -> Bool), (FullName -> UniType), (FullName -> Bool)] [_CONSTM_ NamedThing getExportFlag (FullName), _CONSTM_ NamedThing isLocallyDefined (FullName), _CONSTM_ NamedThing getOrigName (FullName), _CONSTM_ NamedThing getOccurrenceName (FullName), _CONSTM_ NamedThing getInformingModules (FullName), _CONSTM_ NamedThing getSrcLoc (FullName), _CONSTM_ NamedThing getTheUnique (FullName), _CONSTM_ NamedThing hasType (FullName), _CONSTM_ NamedThing getType (FullName), _CONSTM_ NamedThing fromPreludeCore (FullName)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAEAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ThisModule  -> _!_ True [] []; _ORIG_ NameTypes InventedInThisModule  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LLAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [u1, u2]; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(ALSAAA)" {_A_ 2 _U_ 11 _N_ _N_ _F_ _IF_ARGS_ 0 2 XC 10 \ (u0 :: _PackedString) (u1 :: Provenance) -> case u1 of { _ALG_ _ORIG_ NameTypes OtherPrelude (u2 :: _PackedString) -> u2; _ORIG_ NameTypes OtherModule (u3 :: _PackedString) (u4 :: [_PackedString]) -> u3; (u5 :: Provenance) -> u0 } _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ExportedByPreludeCore  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 instance NamedThing ShortName
 instance NamedThing ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ShortName -> ExportFlag), (ShortName -> Bool), (ShortName -> (_PackedString, _PackedString)), (ShortName -> _PackedString), (ShortName -> [_PackedString]), (ShortName -> SrcLoc), (ShortName -> Unique), (ShortName -> Bool), (ShortName -> UniType), (ShortName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ShortName), _CONSTM_ NamedThing isLocallyDefined (ShortName), _CONSTM_ NamedThing getOrigName (ShortName), _CONSTM_ NamedThing getOccurrenceName (ShortName), _CONSTM_ NamedThing getInformingModules (ShortName), _CONSTM_ NamedThing getSrcLoc (ShortName), _CONSTM_ NamedThing getTheUnique (ShortName), _CONSTM_ NamedThing hasType (ShortName), _CONSTM_ NamedThing getType (ShortName), _CONSTM_ NamedThing fromPreludeCore (ShortName)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(SA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u1; _NO_DEFLT_ } _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u2; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AA)" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 instance Outputable FullName
 instance Outputable FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FullName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LLLLAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ShortName
 instance Outputable ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ShortName) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AU(LA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index dee7c44..6b8ce70 100644 (file)
@@ -205,7 +205,7 @@ instance NamedThing ShortName where
     getOrigName (ShortName s l)       = (panic "NamedThing.ShortName.getOrigName", s)
     getOccurrenceName (ShortName s l) = s
     getSrcLoc  (ShortName s l)       = l
     getOrigName (ShortName s l)       = (panic "NamedThing.ShortName.getOrigName", s)
     getOccurrenceName (ShortName s l) = s
     getSrcLoc  (ShortName s l)       = l
-    fromPreludeCore (ShortName _ _)   = False
+    fromPreludeCore _                = False
 #ifdef DEBUG
     getTheUnique (ShortName s l)      = panic "NamedThing.ShortName.getTheUnique" 
     getInformingModules a            = panic "NamedThing.ShortName.getInformingModule"
 #ifdef DEBUG
     getTheUnique (ShortName s l)      = panic "NamedThing.ShortName.getTheUnique" 
     getInformingModules a            = panic "NamedThing.ShortName.getInformingModule"
index 43fbd75..5eef390 100644 (file)
@@ -1,14 +1,9 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface OrdList where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface OrdList where
-data OrdList a         {-# GHC_PRAGMA SeqList (OrdList a) (OrdList a) | ParList (OrdList a) (OrdList a) | OrdObj a | NoObj #-}
+data OrdList a 
 flattenOrdList :: OrdList a -> [a]
 flattenOrdList :: OrdList a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkEmptyList :: OrdList a
 mkEmptyList :: OrdList a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ OrdList NoObj [u0] [] _N_ #-}
 mkParList :: OrdList a -> OrdList a -> OrdList a
 mkParList :: OrdList a -> OrdList a -> OrdList a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: OrdList u0) (u2 :: OrdList u0) -> _!_ _ORIG_ OrdList ParList [u0] [u1, u2] _N_ #-}
 mkSeqList :: OrdList a -> OrdList a -> OrdList a
 mkSeqList :: OrdList a -> OrdList a -> OrdList a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: OrdList u0) (u2 :: OrdList u0) -> _!_ _ORIG_ OrdList SeqList [u0] [u1, u2] _N_ #-}
 mkUnitList :: a -> OrdList a
 mkUnitList :: a -> OrdList a
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: u0) -> _!_ _ORIG_ OrdList OrdObj [u0] [u1] _N_ #-}
 
 
index 65a1e01..b295e28 100644 (file)
@@ -1,45 +1,20 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface ProtoName where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface ProtoName where
-import Id(Id)
 import Maybes(Labda)
 import Name(Name)
 import Maybes(Labda)
 import Name(Name)
-import NameTypes(FullName, ShortName)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
-import TyCon(TyCon)
-import Unique(Unique)
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
+data Labda a 
+data Name 
 data ProtoName   = Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name
 cmpByLocalName :: ProtoName -> ProtoName -> Int#
 data ProtoName   = Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name
 cmpByLocalName :: ProtoName -> ProtoName -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 cmpProtoName :: ProtoName -> ProtoName -> Int#
 cmpProtoName :: ProtoName -> ProtoName -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 elemByLocalNames :: ProtoName -> [ProtoName] -> Bool
 elemByLocalNames :: ProtoName -> [ProtoName] -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 elemProtoNames :: ProtoName -> [ProtoName] -> Bool
 elemProtoNames :: ProtoName -> [ProtoName] -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 eqByLocalName :: ProtoName -> ProtoName -> Bool
 eqByLocalName :: ProtoName -> ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 eqProtoName :: ProtoName -> ProtoName -> Bool
 eqProtoName :: ProtoName -> ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 isConopPN :: ProtoName -> Bool
 isConopPN :: ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkPreludeProtoName :: Name -> ProtoName
 mkPreludeProtoName :: Name -> ProtoName
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _!_ _ORIG_ ProtoName Prel [] [u0] _N_ #-}
 instance NamedThing ProtoName
 instance NamedThing ProtoName
-       {-# GHC_PRAGMA _M_ ProtoName {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ProtoName -> ExportFlag), (ProtoName -> Bool), (ProtoName -> (_PackedString, _PackedString)), (ProtoName -> _PackedString), (ProtoName -> [_PackedString]), (ProtoName -> SrcLoc), (ProtoName -> Unique), (ProtoName -> Bool), (ProtoName -> UniType), (ProtoName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ProtoName), _CONSTM_ NamedThing isLocallyDefined (ProtoName), _CONSTM_ NamedThing getOrigName (ProtoName), _CONSTM_ NamedThing getOccurrenceName (ProtoName), _CONSTM_ NamedThing getInformingModules (ProtoName), _CONSTM_ NamedThing getSrcLoc (ProtoName), _CONSTM_ NamedThing getTheUnique (ProtoName), _CONSTM_ NamedThing hasType (ProtoName), _CONSTM_ NamedThing getType (ProtoName), _CONSTM_ NamedThing fromPreludeCore (ProtoName)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: ProtoName) -> case u0 of { _ALG_ _ORIG_ ProtoName Unk (u1 :: _PackedString) -> u1; _ORIG_ ProtoName Imp (u2 :: _PackedString) (u3 :: _PackedString) (u4 :: [_PackedString]) (u5 :: _PackedString) -> u5; _ORIG_ ProtoName Prel (u6 :: Name) -> _APP_  _CONSTM_ NamedThing getOccurrenceName (Name) [ u6 ]; _NO_DEFLT_ } _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ProtoName) -> _!_ False [] [] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_  _TYAPP_  patError# { (ProtoName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-}
 instance Outputable ProtoName
 instance Outputable ProtoName
-       {-# GHC_PRAGMA _M_ ProtoName {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ProtoName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 8466f01..a02cad8 100644 (file)
@@ -1,31 +1,18 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface SplitUniq where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface SplitUniq where
-import Unique(Unique, mkUniqueGrimily)
+import Unique(Unique)
 type SUniqSM a = SplitUniqSupply -> a
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data SplitUniqSupply 
+data Unique 
 getSUnique :: SplitUniqSupply -> Unique
 getSUnique :: SplitUniqSupply -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> case u1 of { _ALG_ I# (u4 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u4]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getSUniqueAndDepleted :: SplitUniqSupply -> (Unique, SplitUniqSupply)
 getSUniqueAndDepleted :: SplitUniqSupply -> (Unique, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)LA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSUniques :: Int -> SplitUniqSupply -> [Unique]
 getSUniques :: Int -> SplitUniqSupply -> [Unique]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)L" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSUniquesAndDepleted :: Int -> SplitUniqSupply -> ([Unique], SplitUniqSupply)
 getSUniquesAndDepleted :: Int -> SplitUniqSupply -> ([Unique], SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 initSUs :: SplitUniqSupply -> (SplitUniqSupply -> a) -> (SplitUniqSupply, a)
 initSUs :: SplitUniqSupply -> (SplitUniqSupply -> a) -> (SplitUniqSupply, a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(ALL)L" {_A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 3 XXX 6 _/\_ u0 -> \ (u1 :: SplitUniqSupply) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply -> u0) -> let {(u4 :: u0) = _APP_  u3 [ u1 ]} in _!_ _TUP_2 [SplitUniqSupply, u0] [u2, u4] _N_} _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: SplitUniqSupply) (u2 :: SplitUniqSupply -> u0) -> case u1 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u3 :: Int) (u4 :: SplitUniqSupply) (u5 :: SplitUniqSupply) -> let {(u6 :: u0) = _APP_  u2 [ u4 ]} in _!_ _TUP_2 [SplitUniqSupply, u0] [u5, u6]; _NO_DEFLT_ } _N_ #-}
 mapAndUnzipSUs :: (a -> SplitUniqSupply -> (b, c)) -> [a] -> SplitUniqSupply -> ([b], [c])
 mapAndUnzipSUs :: (a -> SplitUniqSupply -> (b, c)) -> [a] -> SplitUniqSupply -> ([b], [c])
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 mapSUs :: (a -> SplitUniqSupply -> b) -> [a] -> SplitUniqSupply -> [b]
 mapSUs :: (a -> SplitUniqSupply -> b) -> [a] -> SplitUniqSupply -> [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 mkSplitUniqSupply :: Char -> _State _RealWorld -> (SplitUniqSupply, _State _RealWorld)
 mkSplitUniqSupply :: Char -> _State _RealWorld -> (SplitUniqSupply, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-mkUniqueGrimily :: Int# -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_ #-}
 returnSUs :: a -> SplitUniqSupply -> a
 returnSUs :: a -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _S_ "SL" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: SplitUniqSupply) -> u1 _N_ #-}
 splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
 splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
 thenSUs :: (SplitUniqSupply -> a) -> (a -> SplitUniqSupply -> b) -> SplitUniqSupply -> b
 thenSUs :: (SplitUniqSupply -> a) -> (a -> SplitUniqSupply -> b) -> SplitUniqSupply -> b
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LSS" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: SplitUniqSupply -> u0) (u3 :: u0 -> SplitUniqSupply -> u1) (u4 :: SplitUniqSupply) -> case _APP_  _ORIG_ SplitUniq splitUniqSupply [ u4 ] of { _ALG_ _TUP_2 (u5 :: SplitUniqSupply) (u6 :: SplitUniqSupply) -> let {(u7 :: u0) = _APP_  u2 [ u5 ]} in _APP_  u3 [ u7, u6 ]; _NO_DEFLT_ } _N_ #-}
 
 
index 1bb1a0b..7ed3938 100644 (file)
@@ -2,20 +2,12 @@
 interface SrcLoc where
 import Outputable(Outputable)
 import PreludePS(_PackedString)
 interface SrcLoc where
 import Outputable(Outputable)
 import PreludePS(_PackedString)
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data SrcLoc 
 mkBuiltinSrcLoc :: SrcLoc
 mkBuiltinSrcLoc :: SrcLoc
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkGeneratedSrcLoc :: SrcLoc
 mkGeneratedSrcLoc :: SrcLoc
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkSrcLoc :: _PackedString -> _PackedString -> SrcLoc
 mkSrcLoc :: _PackedString -> _PackedString -> SrcLoc
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _ORIG_ SrcLoc SrcLoc [] [u0, u1] _N_ #-}
 mkSrcLoc2 :: _PackedString -> Int -> SrcLoc
 mkSrcLoc2 :: _PackedString -> Int -> SrcLoc
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: Int#) -> _!_ _ORIG_ SrcLoc SrcLoc2 [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: _PackedString) (u1 :: Int) -> case u1 of { _ALG_ I# (u2 :: Int#) -> _!_ _ORIG_ SrcLoc SrcLoc2 [] [u0, u2]; _NO_DEFLT_ } _N_ #-}
 mkUnknownSrcLoc :: SrcLoc
 mkUnknownSrcLoc :: SrcLoc
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 unpackSrcLoc :: SrcLoc -> (_PackedString, _PackedString)
 unpackSrcLoc :: SrcLoc -> (_PackedString, _PackedString)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance Outputable SrcLoc
 instance Outputable SrcLoc
-       {-# GHC_PRAGMA _M_ SrcLoc {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (SrcLoc) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 
 
index 579615c..2033128 100644 (file)
@@ -8,328 +8,164 @@ import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 infixr 9 `thenUs`
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 infixr 9 `thenUs`
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data CSeq 
+data PrimOp 
+data SplitUniqSupply 
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data Unique 
+data UniqueSupply 
 absentErrorIdKey :: Unique
 absentErrorIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrDataConKey :: Unique
 addrDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrPrimTyConKey :: Unique
 addrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrTyConKey :: Unique
 addrTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 arrayPrimTyConKey :: Unique
 arrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 binaryClassKey :: Unique
 binaryClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 boolTyConKey :: Unique
 boolTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 buildDataConKey :: Unique
 buildDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 buildIdKey :: Unique
 buildIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 byteArrayPrimTyConKey :: Unique
 byteArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cCallableClassKey :: Unique
 cCallableClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cReturnableClassKey :: Unique
 cReturnableClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charDataConKey :: Unique
 charDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charPrimTyConKey :: Unique
 charPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charTyConKey :: Unique
 charTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cmpTagTyConKey :: Unique
 cmpTagTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cmpUnique :: Unique -> Unique -> Int#
 cmpUnique :: Unique -> Unique -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _ALWAYS_ \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> 0#; False  -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> -1#; False  -> 1#; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 consDataConKey :: Unique
 consDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 dialogueTyConKey :: Unique
 dialogueTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleDataConKey :: Unique
 doubleDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doublePrimTyConKey :: Unique
 doublePrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleTyConKey :: Unique
 doubleTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 enumClassKey :: Unique
 enumClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqClassKey :: Unique
 eqClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqTagDataConKey :: Unique
 eqTagDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqUnique :: Unique -> Unique -> Bool
 eqUnique :: Unique -> Unique -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _ALWAYS_ \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 errorIdKey :: Unique
 errorIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 falseDataConKey :: Unique
 falseDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatDataConKey :: Unique
 floatDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatPrimTyConKey :: Unique
 floatPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatTyConKey :: Unique
 floatTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatingClassKey :: Unique
 floatingClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 foldlIdKey :: Unique
 foldlIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 foldrIdKey :: Unique
 foldrIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 forkIdKey :: Unique
 forkIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 fractionalClassKey :: Unique
 fractionalClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 getBuiltinUniques :: Int -> [Unique]
 getBuiltinUniques :: Int -> [Unique]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 getUnique :: UniqueSupply -> (UniqueSupply, Unique)
 getUnique :: UniqueSupply -> (UniqueSupply, Unique)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getUniques :: Int -> UniqueSupply -> (UniqueSupply, [Unique])
 getUniques :: Int -> UniqueSupply -> (UniqueSupply, [Unique])
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)S" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 gtTagDataConKey :: Unique
 gtTagDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 iOTyConKey :: Unique
 iOTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 initUs :: UniqueSupply -> (UniqueSupply -> (UniqueSupply, a)) -> (UniqueSupply, a)
 initUs :: UniqueSupply -> (UniqueSupply -> (UniqueSupply, a)) -> (UniqueSupply, a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: UniqueSupply) (u2 :: UniqueSupply -> (UniqueSupply, u0)) -> _APP_  u2 [ u1 ] _N_ #-}
 intDataConKey :: Unique
 intDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intPrimTyConKey :: Unique
 intPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intTyConKey :: Unique
 intTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerDataConKey :: Unique
 integerDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerMinusOneIdKey :: Unique
 integerMinusOneIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerPlusOneIdKey :: Unique
 integerPlusOneIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerTyConKey :: Unique
 integerTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerZeroIdKey :: Unique
 integerZeroIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integralClassKey :: Unique
 integralClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ixClassKey :: Unique
 ixClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 liftDataConKey :: Unique
 liftDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 liftTyConKey :: Unique
 liftTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 listTyConKey :: Unique
 listTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ltTagDataConKey :: Unique
 ltTagDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mallocPtrDataConKey :: Unique
 mallocPtrDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mallocPtrPrimTyConKey :: Unique
 mallocPtrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mallocPtrTyConKey :: Unique
 mallocPtrTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mapAndUnzipUs :: (a -> UniqueSupply -> (UniqueSupply, (b, c))) -> [a] -> UniqueSupply -> (UniqueSupply, ([b], [c]))
 mapAndUnzipUs :: (a -> UniqueSupply -> (UniqueSupply, (b, c))) -> [a] -> UniqueSupply -> (UniqueSupply, ([b], [c]))
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 mapUs :: (a -> UniqueSupply -> (UniqueSupply, b)) -> [a] -> UniqueSupply -> (UniqueSupply, [b])
 mapUs :: (a -> UniqueSupply -> (UniqueSupply, b)) -> [a] -> UniqueSupply -> (UniqueSupply, [b])
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 mkBuiltinUnique :: Int -> Unique
 mkBuiltinUnique :: Int -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkPrimOpIdUnique :: PrimOp -> Unique
 mkPrimOpIdUnique :: PrimOp -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkPseudoUnique1 :: Int -> Unique
 mkPseudoUnique1 :: Int -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkPseudoUnique2 :: Int -> Unique
 mkPseudoUnique2 :: Int -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkPseudoUnique3 :: Int -> Unique
 mkPseudoUnique3 :: Int -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkTupleDataConUnique :: Int -> Unique
 mkTupleDataConUnique :: Int -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkUnifiableTyVarUnique :: Int -> Unique
 mkUnifiableTyVarUnique :: Int -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkUniqueGrimily :: Int# -> Unique
 mkUniqueGrimily :: Int# -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_ #-}
 mkUniqueSupplyGrimily :: SplitUniqSupply -> UniqueSupply
 mkUniqueSupplyGrimily :: SplitUniqSupply -> UniqueSupply
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: SplitUniqSupply) -> _!_ _ORIG_ Unique MkNewSupply [] [u0] _N_ #-}
 mutableArrayPrimTyConKey :: Unique
 mutableArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mutableByteArrayPrimTyConKey :: Unique
 mutableByteArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 nilDataConKey :: Unique
 nilDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 numClassKey :: Unique
 numClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ordClassKey :: Unique
 ordClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 packCStringIdKey :: Unique
 packCStringIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 parErrorIdKey :: Unique
 parErrorIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 parIdKey :: Unique
 parIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 patErrorIdKey :: Unique
 patErrorIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pprUnique :: Unique -> Int -> Bool -> PrettyRep
 pprUnique :: Unique -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 pprUnique10 :: Unique -> Int -> Bool -> PrettyRep
 pprUnique10 :: Unique -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 primIoTyConKey :: Unique
 primIoTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ratioDataConKey :: Unique
 ratioDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ratioTyConKey :: Unique
 ratioTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 rationalTyConKey :: Unique
 rationalTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realClassKey :: Unique
 realClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realFloatClassKey :: Unique
 realFloatClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realFracClassKey :: Unique
 realFracClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldPrimIdKey :: Unique
 realWorldPrimIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldTyConKey :: Unique
 realWorldTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 return2GMPsDataConKey :: Unique
 return2GMPsDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 return2GMPsTyConKey :: Unique
 return2GMPsTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 returnIntAndGMPDataConKey :: Unique
 returnIntAndGMPDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 returnIntAndGMPTyConKey :: Unique
 returnIntAndGMPTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 returnUs :: a -> UniqueSupply -> (UniqueSupply, a)
 returnUs :: a -> UniqueSupply -> (UniqueSupply, a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: UniqueSupply) -> _!_ _TUP_2 [UniqueSupply, u0] [u2, u1] _N_ #-}
 runBuiltinUs :: (UniqueSupply -> (UniqueSupply, a)) -> a
 runBuiltinUs :: (UniqueSupply -> (UniqueSupply, a)) -> a
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 runSTIdKey :: Unique
 runSTIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 seqIdKey :: Unique
 seqIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 showUnique :: Unique -> _PackedString
 showUnique :: Unique -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 stTyConKey :: Unique
 stTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stablePtrDataConKey :: Unique
 stablePtrDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stablePtrPrimTyConKey :: Unique
 stablePtrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stablePtrTyConKey :: Unique
 stablePtrTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndAddrPrimDataConKey :: Unique
 stateAndAddrPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndAddrPrimTyConKey :: Unique
 stateAndAddrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndArrayPrimDataConKey :: Unique
 stateAndArrayPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndArrayPrimTyConKey :: Unique
 stateAndArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndByteArrayPrimDataConKey :: Unique
 stateAndByteArrayPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndByteArrayPrimTyConKey :: Unique
 stateAndByteArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndCharPrimDataConKey :: Unique
 stateAndCharPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndCharPrimTyConKey :: Unique
 stateAndCharPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndDoublePrimDataConKey :: Unique
 stateAndDoublePrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndDoublePrimTyConKey :: Unique
 stateAndDoublePrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndFloatPrimDataConKey :: Unique
 stateAndFloatPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndFloatPrimTyConKey :: Unique
 stateAndFloatPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndIntPrimDataConKey :: Unique
 stateAndIntPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndIntPrimTyConKey :: Unique
 stateAndIntPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMallocPtrPrimDataConKey :: Unique
 stateAndMallocPtrPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMallocPtrPrimTyConKey :: Unique
 stateAndMallocPtrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMutableArrayPrimDataConKey :: Unique
 stateAndMutableArrayPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMutableArrayPrimTyConKey :: Unique
 stateAndMutableArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMutableByteArrayPrimDataConKey :: Unique
 stateAndMutableByteArrayPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMutableByteArrayPrimTyConKey :: Unique
 stateAndMutableByteArrayPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndPtrPrimDataConKey :: Unique
 stateAndPtrPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndPtrPrimTyConKey :: Unique
 stateAndPtrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndStablePtrPrimDataConKey :: Unique
 stateAndStablePtrPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndStablePtrPrimTyConKey :: Unique
 stateAndStablePtrPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndSynchVarPrimDataConKey :: Unique
 stateAndSynchVarPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndSynchVarPrimTyConKey :: Unique
 stateAndSynchVarPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndWordPrimDataConKey :: Unique
 stateAndWordPrimDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndWordPrimTyConKey :: Unique
 stateAndWordPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateDataConKey :: Unique
 stateDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 statePrimTyConKey :: Unique
 statePrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateTyConKey :: Unique
 stateTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stringTyConKey :: Unique
 stringTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 synchVarPrimTyConKey :: Unique
 synchVarPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 textClassKey :: Unique
 textClassKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 thenUs :: (UniqueSupply -> (UniqueSupply, a)) -> (a -> UniqueSupply -> (UniqueSupply, b)) -> UniqueSupply -> (UniqueSupply, b)
 thenUs :: (UniqueSupply -> (UniqueSupply, a)) -> (a -> UniqueSupply -> (UniqueSupply, b)) -> UniqueSupply -> (UniqueSupply, b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: UniqueSupply -> (UniqueSupply, u0)) (u3 :: u0 -> UniqueSupply -> (UniqueSupply, u1)) (u4 :: UniqueSupply) -> case _APP_  u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: UniqueSupply) (u6 :: u0) -> _APP_  u3 [ u6, u5 ]; _NO_DEFLT_ } _N_ #-}
 traceIdKey :: Unique
 traceIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 trueDataConKey :: Unique
 trueDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 u2i :: Unique -> Int#
 u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 uniqSupply_u :: UniqueSupply
 uniqSupply_u :: UniqueSupply
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+unpackCString2IdKey :: Unique
+unpackCStringAppendIdKey :: Unique
 unpackCStringIdKey :: Unique
 unpackCStringIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 unpkUnifiableTyVarUnique :: Unique -> Int
 unpkUnifiableTyVarUnique :: Unique -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 voidPrimIdKey :: Unique
 voidPrimIdKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 voidPrimTyConKey :: Unique
 voidPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordDataConKey :: Unique
 wordDataConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordPrimTyConKey :: Unique
 wordPrimTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordTyConKey :: Unique
 wordTyConKey :: Unique
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 81e3af1..482b0a4 100644 (file)
@@ -150,7 +150,7 @@ module Unique (
        textClassKey,
        traceIdKey,
        trueDataConKey,
        textClassKey,
        traceIdKey,
        trueDataConKey,
-       unpackCStringIdKey,
+       unpackCStringIdKey, unpackCString2IdKey, unpackCStringAppendIdKey,
        packCStringIdKey,
        integerZeroIdKey, integerPlusOneIdKey, integerMinusOneIdKey,
        voidPrimIdKey,
        packCStringIdKey,
        integerZeroIdKey, integerPlusOneIdKey, integerMinusOneIdKey,
        voidPrimIdKey,
@@ -426,8 +426,8 @@ chars62
 \begin{code}
 mkPreludeClassUnique i         = mkUnique '1' i
 mkPreludeTyConUnique i         = mkUnique '2' i
 \begin{code}
 mkPreludeClassUnique i         = mkUnique '1' i
 mkPreludeTyConUnique i         = mkUnique '2' i
-mkPreludeDataConUnique i       = mkUnique '3' i
-mkTupleDataConUnique i         = mkUnique '4' i
+mkPreludeDataConUnique i       = mkUnique 'Y' i -- must be alphabetic
+mkTupleDataConUnique i         = mkUnique 'Z' i -- ditto (*may* be used in C labels)
 -- mkPrimOpIdUnique op: see below (uses '5')
 mkPreludeMiscIdUnique i                = mkUnique '7' i
 \end{code}
 -- mkPrimOpIdUnique op: see below (uses '5')
 mkPreludeMiscIdUnique i                = mkUnique '7' i
 \end{code}
@@ -632,6 +632,8 @@ seqIdKey            = mkPreludeMiscIdUnique 19
 --UNUSED:showSpaceIdKey                = mkPreludeMiscIdUnique 21
 traceIdKey             = mkPreludeMiscIdUnique 22
 unpackCStringIdKey     = mkPreludeMiscIdUnique 23
 --UNUSED:showSpaceIdKey                = mkPreludeMiscIdUnique 21
 traceIdKey             = mkPreludeMiscIdUnique 22
 unpackCStringIdKey     = mkPreludeMiscIdUnique 23
+unpackCString2IdKey    = mkPreludeMiscIdUnique 20 -- NB: NB: NB
+unpackCStringAppendIdKey= mkPreludeMiscIdUnique        21 -- NB: NB: NB
 voidPrimIdKey          = mkPreludeMiscIdUnique 24
 
 #ifdef GRAN
 voidPrimIdKey          = mkPreludeMiscIdUnique 24
 
 #ifdef GRAN
index 7d11d51..4d4fa91 100644 (file)
@@ -4,85 +4,60 @@ import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelativ
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
-import ClosureInfo(ClosureInfo, LambdaFormInfo, StandardFormInfo)
+import ClosureInfo(ClosureInfo, LambdaFormInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(IdInfo)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
+data AbstractC 
+data CAddrMode 
+data MagicId 
+data BasicLit 
 data CLabel 
 type CgBindings = UniqFM CgIdInfo
 data CgIdInfo   = MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo
 data CLabel 
 type CgBindings = UniqFM CgIdInfo
 data CgIdInfo   = MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data LambdaFormInfo    {-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
+data CgState 
+data LambdaFormInfo 
 data HeapOffset 
 data HeapOffset 
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data StableLoc         {-# GHC_PRAGMA NoStableLoc | VirAStkLoc Int | VirBStkLoc Int | LitLoc BasicLit | StableAmodeLoc CAddrMode #-}
-data StgAtom a         {-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data Labda a 
+data StableLoc 
+data StgAtom a 
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data VolatileLoc       {-# GHC_PRAGMA NoVolatileLoc | TempVarLoc Unique | RegLoc MagicId | VirHpLoc HeapOffset | VirNodeLoc HeapOffset #-}
+data Unique 
+data VolatileLoc 
 bindArgsToRegs :: [Id] -> [MagicId] -> CgInfoDownwards -> CgState -> CgState
 bindArgsToRegs :: [Id] -> [MagicId] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _N_ _N_ #-}
 bindNewPrimToAmode :: Id -> CAddrMode -> CgInfoDownwards -> CgState -> CgState
 bindNewPrimToAmode :: Id -> CAddrMode -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 bindNewToAStack :: (Id, Int) -> CgInfoDownwards -> CgState -> CgState
 bindNewToAStack :: (Id, Int) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 101 _N_ _S_ "U(LL)AU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToBStack :: (Id, Int) -> CgInfoDownwards -> CgState -> CgState
 bindNewToBStack :: (Id, Int) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 101 _N_ _S_ "U(LL)AU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToNode :: Id -> HeapOffset -> LambdaFormInfo -> CgInfoDownwards -> CgState -> CgState
 bindNewToNode :: Id -> HeapOffset -> LambdaFormInfo -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 22201 _N_ _S_ "LLLAU(LLL)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> CgInfoDownwards -> CgState -> CgState
 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 22201 _N_ _S_ "LLLAU(LLL)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToTemp :: Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
 bindNewToTemp :: Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 201 _N_ _N_ _N_ _N_ #-}
 getAtomAmode :: StgAtom Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
 getAtomAmode :: StgAtom Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 getAtomAmodes :: [StgAtom Id] -> CgInfoDownwards -> CgState -> ([CAddrMode], CgState)
 getAtomAmodes :: [StgAtom Id] -> CgInfoDownwards -> CgState -> ([CAddrMode], CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 getCAddrMode :: Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
 getCAddrMode :: Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getCAddrModeAndInfo :: Id -> CgInfoDownwards -> CgState -> ((CAddrMode, LambdaFormInfo), CgState)
 getCAddrModeAndInfo :: Id -> CgInfoDownwards -> CgState -> ((CAddrMode, LambdaFormInfo), CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getCAddrModeIfVolatile :: Id -> CgInfoDownwards -> CgState -> (Labda CAddrMode, CgState)
 getCAddrModeIfVolatile :: Id -> CgInfoDownwards -> CgState -> (Labda CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getVolatileRegs :: UniqFM Id -> CgInfoDownwards -> CgState -> ([MagicId], CgState)
 getVolatileRegs :: UniqFM Id -> CgInfoDownwards -> CgState -> ([MagicId], CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _N_ _N_ _N_ #-}
 heapIdInfo :: Id -> HeapOffset -> LambdaFormInfo -> CgIdInfo
 heapIdInfo :: Id -> HeapOffset -> LambdaFormInfo -> CgIdInfo
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 idInfoToAmode :: PrimKind -> CgIdInfo -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
 idInfoToAmode :: PrimKind -> CgIdInfo -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LU(ASLA)" {_A_ 5 _U_ 21122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 letNoEscapeIdInfo :: Id -> Int -> Int -> LambdaFormInfo -> CgIdInfo
 letNoEscapeIdInfo :: Id -> Int -> Int -> LambdaFormInfo -> CgIdInfo
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 maybeAStkLoc :: StableLoc -> Labda Int
 maybeAStkLoc :: StableLoc -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: StableLoc) -> case u0 of { _ALG_ _ORIG_ CgBindery VirAStkLoc (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; (u2 :: StableLoc) -> _!_ _ORIG_ Maybes Hamna [Int] [] } _N_ #-}
 maybeBStkLoc :: StableLoc -> Labda Int
 maybeBStkLoc :: StableLoc -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: StableLoc) -> case u0 of { _ALG_ _ORIG_ CgBindery VirBStkLoc (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; (u2 :: StableLoc) -> _!_ _ORIG_ Maybes Hamna [Int] [] } _N_ #-}
 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 nukeVolatileBinds :: UniqFM CgIdInfo -> UniqFM CgIdInfo
 nukeVolatileBinds :: UniqFM CgIdInfo -> UniqFM CgIdInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 rebindToAStack :: Id -> Int -> CgInfoDownwards -> CgState -> CgState
 rebindToAStack :: Id -> Int -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rebindToBStack :: Id -> Int -> CgInfoDownwards -> CgState -> CgState
 rebindToBStack :: Id -> Int -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 stableAmodeIdInfo :: Id -> CAddrMode -> LambdaFormInfo -> CgIdInfo
 stableAmodeIdInfo :: Id -> CAddrMode -> LambdaFormInfo -> CgIdInfo
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 
 
index 9a2ce69..e0c05ba 100644 (file)
@@ -6,20 +6,17 @@ import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, EndOfBlockInfo, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CgMonad(CgInfoDownwards, CgState, EndOfBlockInfo, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgCaseDefault, StgExpr)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import Maybes(Labda)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgCaseDefault, StgExpr)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data StgCaseAlternatives a b   {-# GHC_PRAGMA StgAlgAlts UniType [(Id, [a], [Bool], StgExpr a b)] (StgCaseDefault a b) | StgPrimAlts UniType [(BasicLit, StgExpr a b)] (StgCaseDefault a b) #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data CgState 
+data Id 
+data StgCaseAlternatives a b 
+data StgExpr a b 
 cgCase :: StgExpr Id Id -> UniqFM Id -> UniqFM Id -> Unique -> StgCaseAlternatives Id Id -> CgInfoDownwards -> CgState -> CgState
 cgCase :: StgExpr Id Id -> UniqFM Id -> UniqFM Id -> Unique -> StgCaseAlternatives Id Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _S_ "SLLLL" _N_ _N_ #-}
 saveVolatileVarsAndRegs :: UniqFM Id -> CgInfoDownwards -> CgState -> ((AbstractC, EndOfBlockInfo, Labda Int), CgState)
 saveVolatileVarsAndRegs :: UniqFM Id -> CgInfoDownwards -> CgState -> ((AbstractC, EndOfBlockInfo, Labda Int), CgState)
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _N_ _N_ _N_ #-}
 
 
index 1cd7696..17be925 100644 (file)
@@ -190,30 +190,27 @@ cgCase (StgPrimApp op args _) live_in_whole_case live_in_alts uniq alts
        -- Perform the operation
     getVolatileRegs live_in_alts                       `thenFC` \ vol_regs ->
 
        -- Perform the operation
     getVolatileRegs live_in_alts                       `thenFC` \ vol_regs ->
 
-    profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]  `thenC`
-
     absC (COpStmt result_amodes op
                 arg_amodes -- note: no liveness arg
                 liveness_mask vol_regs)                `thenC`
 
     absC (COpStmt result_amodes op
                 arg_amodes -- note: no liveness arg
                 liveness_mask vol_regs)                `thenC`
 
-    profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]  `thenC`
-
        -- Scrutinise the result
     cgInlineAlts NoGC uniq alts
 
   | otherwise  -- *Can* trigger GC
        -- Scrutinise the result
     cgInlineAlts NoGC uniq alts
 
   | otherwise  -- *Can* trigger GC
-  = getPrimOpArgAmodes op args         `thenFC` \ arg_amodes ->
+  = getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
+--NO:  getIntSwitchChkrC       `thenFC` \ isw_chkr   ->
 
        -- Get amodes for the arguments and results, and assign to regs
        -- (Can-trigger-gc primops guarantee to have their (nonRobust)
        --  args in regs)
     let
 
        -- Get amodes for the arguments and results, and assign to regs
        -- (Can-trigger-gc primops guarantee to have their (nonRobust)
        --  args in regs)
     let
-       op_result_regs = assignPrimOpResultRegs op
+       op_result_regs = assignPrimOpResultRegs {-NO:isw_chkr-} op
 
        op_result_amodes = map CReg op_result_regs
 
        (op_arg_amodes, liveness_mask, arg_assts) 
 
        op_result_amodes = map CReg op_result_regs
 
        (op_arg_amodes, liveness_mask, arg_assts) 
-         = makePrimOpArgsRobust op arg_amodes
+         = makePrimOpArgsRobust {-NO:isw_chkr-} op arg_amodes
 
        liveness_arg  = mkIntCLit liveness_mask
     in
 
        liveness_arg  = mkIntCLit liveness_mask
     in
@@ -245,17 +242,13 @@ cgCase (StgPrimApp op args _) live_in_whole_case live_in_alts uniq alts
        
        -- do_op_and_continue will be passed an amode for the continuation
        do_op_and_continue sequel
        
        -- do_op_and_continue will be passed an amode for the continuation
        do_op_and_continue sequel
-          = profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]  `thenC`
-
-           absC (COpStmt op_result_amodes
+          = absC (COpStmt op_result_amodes
                          op
                          (pin_liveness op liveness_arg op_arg_amodes)
                          liveness_mask
                          [{-no vol_regs-}])
                                        `thenC`
 
                          op
                          (pin_liveness op liveness_arg op_arg_amodes)
                          liveness_mask
                          [{-no vol_regs-}])
                                        `thenC`
 
-           profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]  `thenC`
-
             sequelToAmode sequel        `thenFC` \ dest_amode ->
             absC (CReturn dest_amode DirectReturn)
 
             sequelToAmode sequel        `thenFC` \ dest_amode ->
             absC (CReturn dest_amode DirectReturn)
 
@@ -438,6 +431,7 @@ cgEvalAlts :: Maybe VirtualSpBOffset        -- Offset of cost-centre to be restored, if
 cgEvalAlts cc_slot uniq (StgAlgAlts ty alts deflt)
   =    -- Generate the instruction to restore cost centre, if any
     restoreCurrentCostCentre cc_slot   `thenFC` \ cc_restore ->
 cgEvalAlts cc_slot uniq (StgAlgAlts ty alts deflt)
   =    -- Generate the instruction to restore cost centre, if any
     restoreCurrentCostCentre cc_slot   `thenFC` \ cc_restore ->
+    getIntSwitchChkrC                  `thenFC` \ isw_chkr ->
 
        -- Generate sequel info for use downstream
        -- At the moment, we only do it if the type is vector-returnable.
 
        -- Generate sequel info for use downstream
        -- At the moment, we only do it if the type is vector-returnable.
@@ -460,7 +454,7 @@ cgEvalAlts cc_slot uniq (StgAlgAlts ty alts deflt)
          = if not use_labelled_alts then
                Nothing -- no semi-tagging info
            else
          = if not use_labelled_alts then
                Nothing -- no semi-tagging info
            else
-               cgSemiTaggedAlts uniq alts deflt -- Just <something>
+               cgSemiTaggedAlts isw_chkr uniq alts deflt -- Just <something>
     in
     cgAlgAlts GCMayHappen uniq cc_restore use_labelled_alts ty alts deflt
                                        `thenFC` \ (tagged_alt_absCs, deflt_absC) ->
     in
     cgAlgAlts GCMayHappen uniq cc_restore use_labelled_alts ty alts deflt
                                        `thenFC` \ (tagged_alt_absCs, deflt_absC) ->
@@ -587,14 +581,17 @@ It's all pretty turgid anyway.
 \begin{code}
 cgAlgAlts gc_flag uniq restore_cc semi_tagging
        ty alts deflt@(StgBindDefault binder True{-used-} _)
 \begin{code}
 cgAlgAlts gc_flag uniq restore_cc semi_tagging
        ty alts deflt@(StgBindDefault binder True{-used-} _)
-  = forkAlts (map (cgAlgAlt gc_flag uniq restore_cc semi_tagging) alts)
+  = getIntSwitchChkrC  `thenFC` \ isw_chkr ->
+    let
+       extra_branches :: [FCode (ConTag, AbstractC)]
+       extra_branches = catMaybes (map (mk_extra_branch isw_chkr) default_cons)
+
+       must_label_default = semi_tagging || not (null extra_branches)
+    in
+    forkAlts (map (cgAlgAlt gc_flag uniq restore_cc semi_tagging) alts)
             extra_branches
             (cgAlgDefault  gc_flag uniq restore_cc must_label_default deflt)
   where
             extra_branches
             (cgAlgDefault  gc_flag uniq restore_cc must_label_default deflt)
   where
-    extra_branches :: [FCode (ConTag, AbstractC)]
-    extra_branches = catMaybes (map mk_extra_branch default_cons)
-
-    must_label_default = semi_tagging || not (null extra_branches)
 
     default_join_lbl = mkDefaultLabel uniq
     jump_instruction = CJump (CLbl default_join_lbl CodePtrKind)
 
     default_join_lbl = mkDefaultLabel uniq
     jump_instruction = CJump (CLbl default_join_lbl CodePtrKind)
@@ -620,11 +617,11 @@ cgAlgAlts gc_flag uniq restore_cc semi_tagging
     -- nothing to do. Otherwise, we have a special case for a nullary constructor,
     -- but in the general case we do an allocation and heap-check.
 
     -- nothing to do. Otherwise, we have a special case for a nullary constructor,
     -- but in the general case we do an allocation and heap-check.
 
-    mk_extra_branch :: DataCon -> (Maybe (FCode (ConTag, AbstractC)))
+    mk_extra_branch :: IntSwitchChecker -> DataCon -> (Maybe (FCode (ConTag, AbstractC)))
 
 
-    mk_extra_branch con
+    mk_extra_branch isw_chkr con
       = ASSERT(isDataCon con)
       = ASSERT(isDataCon con)
-       case dataReturnConvAlg con of
+       case dataReturnConvAlg isw_chkr con of
          ReturnInHeap    -> Nothing
          ReturnInRegs rs -> Just (getAbsC (alloc_code rs) `thenFC` \ abs_c ->
                                   returnFC (tag, abs_c)
          ReturnInHeap    -> Nothing
          ReturnInRegs rs -> Just (getAbsC (alloc_code rs) `thenFC` \ abs_c ->
                                   returnFC (tag, abs_c)
@@ -728,9 +725,10 @@ cgAlgAlt gc_flag uniq restore_cc must_label_branch (con, args, use_mask, rhs)
 cgAlgAltRhs :: GCFlag -> Id -> [Id] -> [Bool] -> PlainStgExpr -> Code
 
 cgAlgAltRhs gc_flag con args use_mask rhs
 cgAlgAltRhs :: GCFlag -> Id -> [Id] -> [Bool] -> PlainStgExpr -> Code
 
 cgAlgAltRhs gc_flag con args use_mask rhs
-  = let
+  = getIntSwitchChkrC  `thenFC` \ isw_chkr ->
+    let
       (live_regs, node_reqd)
       (live_regs, node_reqd)
-       = case (dataReturnConvAlg con) of
+       = case (dataReturnConvAlg isw_chkr con) of
            ReturnInHeap      -> ([],                                             True)
            ReturnInRegs regs -> ([reg | (reg,True) <- regs `zipEqual` use_mask], False)
                                -- Pick the live registers using the use_mask
            ReturnInHeap      -> ([],                                             True)
            ReturnInRegs regs -> ([reg | (reg,True) <- regs `zipEqual` use_mask], False)
                                -- Pick the live registers using the use_mask
@@ -758,13 +756,14 @@ Turgid-but-non-monadic code to conjure up the required info from
 algebraic case alternatives for semi-tagging.
 
 \begin{code}
 algebraic case alternatives for semi-tagging.
 
 \begin{code}
-cgSemiTaggedAlts :: Unique
+cgSemiTaggedAlts :: IntSwitchChecker
+                -> Unique
                 -> [(Id, [Id], [Bool], PlainStgExpr)]
                 -> StgCaseDefault Id Id
                 -> SemiTaggingStuff
 
                 -> [(Id, [Id], [Bool], PlainStgExpr)]
                 -> StgCaseDefault Id Id
                 -> SemiTaggingStuff
 
-cgSemiTaggedAlts uniq alts deflt
-  = Just (map st_alt alts, st_deflt deflt)
+cgSemiTaggedAlts isw_chkr uniq alts deflt
+  = Just (map (st_alt isw_chkr) alts, st_deflt deflt)
   where
     st_deflt StgNoDefault = Nothing
 
   where
     st_deflt StgNoDefault = Nothing
 
@@ -774,13 +773,14 @@ cgSemiTaggedAlts uniq alts deflt
               mkDefaultLabel uniq)
             )
 
               mkDefaultLabel uniq)
             )
 
-    st_alt (con, args, use_mask, _)
-      = case (dataReturnConvAlg con) of
+    st_alt isw_chkr (con, args, use_mask, _)
+      = case (dataReturnConvAlg isw_chkr con) of
 
          ReturnInHeap ->
            -- Ha!  Nothing to do; Node already points to the thing
            (con_tag,
 
          ReturnInHeap ->
            -- Ha!  Nothing to do; Node already points to the thing
            (con_tag,
-            (CCallProfCtrMacro SLIT("RET_SEMI_IN_HEAP") [], -- ToDo: monadise?
+            (CCallProfCtrMacro SLIT("RET_SEMI_IN_HEAP") -- ToDo: monadise?
+                       [mkIntCLit (length args)], -- how big the thing in the heap is
             join_label)
            )
 
             join_label)
            )
 
@@ -799,7 +799,9 @@ cgSemiTaggedAlts uniq alts deflt
            in
            (con_tag,
             (mkAbstractCs [
            in
            (con_tag,
             (mkAbstractCs [
-               CCallProfCtrMacro SLIT("RET_SEMI_IN_REGS") [], -- ToDo: macroise?
+               CCallProfCtrMacro SLIT("RET_SEMI_IN_REGS")  -- ToDo: macroise?
+                       [mkIntCLit (length regs_w_offsets),
+                        mkIntCLit (length used_regs_w_offsets)],
                CSimultaneous (mkAbstractCs (map move_to_reg used_regs_w_offsets))],
              join_label))
       where
                CSimultaneous (mkAbstractCs (map move_to_reg used_regs_w_offsets))],
              join_label))
       where
@@ -809,7 +811,6 @@ cgSemiTaggedAlts uniq alts deflt
     move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
     move_to_reg (reg, offset)
       = CAssign (CReg reg) (CVal (NodeRel offset) (kindFromMagicId reg))
     move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
     move_to_reg (reg, offset)
       = CAssign (CReg reg) (CVal (NodeRel offset) (kindFromMagicId reg))
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index fcdb52d..36957ad 100644 (file)
@@ -1,14 +1,13 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CgClosure where
 import AbsCSyn(AbstractC)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CgClosure where
 import AbsCSyn(AbstractC)
-import CgBindery(CgIdInfo, StableLoc, VolatileLoc)
+import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, StubFlag)
 import ClosureInfo(LambdaFormInfo)
 import CmdLineOpts(GlobalSwitch)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, StubFlag)
 import ClosureInfo(LambdaFormInfo)
 import CmdLineOpts(GlobalSwitch)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
@@ -16,17 +15,15 @@ import StgSyn(StgAtom, StgBinderInfo, StgBinding, StgCaseAlternatives, StgExpr,
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CgIdInfo  {-# GHC_PRAGMA MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo #-}
-data CgInfoDownwards   {-# GHC_PRAGMA MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data CompilationInfo   {-# GHC_PRAGMA MkCompInfo (GlobalSwitch -> Bool) _PackedString #-}
+data CgIdInfo 
+data CgInfoDownwards 
+data CgState 
+data CompilationInfo 
 data HeapOffset 
 data HeapOffset 
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
-data UpdateFlag        {-# GHC_PRAGMA ReEntrant | Updatable | SingleEntry #-}
+data Id 
+data Labda a 
+data StgExpr a b 
+data UpdateFlag 
 cgRhsClosure :: Id -> CostCentre -> StgBinderInfo -> [Id] -> [Id] -> StgExpr Id Id -> LambdaFormInfo -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
 cgRhsClosure :: Id -> CostCentre -> StgBinderInfo -> [Id] -> [Id] -> StgExpr Id Id -> LambdaFormInfo -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-       {-# GHC_PRAGMA _A_ 7 _U_ 222222222 _N_ _S_ "LLLLLLS" _N_ _N_ #-}
 cgTopRhsClosure :: Id -> CostCentre -> StgBinderInfo -> [Id] -> StgExpr Id Id -> LambdaFormInfo -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
 cgTopRhsClosure :: Id -> CostCentre -> StgBinderInfo -> [Id] -> StgExpr Id Id -> LambdaFormInfo -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-       {-# GHC_PRAGMA _A_ 6 _U_ 22222222 _N_ _N_ _N_ _N_ #-}
 
 
index 93aabe1..677cf2f 100644 (file)
@@ -434,17 +434,13 @@ closureCodeBody binder_info closure_info cc [] body
        pprPanic "closureCodeBody:thunk:prim type!" (ppr PprDebug tycon)
     else
 #endif
        pprPanic "closureCodeBody:thunk:prim type!" (ppr PprDebug tycon)
     else
 #endif
-    getAbsC body_code          `thenFC` \ body_absC ->
-#ifndef DPH
-    moduleName                 `thenFC` \ mod_name ->
-    absC (CClosureInfoAndCode closure_info body_absC Nothing stdUpd (cl_descr mod_name))
-#else
-    -- Applying a similar scheme to Simon's placing info tables before code...
-    -- ToDo:DPH: update
-    absC (CNativeInfoTableAndCode closure_info
-           closure_description
-           (CCodeBlock entry_label body_absC))
-#endif {- Data Parallel Haskell -}
+    getAbsC body_code  `thenFC` \ body_absC ->
+    moduleName         `thenFC` \ mod_name ->
+    getIntSwitchChkrC  `thenFC` \ isw_chkr ->
+
+    absC (CClosureInfoAndCode closure_info body_absC Nothing
+                             stdUpd (cl_descr mod_name)
+                             (dataConLiveness isw_chkr closure_info))
   where
     cl_descr mod_name = closureDescription mod_name (closureId closure_info) [] body
 
   where
     cl_descr mod_name = closureDescription mod_name (closureId closure_info) [] body
 
@@ -580,48 +576,24 @@ closureCodeBody binder_info closure_info cc all_args body
                -- Do the business
            funWrapper closure_info arg_regs (cgExpr body)
     in
                -- Do the business
            funWrapper closure_info arg_regs (cgExpr body)
     in
-#ifndef DPH
        -- Make a labelled code-block for the slow and fast entry code
     forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)              
        -- Make a labelled code-block for the slow and fast entry code
     forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)              
-                                                       `thenFC` \ slow_abs_c ->
-    forkAbsC fast_entry_code                           `thenFC` \ fast_abs_c ->
-    moduleName                                         `thenFC` \ mod_name ->
+                               `thenFC` \ slow_abs_c ->
+    forkAbsC fast_entry_code   `thenFC` \ fast_abs_c ->
+    moduleName                 `thenFC` \ mod_name ->
+    getIntSwitchChkrC          `thenFC` \ isw_chkr ->
+    
        -- Now either construct the info table, or put the fast code in alone
        -- (We never have slow code without an info table)
     absC (
        -- Now either construct the info table, or put the fast code in alone
        -- (We never have slow code without an info table)
     absC (
-      if info_table_needed 
-      then
-        CClosureInfoAndCode closure_info slow_abs_c 
-                            (Just fast_abs_c) stdUpd (cl_descr mod_name)
+      if info_table_needed then
+        CClosureInfoAndCode closure_info slow_abs_c (Just fast_abs_c)
+                       stdUpd (cl_descr mod_name)
+                       (dataConLiveness isw_chkr closure_info)
       else 
        CCodeBlock fast_label fast_abs_c
     )
       else 
        CCodeBlock fast_label fast_abs_c
     )
-
-  where
-#else
-    -- The info table goes before the slow entry point.
-    forkAbsC slow_entry_code                           `thenFC` \ slow_abs_c ->
-    forkAbsC fast_entry_code                           `thenFC` \ fast_abs_c ->
-    moduleName                                         `thenFC` \ mod_name ->
-    absC (CNativeInfoTableAndCode 
-               closure_info 
-               (closureDescription mod_name id all_args body)
-                (CCodeBlock slow_label 
-                  (AbsCStmts slow_abs_c
-                     (CCodeBlock fast_label 
-                                 fast_abs_c))))
   where
   where
-    slow_label = if slow_code_needed then
-                       mkStdEntryLabel id
-                else
-                       mkErrorStdEntryLabel
-                       -- We may need a pointer to stuff in the info table,
-                       -- but if the slow entry code isn't needed, this code
-                       -- will never be entered, so we can use a standard 
-                       -- panic routine.
-
-#endif {- Data Parallel Haskell -}
-
     lf_info = closureLFInfo closure_info
 
     cl_descr mod_name = closureDescription mod_name id all_args body
     lf_info = closureLFInfo closure_info
 
     cl_descr mod_name = closureDescription mod_name id all_args body
@@ -904,8 +876,9 @@ setupUpdate :: ClosureInfo -> Code -> Code  -- Only called for thunks
 
 setupUpdate closure_info code
  = if (closureUpdReqd closure_info) then
 
 setupUpdate closure_info code
  = if (closureUpdReqd closure_info) then
-       link_caf_if_needed              `thenFC` \ update_closure ->
-       pushUpdateFrame update_closure vector code
+       link_caf_if_needed      `thenFC` \ update_closure ->
+       getIntSwitchChkrC       `thenFC` \ isw_chkr ->
+       pushUpdateFrame update_closure (vector isw_chkr) code
    else
        -- Non-updatable thunks still need a resume-cost-centre "update"
        -- frame to be pushed if we are doing evaluation profiling.
    else
        -- Non-updatable thunks still need a resume-cost-centre "update"
        -- frame to be pushed if we are doing evaluation profiling.
@@ -942,17 +915,20 @@ setupUpdate closure_info code
 
    closure_label = mkClosureLabel (closureId closure_info)
 
 
    closure_label = mkClosureLabel (closureId closure_info)
 
-   vector = case (closureType closure_info) of
+   vector isw_chkr
+     = case (closureType closure_info) of
        Nothing -> CReg StdUpdRetVecReg
        Just (spec_tycon, _, spec_datacons) ->
        Nothing -> CReg StdUpdRetVecReg
        Just (spec_tycon, _, spec_datacons) ->
-           case ctrlReturnConvAlg spec_tycon of
+           case (ctrlReturnConvAlg spec_tycon) of
              UnvectoredReturn 1 -> 
                        let
                    spec_data_con = head spec_datacons
                     only_tag = getDataConTag spec_data_con
              UnvectoredReturn 1 -> 
                        let
                    spec_data_con = head spec_datacons
                     only_tag = getDataConTag spec_data_con
-                   direct = case dataReturnConvAlg spec_data_con of
+
+                   direct = case (dataReturnConvAlg isw_chkr spec_data_con) of
                        ReturnInRegs _ -> mkConUpdCodePtrVecLabel spec_tycon only_tag
                        ReturnInHeap   -> mkStdUpdCodePtrVecLabel spec_tycon only_tag
                        ReturnInRegs _ -> mkConUpdCodePtrVecLabel spec_tycon only_tag
                        ReturnInHeap   -> mkStdUpdCodePtrVecLabel spec_tycon only_tag
+
                    vectored = mkStdUpdVecTblLabel spec_tycon
                in
                    CUnVecLbl direct vectored
                    vectored = mkStdUpdVecTblLabel spec_tycon
                in
                    CUnVecLbl direct vectored
index abf7a52..9a75ed2 100644 (file)
@@ -2,93 +2,49 @@
 interface CgCompInfo where
 import AbsCSyn(RegRelative)
 import HeapOffs(HeapOffset)
 interface CgCompInfo where
 import AbsCSyn(RegRelative)
 import HeapOffs(HeapOffset)
-data RegRelative       {-# GHC_PRAGMA HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset #-}
+data RegRelative 
 cON_UF_SIZE :: Int
 cON_UF_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 iND_TAG :: Integer
 iND_TAG :: Integer
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 lIVENESS_R1 :: Int
 lIVENESS_R1 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 lIVENESS_R2 :: Int
 lIVENESS_R2 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 lIVENESS_R3 :: Int
 lIVENESS_R3 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 lIVENESS_R4 :: Int
 lIVENESS_R4 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 lIVENESS_R5 :: Int
 lIVENESS_R5 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [16#] _N_ #-}
 lIVENESS_R6 :: Int
 lIVENESS_R6 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [32#] _N_ #-}
 lIVENESS_R7 :: Int
 lIVENESS_R7 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [64#] _N_ #-}
 lIVENESS_R8 :: Int
 lIVENESS_R8 :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [128#] _N_ #-}
 mAX_Double_REG :: Int
 mAX_Double_REG :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 mAX_FAMILY_SIZE_FOR_VEC_RETURNS :: Int
 mAX_FAMILY_SIZE_FOR_VEC_RETURNS :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 mAX_Float_REG :: Int
 mAX_Float_REG :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 mAX_INTLIKE :: Integer
 mAX_INTLIKE :: Integer
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _#_ int2Integer# [] [16#] _N_ #-}
 mAX_SPEC_ALL_NONPTRS :: Int
 mAX_SPEC_ALL_NONPTRS :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [5#] _N_ #-}
 mAX_SPEC_ALL_PTRS :: Int
 mAX_SPEC_ALL_PTRS :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [12#] _N_ #-}
 mAX_SPEC_MIXED_FIELDS :: Int
 mAX_SPEC_MIXED_FIELDS :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 mAX_SPEC_SELECTEE_SIZE :: Int
 mAX_SPEC_SELECTEE_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [12#] _N_ #-}
 mAX_Vanilla_REG :: Int
 mAX_Vanilla_REG :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 mIN_BIG_TUPLE_SIZE :: Int
 mIN_BIG_TUPLE_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [16#] _N_ #-}
 mIN_INTLIKE :: Integer
 mIN_INTLIKE :: Integer
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mIN_MP_INT_SIZE :: Int
 mIN_MP_INT_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [16#] _N_ #-}
 mIN_SIZE_NonUpdHeapObject :: Int
 mIN_SIZE_NonUpdHeapObject :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 mIN_SIZE_NonUpdStaticHeapObject :: Int
 mIN_SIZE_NonUpdStaticHeapObject :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [0#] _N_ #-}
 mIN_UPD_SIZE :: Int
 mIN_UPD_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 mP_STRUCT_SIZE :: Int
 mP_STRUCT_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 oTHER_TAG :: Integer
 oTHER_TAG :: Integer
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 sCC_CON_UF_SIZE :: Int
 sCC_CON_UF_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 sCC_STD_UF_SIZE :: Int
 sCC_STD_UF_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [5#] _N_ #-}
 sTD_UF_SIZE :: Int
 sTD_UF_SIZE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 spARelToInt :: RegRelative -> Int
 spARelToInt :: RegRelative -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 spBRelToInt :: RegRelative -> Int
 spBRelToInt :: RegRelative -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 uF_COST_CENTRE :: Int
 uF_COST_CENTRE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 uF_RET :: Int
 uF_RET :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [0#] _N_ #-}
 uF_SUA :: Int
 uF_SUA :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 uF_SUB :: Int
 uF_SUB :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 uF_UPDATEE :: Int
 uF_UPDATEE :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 uNFOLDING_CHEAP_OP_COST :: Int
 uNFOLDING_CHEAP_OP_COST :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 uNFOLDING_CON_DISCOUNT_WEIGHT :: Int
 uNFOLDING_CON_DISCOUNT_WEIGHT :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 uNFOLDING_CREATION_THRESHOLD :: Int
 uNFOLDING_CREATION_THRESHOLD :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [30#] _N_ #-}
 uNFOLDING_DEAR_OP_COST :: Int
 uNFOLDING_DEAR_OP_COST :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 uNFOLDING_NOREP_LIT_COST :: Int
 uNFOLDING_NOREP_LIT_COST :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 uNFOLDING_OVERRIDE_THRESHOLD :: Int
 uNFOLDING_OVERRIDE_THRESHOLD :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 uNFOLDING_USE_THRESHOLD :: Int
 uNFOLDING_USE_THRESHOLD :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 
 
index 1ea5e04..56ab598 100644 (file)
@@ -125,7 +125,7 @@ Constants for semi-tagging; the tags associated with the data
 constructors will start at 0 and go up.
 \begin{code}
 oTHER_TAG = (INFO_OTHER_TAG :: Integer)        -- (-1) unevaluated, probably
 constructors will start at 0 and go up.
 \begin{code}
 oTHER_TAG = (INFO_OTHER_TAG :: Integer)        -- (-1) unevaluated, probably
-iND_TAG          = (INFO_IND_TAG   :: Integer) -- (-1) NOT USED, REALLY
+iND_TAG          = (INFO_IND_TAG   :: Integer) -- (-2) NOT USED, REALLY
 \end{code}
 
 Stuff for liveness masks:
 \end{code}
 
 Stuff for liveness masks:
index f90731d..57c0983 100644 (file)
@@ -7,29 +7,22 @@ import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data StgAtom a         {-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
+data CAddrMode 
+data MagicId 
+data CgState 
+data Id 
+data PrimKind 
+data PrimOp 
+data StgAtom a 
 bindConArgs :: Id -> [Id] -> CgInfoDownwards -> CgState -> CgState
 bindConArgs :: Id -> [Id] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 2 _U_ 1222 _N_ _S_ "U(LLLS)L" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 buildDynCon :: Id -> CostCentre -> Id -> [CAddrMode] -> Bool -> CgInfoDownwards -> CgState -> (CgIdInfo, CgState)
 buildDynCon :: Id -> CostCentre -> Id -> [CAddrMode] -> Bool -> CgInfoDownwards -> CgState -> (CgIdInfo, CgState)
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222122 _N_ _S_ "LLLLE" _N_ _N_ #-}
 cgReturnDataCon :: Id -> [CAddrMode] -> Bool -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
 cgReturnDataCon :: Id -> [CAddrMode] -> Bool -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _S_ "LLLLU(LLU(LLS))L" _N_ _N_ #-}
 cgTopRhsCon :: Id -> Id -> [StgAtom Id] -> Bool -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
 cgTopRhsCon :: Id -> Id -> [StgAtom Id] -> Bool -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-       {-# GHC_PRAGMA _A_ 4 _U_ 222022 _N_ _S_ "LLSA" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 05ef0e8..9385827 100644 (file)
@@ -417,7 +417,9 @@ found a $con$.
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
   = ASSERT(isDataCon con)
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
   = ASSERT(isDataCon con)
-    case (dataReturnConvAlg con) of
+    getIntSwitchChkrC  `thenFC` \ isw_chkr ->
+
+    case (dataReturnConvAlg isw_chkr con) of
       ReturnInRegs rs  -> bindArgsToRegs args rs
       ReturnInHeap     ->
          let
       ReturnInRegs rs  -> bindArgsToRegs args rs
       ReturnInHeap     ->
          let
@@ -443,7 +445,8 @@ cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> PlainStgLiveVars -> Code
 
 cgReturnDataCon con amodes all_zero_size_args live_vars
   = ASSERT(isDataCon con)
 
 cgReturnDataCon con amodes all_zero_size_args live_vars
   = ASSERT(isDataCon con)
-    getEndOfBlockInfo          `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
+    getIntSwitchChkrC  `thenFC` \ isw_chkr ->
+    getEndOfBlockInfo  `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
 
     case sequel of
 
 
     case sequel of
 
@@ -480,7 +483,7 @@ cgReturnDataCon con amodes all_zero_size_args live_vars
                -- Ignore the sequel: we've already looked at it above
 
       other_sequel ->  -- The usual case
                -- Ignore the sequel: we've already looked at it above
 
       other_sequel ->  -- The usual case
-           case dataReturnConvAlg con of
+           case (dataReturnConvAlg isw_chkr con) of
 
              ReturnInHeap          ->
                        -- BUILD THE OBJECT IN THE HEAP
 
              ReturnInHeap          ->
                        -- BUILD THE OBJECT IN THE HEAP
@@ -497,16 +500,16 @@ cgReturnDataCon con amodes all_zero_size_args live_vars
                  in
 
                        -- RETURN
                  in
 
                        -- RETURN
-                 profCtrC SLIT("RET_NEW_IN_HEAP") []           `thenC`
+                 profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
 
                  performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 
              ReturnInRegs regs  ->
 
                  performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 
              ReturnInRegs regs  ->
-                 let reg_assts = mkAbstractCs (zipWith move_to_reg amodes regs)
+                 let
+                     reg_assts = mkAbstractCs (zipWith move_to_reg amodes regs)
                      info_lbl  = mkPhantomInfoTableLabel con
                  in
                      info_lbl  = mkPhantomInfoTableLabel con
                  in
---OLD:WDP:94/06          evalCostCentreC "SET_RetCC" [CReg CurCostCentre] `thenC`
-                 profCtrC SLIT("RET_NEW_IN_REGS") []              `thenC`
+                 profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
 
                  performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
   where
 
                  performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
   where
index 9779b1d..e05e367 100644 (file)
@@ -15,10 +15,9 @@ import TCE(TCE(..))
 import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CompilationInfo   {-# GHC_PRAGMA MkCompInfo (GlobalSwitch -> Bool) _PackedString #-}
+data AbstractC 
+data CompilationInfo 
 type TCE = UniqFM TyCon
 type TCE = UniqFM TyCon
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 genStaticConBits :: CompilationInfo -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> AbstractC
 genStaticConBits :: CompilationInfo -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> AbstractC
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _N_ _N_ _N_ #-}
 
 
index b37689f..22bfa73 100644 (file)
@@ -36,7 +36,7 @@ import CgRetConv      ( dataReturnConvAlg, ctrlReturnConvAlg,
 import CgTailCall      ( performReturn, mkStaticAlgReturnCode )
 import CgUsages                ( getHpRelOffset )
 import CLabelInfo      ( mkConEntryLabel, mkStaticConEntryLabel, 
 import CgTailCall      ( performReturn, mkStaticAlgReturnCode )
 import CgUsages                ( getHpRelOffset )
 import CLabelInfo      ( mkConEntryLabel, mkStaticConEntryLabel, 
-                         mkInfoTableLabel,
+                         --UNUSED: mkInfoTableLabel,
                          mkClosureLabel, --UNUSED: mkConUpdCodePtrUnvecLabel,
                          mkConUpdCodePtrVecLabel, mkStdUpdCodePtrVecLabel, 
                          mkStdUpdVecTblLabel, CLabel
                          mkClosureLabel, --UNUSED: mkConUpdCodePtrUnvecLabel,
                          mkConUpdCodePtrVecLabel, mkStdUpdCodePtrVecLabel, 
                          mkStdUpdVecTblLabel, CLabel
@@ -44,7 +44,7 @@ import CLabelInfo     ( mkConEntryLabel, mkStaticConEntryLabel,
 import ClosureInfo     ( layOutStaticClosure, layOutDynCon,
                          closureSizeWithoutFixedHdr, closurePtrsSize,
                          fitsMinUpdSize, mkConLFInfo, layOutPhantomClosure,
 import ClosureInfo     ( layOutStaticClosure, layOutDynCon,
                          closureSizeWithoutFixedHdr, closurePtrsSize,
                          fitsMinUpdSize, mkConLFInfo, layOutPhantomClosure,
-                         infoTableLabelFromCI
+                         infoTableLabelFromCI, dataConLiveness
                        )
 import CmdLineOpts     ( GlobalSwitch(..) )
 import FiniteMap
                        )
 import CmdLineOpts     ( GlobalSwitch(..) )
 import FiniteMap
@@ -177,14 +177,16 @@ genStaticConBits comp_info gen_tycons tycon_specs
                                        (map (mk_upd_label spec_tycon) spec_data_cons)
     ------------------
     mk_upd_label tycon con
                                        (map (mk_upd_label spec_tycon) spec_data_cons)
     ------------------
     mk_upd_label tycon con
-      = case dataReturnConvAlg con of
-         ReturnInRegs _ -> CLbl (mkConUpdCodePtrVecLabel tycon tag) CodePtrKind
-         ReturnInHeap   -> CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrKind
+      = CLbl
+        (case (dataReturnConvAlg isw_chkr con) of
+         ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
+         ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag)
+       CodePtrKind
       where
        tag = getDataConTag con
 
     ------------------
       where
        tag = getDataConTag con
 
     ------------------
-    (MkCompInfo sw_chkr _) = comp_info
+    (MkCompInfo sw_chkr isw_chkr _) = comp_info
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -199,22 +201,16 @@ static closure, for a constructor.
 \begin{code}
 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
 
 \begin{code}
 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
 
-genConInfo comp_info tycon data_con
+genConInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con
   = mkAbstractCs [
   = mkAbstractCs [
-#ifndef DPH
                  CSplitMarker,
                  inregs_upd_maybe,
                  closure_code,
                  static_code,
                  CSplitMarker,
                  inregs_upd_maybe,
                  closure_code,
                  static_code,
-#else
-                 info_table,
-                 CSplitMarker,
-                 static_info_table,
-#endif {- Data Parallel Haskell -}
                  closure_maybe]
        -- Order of things is to reduce forward references
   where
                  closure_maybe]
        -- Order of things is to reduce forward references
   where
-    (closure_info, body_code) = mkConCodeAndInfo data_con
+    (closure_info, body_code) = mkConCodeAndInfo isw_chkr data_con
 
     -- To allow the debuggers, interpreters, etc to cope with static
     -- data structures (ie those built at compile time), we take care that
 
     -- To allow the debuggers, interpreters, etc to cope with static
     -- data structures (ie those built at compile time), we take care that
@@ -228,9 +224,12 @@ genConInfo comp_info tycon data_con
     entry_addr = CLbl entry_label CodePtrKind
     con_descr  = _UNPK_ (getOccurrenceName data_con)
 
     entry_addr = CLbl entry_label CodePtrKind
     con_descr  = _UNPK_ (getOccurrenceName data_con)
 
-#ifndef DPH
-    closure_code        = CClosureInfoAndCode closure_info body Nothing stdUpd con_descr
-    static_code         = CClosureInfoAndCode static_ci body Nothing stdUpd con_descr
+    closure_code        = CClosureInfoAndCode closure_info body Nothing
+                                             stdUpd con_descr
+                                             (dataConLiveness isw_chkr closure_info)
+    static_code         = CClosureInfoAndCode static_ci body Nothing
+                                             stdUpd con_descr
+                                             (dataConLiveness isw_chkr static_ci)
 
     inregs_upd_maybe    = genPhantomUpdInfo comp_info tycon data_con
 
 
     inregs_upd_maybe    = genPhantomUpdInfo comp_info tycon data_con
 
@@ -238,13 +237,6 @@ genConInfo comp_info tycon data_con
 
     tag                        = getDataConTag data_con
 
 
     tag                        = getDataConTag data_con
 
-#else
-    info_table         
-      = CNativeInfoTableAndCode closure_info con_descr entry_code
-    static_info_table  
-      = CNativeInfoTableAndCode static_ci con_descr (CJump entry_addr)
-#endif {- Data Parallel Haskell -}
-
     cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
 
     -- For zero-arity data constructors, or, more accurately,
     cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
 
     -- For zero-arity data constructors, or, more accurately,
@@ -269,11 +261,12 @@ genConInfo comp_info tycon data_con
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-mkConCodeAndInfo :: Id                         -- Data constructor
+mkConCodeAndInfo :: IntSwitchChecker
+                -> Id                  -- Data constructor
                 -> (ClosureInfo, Code) -- The info table
 
                 -> (ClosureInfo, Code) -- The info table
 
-mkConCodeAndInfo con
-  = case (dataReturnConvAlg con) of
+mkConCodeAndInfo isw_chkr con
+  = case (dataReturnConvAlg isw_chkr con) of
 
     ReturnInRegs regs ->
        let
 
     ReturnInRegs regs ->
        let
@@ -281,10 +274,7 @@ mkConCodeAndInfo con
              = layOutDynCon con kindFromMagicId regs
 
            body_code
              = layOutDynCon con kindFromMagicId regs
 
            body_code
-             = -- OLD: We don't set CC when entering data any more (WDP 94/06)
-               -- lexCostCentreC "ENTER_CC_DCL" [CReg node]            `thenC`
-               -- evalCostCentreC "SET_RetCC_CL" [CReg node]           `thenC`
-               profCtrC SLIT("RET_OLD_IN_REGS") []                     `thenC`
+             = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
 
                performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
                              (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 
                performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
                              (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
@@ -296,13 +286,13 @@ mkConCodeAndInfo con
        let
            (_, _, arg_tys, _) = getDataConSig con
 
        let
            (_, _, arg_tys, _) = getDataConSig con
 
-           (closure_info, _)
+           (closure_info, arg_things)
                = layOutDynCon con kindFromType arg_tys
 
            body_code
                = -- OLD: We don't set CC when entering data any more (WDP 94/06)
                  -- lexCostCentreC "ENTER_CC_DCL" [CReg node]          `thenC`
                = layOutDynCon con kindFromType arg_tys
 
            body_code
                = -- OLD: We don't set CC when entering data any more (WDP 94/06)
                  -- lexCostCentreC "ENTER_CC_DCL" [CReg node]          `thenC`
-                 profCtrC SLIT("RET_OLD_IN_HEAP") []                   `thenC`
+                 profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
 
                  performReturn AbsCNop -- Ptr to thing already in Node
                                (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 
                  performReturn AbsCNop -- Ptr to thing already in Node
                                (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
@@ -327,15 +317,20 @@ Generate the "phantom" info table and update code, iff the constructor returns i
 \begin{code}
 
 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
 \begin{code}
 
 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
-genPhantomUpdInfo comp_info tycon data_con 
-  = case dataReturnConvAlg data_con of
 
 
-      ReturnInHeap -> AbsCNop  -- No need for a phantom update
+genPhantomUpdInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con 
+  = case (dataReturnConvAlg isw_chkr data_con) of
+
+      ReturnInHeap -> --OLD: pprTrace "NoPhantom: " (ppr PprDebug data_con) $
+                     AbsCNop   -- No need for a phantom update
 
       ReturnInRegs regs -> 
 
       ReturnInRegs regs -> 
+       --OLD: pprTrace "YesPhantom! " (ppr PprDebug data_con) $
+       let 
+            phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
+                               upd_code con_descr
+                               (dataConLiveness isw_chkr phantom_ci)
 
 
-        let 
-            phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing upd_code con_descr
             phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
       
             con_descr = _UNPK_ (getOccurrenceName data_con)
             phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
       
             con_descr = _UNPK_ (getOccurrenceName data_con)
@@ -371,7 +366,9 @@ genPhantomUpdInfo comp_info tycon data_con
 
 
            -- Code for building a new constructor in place over the updatee
 
 
            -- Code for building a new constructor in place over the updatee
-                   overwrite_code = profCtrC SLIT("UPD_CON_IN_PLACE") []       `thenC`
+                   overwrite_code
+             = profCtrC SLIT("UPD_CON_IN_PLACE")
+                        [mkIntCLit (length regs_w_offsets)]    `thenC`
                absC (mkAbstractCs 
                  [
                    CAssign (CReg node) updatee,
                absC (mkAbstractCs 
                  [
                    CAssign (CReg node) updatee,
@@ -396,8 +393,9 @@ genPhantomUpdInfo comp_info tycon data_con
                                else UPD_INPLACE_PTRS
 
            -- Code for allocating a new constructor in the heap
                                else UPD_INPLACE_PTRS
 
            -- Code for allocating a new constructor in the heap
-           alloc_code = 
-               let amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
+           alloc_code
+             = let
+                   amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
                in
                    -- Allocate and build closure specifying upd_new_w_regs
                    allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
                in
                    -- Allocate and build closure specifying upd_new_w_regs
                    allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
@@ -406,13 +404,13 @@ genPhantomUpdInfo comp_info tycon data_con
                    let
                        amode = CAddr hp_rel
                    in
                    let
                        amode = CAddr hp_rel
                    in
-                       profCtrC SLIT("UPD_CON_IN_NEW") [] `thenC`
-                       absC (mkAbstractCs 
-                         [
-                           CMacroStmt UPD_IND [updatee, amode],
-                           CAssign (CReg node) amode,
-                           CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
-                          ])
+                   profCtrC SLIT("UPD_CON_IN_NEW")
+                            [mkIntCLit (length amodes_w_offsets)] `thenC`
+                   absC (mkAbstractCs 
+                     [ CMacroStmt UPD_IND [updatee, amode],
+                       CAssign (CReg node) amode,
+                       CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
+                     ])
 
             (closure_info, regs_w_offsets) = layOutDynCon data_con kindFromMagicId regs
             info_label = infoTableLabelFromCI closure_info
 
             (closure_info, regs_w_offsets) = layOutDynCon data_con kindFromMagicId regs
             info_label = infoTableLabelFromCI closure_info
index 6d21c17..1167fd3 100644 (file)
@@ -5,20 +5,16 @@ import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgExpr)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgExpr)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data CgState 
+data Id 
+data StgExpr a b 
 cgExpr :: StgExpr Id Id -> CgInfoDownwards -> CgState -> CgState
 cgExpr :: StgExpr Id Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 cgSccExpr :: StgExpr Id Id -> CgInfoDownwards -> CgState -> CgState
 cgSccExpr :: StgExpr Id Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 getPrimOpArgAmodes :: PrimOp -> [StgAtom Id] -> CgInfoDownwards -> CgState -> ([CAddrMode], CgState)
 getPrimOpArgAmodes :: PrimOp -> [StgAtom Id] -> CgInfoDownwards -> CgState -> ([CAddrMode], CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 1222 _N_ _S_ "SL" _N_ _N_ #-}
 
 
index 5974df6..a8dbbfe 100644 (file)
@@ -98,10 +98,10 @@ Here is where we insert real live machine instructions.
 
 \begin{code}
 cgExpr x@(StgPrimApp op args live_vars)
 
 \begin{code}
 cgExpr x@(StgPrimApp op args live_vars)
-  = -- trace ("cgExpr:PrimApp:"++(ppShow 80 (ppr PprDebug x))) (
-    getPrimOpArgAmodes op args                 `thenFC` \ arg_amodes ->
+  = getIntSwitchChkrC          `thenFC` \ isw_chkr ->
+    getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
     let
     let
-       result_regs   = assignPrimOpResultRegs op
+       result_regs   = assignPrimOpResultRegs {-NO:isw_chkr-} op
        result_amodes = map CReg result_regs
        may_gc  = primOpCanTriggerGC op
        dyn_tag = head result_amodes
        result_amodes = map CReg result_regs
        may_gc  = primOpCanTriggerGC op
        dyn_tag = head result_amodes
@@ -113,19 +113,16 @@ cgExpr x@(StgPrimApp op args live_vars)
        -- (Can-trigger-gc primops guarantee to have their args in regs)
        let
            (arg_robust_amodes, liveness_mask, arg_assts) 
        -- (Can-trigger-gc primops guarantee to have their args in regs)
        let
            (arg_robust_amodes, liveness_mask, arg_assts) 
-             = makePrimOpArgsRobust op arg_amodes
+             = makePrimOpArgsRobust {-NO:isw_chkr-} op arg_amodes
 
            liveness_arg = mkIntCLit liveness_mask
        in
        returnFC (
            arg_assts,
 
            liveness_arg = mkIntCLit liveness_mask
        in
        returnFC (
            arg_assts,
-           mkAbstractCs [
-             spat_prim_macro,
-             COpStmt result_amodes op
-                     (pin_liveness op liveness_arg arg_robust_amodes)
-                     liveness_mask
-                     [{-no vol_regs-}],
-             spat_prim_stop_macro ]
+           COpStmt result_amodes op
+                   (pin_liveness op liveness_arg arg_robust_amodes)
+                   liveness_mask
+                   [{-no vol_regs-}]
        )
      else
        -- Use args from their current amodes.
        )
      else
        -- Use args from their current amodes.
@@ -133,13 +130,8 @@ cgExpr x@(StgPrimApp op args live_vars)
          liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
        in
        returnFC (
          liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
        in
        returnFC (
---       DO NOT want CCallProfMacros in CSimultaneous stuff.  Yurgh.  (WDP 95/01)
---             Arises in compiling PreludeGlaST (and elsewhere??)
---       mkAbstractCs [
---         spat_prim_macro,
            COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
            COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
---         spat_prim_stop_macro ],
-         AbsCNop
+           AbsCNop
        )
     )                          `thenFC` \ (do_before_stack_cleanup,
                                             do_just_before_jump) ->
        )
     )                          `thenFC` \ (do_before_stack_cleanup,
                                             do_just_before_jump) ->
@@ -157,7 +149,7 @@ cgExpr x@(StgPrimApp op args live_vars)
 
        ReturnsAlg tycon ->
 --OLD:     evalCostCentreC "SET_RetCC" [CReg CurCostCentre]    `thenC` 
 
        ReturnsAlg tycon ->
 --OLD:     evalCostCentreC "SET_RetCC" [CReg CurCostCentre]    `thenC` 
-           profCtrC SLIT("RET_NEW_IN_REGS") []                 `thenC`
+           profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields]    `thenC`
 
            performReturn do_before_stack_cleanup
                          (\ sequel -> robustifySequel may_gc sequel
 
            performReturn do_before_stack_cleanup
                          (\ sequel -> robustifySequel may_gc sequel
@@ -189,12 +181,20 @@ cgExpr x@(StgPrimApp op args live_vars)
                                dyn_tag DataPtrKind
 
                data_con = head (getTyConDataCons tycon)
                                dyn_tag DataPtrKind
 
                data_con = head (getTyConDataCons tycon)
-               dir_lbl  = case dataReturnConvAlg data_con of
-                               ReturnInRegs _ -> CLbl (mkPhantomInfoTableLabel data_con) 
-                                                      DataPtrKind
-                               ReturnInHeap   -> panic "CgExpr: can't return prim in heap"
-                                         -- Never used, and no point in generating
-                                         -- the code for it!
+
+               (dir_lbl, num_of_fields)
+                 = case (dataReturnConvAlg fake_isw_chkr data_con) of
+                     ReturnInRegs rs
+                       -> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrKind,
+--OLD:                     pprTrace "CgExpr:prim datacon:" (ppr PprDebug data_con) $
+                           mkIntCLit (length rs)) -- for ticky-ticky only
+
+                     ReturnInHeap
+                       -> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con)
+                         -- Never used, and no point in generating
+                         -- the code for it!
+
+               fake_isw_chkr x = Nothing
   where
     -- for all PrimOps except ccalls, we pin the liveness info
     -- on as the first "argument"
   where
     -- for all PrimOps except ccalls, we pin the liveness info
     -- on as the first "argument"
@@ -212,10 +212,6 @@ cgExpr x@(StgPrimApp op args live_vars)
        sequelToAmode sequel                    `thenFC` \ amode ->
        returnFC (CAssign (CReg RetReg) amode, InRetReg)
     robustifySequel _ sequel = returnFC (AbsCNop, sequel)
        sequelToAmode sequel                    `thenFC` \ amode ->
        returnFC (CAssign (CReg RetReg) amode, InRetReg)
     robustifySequel _ sequel = returnFC (AbsCNop, sequel)
-    
-    spat_prim_macro     = CCallProfCtrMacro SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]
-    spat_prim_stop_macro = CCallProfCtrMacro SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]
-
 \end{code}
 
 %********************************************************
 \end{code}
 
 %********************************************************
index 43aa7cb..5098bba 100644 (file)
@@ -5,29 +5,23 @@ import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CLabelInfo(CLabel)
 import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
-import ClosureInfo(ClosureInfo, LambdaFormInfo)
+import ClosureInfo(ClosureInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
-import SMRep(SMRep)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data ClosureInfo       {-# GHC_PRAGMA MkClosureInfo Id LambdaFormInfo SMRep #-}
+data AbstractC 
+data CAddrMode 
+data CgState 
+data ClosureInfo 
 data HeapOffset 
 data HeapOffset 
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 allocDynClosure :: ClosureInfo -> CAddrMode -> CAddrMode -> [(CAddrMode, HeapOffset)] -> CgInfoDownwards -> CgState -> (HeapOffset, CgState)
 allocDynClosure :: ClosureInfo -> CAddrMode -> CAddrMode -> [(CAddrMode, HeapOffset)] -> CgInfoDownwards -> CgState -> (HeapOffset, CgState)
-       {-# GHC_PRAGMA _A_ 4 _U_ 222111 _N_ _N_ _N_ _N_ #-}
 allocHeap :: HeapOffset -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
 allocHeap :: HeapOffset -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LLU(LLU(LLU(LL)))" {_A_ 5 _U_ 21222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 heapCheck :: [MagicId] -> Bool -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 heapCheck :: [MagicId] -> Bool -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 22221 _N_ _S_ "LLLLU(LLU(LLL))" _N_ _N_ #-}
 
 
index 8f5b0c4..0da1a6f 100644 (file)
@@ -8,5 +8,4 @@ import Maybes(Labda)
 import StgSyn(StgBinderInfo, StgExpr)
 import UniqFM(UniqFM)
 cgLetNoEscapeClosure :: Id -> CostCentre -> StgBinderInfo -> UniqFM Id -> EndOfBlockInfo -> Labda Int -> [Id] -> StgExpr Id Id -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
 import StgSyn(StgBinderInfo, StgExpr)
 import UniqFM(UniqFM)
 cgLetNoEscapeClosure :: Id -> CostCentre -> StgBinderInfo -> UniqFM Id -> EndOfBlockInfo -> Labda Int -> [Id] -> StgExpr Id Id -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-       {-# GHC_PRAGMA _A_ 8 _U_ 2002202212 _N_ _S_ "LAALLALL" {_A_ 5 _U_ 2222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index abc1e11..be887ae 100644 (file)
@@ -22,7 +22,7 @@ import CgHeapery      ( heapCheck )
 import CgRetConv       ( assignRegs )
 import CgStackery      ( mkVirtStkOffsets )
 import CgUsages                ( setRealAndVirtualSps, getVirtSps )
 import CgRetConv       ( assignRegs )
 import CgStackery      ( mkVirtStkOffsets )
 import CgUsages                ( setRealAndVirtualSps, getVirtSps )
-import CLabelInfo      ( mkFastEntryLabel )
+import CLabelInfo      ( mkStdEntryLabel )
 import ClosureInfo     ( mkLFLetNoEscape )
 import Id              ( getIdKind )
 import Util
 import ClosureInfo     ( mkLFLetNoEscape )
 import Id              ( getIdKind )
 import Util
@@ -151,7 +151,7 @@ cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot a
        (forkAbsC (cgLetNoEscapeBody args body)) 
                                        `thenFC` \ (vA, vB, code) ->
     let
        (forkAbsC (cgLetNoEscapeBody args body)) 
                                        `thenFC` \ (vA, vB, code) ->
     let
-       label = mkFastEntryLabel binder arity
+       label = mkStdEntryLabel binder -- arity
     in
     absC (CCodeBlock label code) `thenC` 
     returnFC (binder, letNoEscapeIdInfo binder vA vB lf_info)
     in
     absC (CCodeBlock label code) `thenC` 
     returnFC (binder, letNoEscapeIdInfo binder vA vB lf_info)
@@ -163,10 +163,11 @@ cgLetNoEscapeBody :: [Id]         -- Args
                  -> Code
 
 cgLetNoEscapeBody all_args rhs
                  -> Code
 
 cgLetNoEscapeBody all_args rhs
-  = getVirtSps                         `thenFC` \ (vA, vB) ->
+  = getVirtSps         `thenFC` \ (vA, vB) ->
+    getIntSwitchChkrC  `thenFC` \ isw_chkr ->
     let
        arg_kinds       = map getIdKind all_args
     let
        arg_kinds       = map getIdKind all_args
-       (arg_regs, _)   = assignRegs [{-nothing live-}] arg_kinds
+       (arg_regs, _)   = assignRegs isw_chkr [{-nothing live-}] arg_kinds
        stk_args        = drop (length arg_regs) all_args
 
        -- stk_args is the args which are passed on the stack at the fast-entry point
        stk_args        = drop (length arg_regs) all_args
 
        -- stk_args is the args which are passed on the stack at the fast-entry point
index 73a974e..e6fd6fd 100644 (file)
@@ -4,206 +4,105 @@ import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelativ
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgBindings(..), CgIdInfo, StableLoc, VolatileLoc, heapIdInfo, stableAmodeIdInfo)
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgBindings(..), CgIdInfo, StableLoc, VolatileLoc, heapIdInfo, stableAmodeIdInfo)
-import ClosureInfo(ClosureInfo, LambdaFormInfo, StandardFormInfo)
+import ClosureInfo(ClosureInfo, LambdaFormInfo)
 import CmdLineOpts(GlobalSwitch)
 import CmdLineOpts(GlobalSwitch)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
+import CostCentre(CostCentre, IsCafCC)
 import HeapOffs(HeapOffset, VirtualHeapOffset(..), VirtualSpAOffset(..), VirtualSpBOffset(..))
 import HeapOffs(HeapOffset, VirtualHeapOffset(..), VirtualSpAOffset(..), VirtualSpBOffset(..))
-import Id(DataCon(..), Id, IdDetails)
+import Id(DataCon(..), Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(IdInfo)
 import Maybes(Labda)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(PlainStgLiveVars(..))
 import Maybes(Labda)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(PlainStgLiveVars(..))
-import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 infixr 9 `thenC`
 infixr 9 `thenFC`
 type AStackUsage = (Int, [(Int, StubFlag)], Int, Int)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 infixr 9 `thenC`
 infixr 9 `thenFC`
 type AStackUsage = (Int, [(Int, StubFlag)], Int, Int)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
+data AbstractC 
 type BStackUsage = (Int, [Int], Int, Int)
 type BStackUsage = (Int, [Int], Int, Int)
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
+data CAddrMode 
 data CLabel 
 type CgBindings = UniqFM CgIdInfo
 data CLabel 
 type CgBindings = UniqFM CgIdInfo
-data CgIdInfo  {-# GHC_PRAGMA MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo #-}
+data CgIdInfo 
 data CgInfoDownwards   = MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo
 data CgState   = MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))
 type Code = CgInfoDownwards -> CgState -> CgState
 data CgInfoDownwards   = MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo
 data CgState   = MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))
 type Code = CgInfoDownwards -> CgState -> CgState
-data CompilationInfo   = MkCompInfo (GlobalSwitch -> Bool) _PackedString
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
+data CompilationInfo   = MkCompInfo (GlobalSwitch -> Bool) ((Int -> GlobalSwitch) -> Labda Int) _PackedString
+data CostCentre 
 data EndOfBlockInfo   = EndOfBlockInfo Int Int Sequel
 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
 data EndOfBlockInfo   = EndOfBlockInfo Int Int Sequel
 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data GlobalSwitch 
 data HeapOffset 
 type HeapUsage = (HeapOffset, HeapOffset)
 data HeapOffset 
 type HeapUsage = (HeapOffset, HeapOffset)
-data LambdaFormInfo    {-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
-data IsCafCC   {-# GHC_PRAGMA IsCafCC | IsNotCafCC #-}
+type IntSwitchChecker = (Int -> GlobalSwitch) -> Labda Int
+data LambdaFormInfo 
+data IsCafCC 
 type SemiTaggingStuff = Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel)))
 data Sequel   = InRetReg | OnStack Int | UpdateCode CAddrMode | CaseAlts CAddrMode (Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel))))
 type SemiTaggingStuff = Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel)))
 data Sequel   = InRetReg | OnStack Int | UpdateCode CAddrMode | CaseAlts CAddrMode (Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel))))
-data StubFlag  {-# GHC_PRAGMA Stubbed | NotStubbed #-}
+data StubFlag 
 type VirtualHeapOffset = HeapOffset
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 type DataCon = Id
 type VirtualHeapOffset = HeapOffset
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 type DataCon = Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 type PlainStgLiveVars = UniqFM Id
 type PlainStgLiveVars = UniqFM Id
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 absC :: AbstractC -> CgInfoDownwards -> CgState -> CgState
 absC :: AbstractC -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addBindC :: Id -> CgIdInfo -> CgInfoDownwards -> CgState -> CgState
 addBindC :: Id -> CgIdInfo -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 1201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addBindsC :: [(Id, CgIdInfo)] -> CgInfoDownwards -> CgState -> CgState
 addBindsC :: [(Id, CgIdInfo)] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 101 _N_ _S_ "LAU(LLL)" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addFreeBSlots :: [Int] -> [Int] -> [Int]
 addFreeBSlots :: [Int] -> [Int] -> [Int]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 costCentresC :: _PackedString -> [CAddrMode] -> CgInfoDownwards -> CgState -> CgState
 costCentresC :: _PackedString -> [CAddrMode] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2211 _N_ _S_ "LLU(U(SA)AA)U(LLL)" {_A_ 4 _U_ 2211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 costCentresFlag :: CgInfoDownwards -> CgState -> (Bool, CgState)
 costCentresFlag :: CgInfoDownwards -> CgState -> (Bool, CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(LA)AA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fixC :: (a -> CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> (a, CgState)
 fixC :: (a -> CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> (a, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 forkAbsC :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> (AbstractC, CgState)
 forkAbsC :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> (AbstractC, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 forkAlts :: [CgInfoDownwards -> CgState -> (a, CgState)] -> [CgInfoDownwards -> CgState -> (a, CgState)] -> (CgInfoDownwards -> CgState -> (b, CgState)) -> CgInfoDownwards -> CgState -> (([a], b), CgState)
 forkAlts :: [CgInfoDownwards -> CgState -> (a, CgState)] -> [CgInfoDownwards -> CgState -> (a, CgState)] -> (CgInfoDownwards -> CgState -> (b, CgState)) -> CgInfoDownwards -> CgState -> (([a], b), CgState)
-       {-# GHC_PRAGMA _A_ 5 _U_ 11122 _N_ _N_ _N_ _N_ #-}
 forkClosureBody :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 forkClosureBody :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(LLA)U(LLL)" {_A_ 4 _U_ 1221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 forkEval :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> (Sequel, CgState)) -> CgInfoDownwards -> CgState -> (EndOfBlockInfo, CgState)
 forkEval :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> (Sequel, CgState)) -> CgInfoDownwards -> CgState -> (EndOfBlockInfo, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 21112 _N_ _N_ _N_ _N_ #-}
 forkEvalHelp :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> ((Int, Int, a), CgState)
 forkEvalHelp :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> ((Int, Int, a), CgState)
-       {-# GHC_PRAGMA _A_ 5 _U_ 21112 _N_ _S_ "LLLU(LLA)L" _N_ _N_ #-}
 forkStatics :: (CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> (a, CgState)
 forkStatics :: (CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> (a, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(LAA)U(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getAbsC :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> (AbstractC, CgState)
 getAbsC :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> (AbstractC, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getEndOfBlockInfo :: CgInfoDownwards -> CgState -> (EndOfBlockInfo, CgState)
 getEndOfBlockInfo :: CgInfoDownwards -> CgState -> (EndOfBlockInfo, CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAL)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: EndOfBlockInfo) (u1 :: CgState) -> _!_ _TUP_2 [EndOfBlockInfo, CgState] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> case u0 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u2 :: CompilationInfo) (u3 :: UniqFM CgIdInfo) (u4 :: EndOfBlockInfo) -> _!_ _TUP_2 [EndOfBlockInfo, CgState] [u4, u1]; _NO_DEFLT_ } _N_ #-}
+getIntSwitchChkrC :: CgInfoDownwards -> CgState -> ((Int -> GlobalSwitch) -> Labda Int, CgState)
 getUnstubbedAStackSlots :: Int -> CgInfoDownwards -> CgState -> ([Int], CgState)
 getUnstubbedAStackSlots :: Int -> CgInfoDownwards -> CgState -> ([Int], CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(U(LLLL)LL))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 heapIdInfo :: Id -> HeapOffset -> LambdaFormInfo -> CgIdInfo
 heapIdInfo :: Id -> HeapOffset -> LambdaFormInfo -> CgIdInfo
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 initC :: CompilationInfo -> (CgInfoDownwards -> CgState -> CgState) -> AbstractC
 initC :: CompilationInfo -> (CgInfoDownwards -> CgState -> CgState) -> AbstractC
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 isStringSwitchSetC :: ([Char] -> GlobalSwitch) -> CgInfoDownwards -> CgState -> (Bool, CgState)
 isStringSwitchSetC :: ([Char] -> GlobalSwitch) -> CgInfoDownwards -> CgState -> (Bool, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "LU(U(LA)AA)L" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isStubbed :: StubFlag -> Bool
 isStubbed :: StubFlag -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: StubFlag) -> case u0 of { _ALG_ _ORIG_ CgMonad Stubbed  -> _!_ True [] []; _ORIG_ CgMonad NotStubbed  -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 isSwitchSetC :: GlobalSwitch -> CgInfoDownwards -> CgState -> (Bool, CgState)
 isSwitchSetC :: GlobalSwitch -> CgInfoDownwards -> CgState -> (Bool, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LU(U(LA)AA)L" {_A_ 3 _U_ 212 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 6 \ (u0 :: GlobalSwitch) (u1 :: GlobalSwitch -> Bool) (u2 :: CgState) -> let {(u3 :: Bool) = _APP_  u1 [ u0 ]} in _!_ _TUP_2 [Bool, CgState] [u3, u2] _N_} _F_ _ALWAYS_ \ (u0 :: GlobalSwitch) (u1 :: CgInfoDownwards) (u2 :: CgState) -> case u1 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u3 :: CompilationInfo) (u4 :: UniqFM CgIdInfo) (u5 :: EndOfBlockInfo) -> case u3 of { _ALG_ _ORIG_ CgMonad MkCompInfo (u6 :: GlobalSwitch -> Bool) (u7 :: _PackedString) -> let {(u8 :: Bool) = _APP_  u6 [ u0 ]} in _!_ _TUP_2 [Bool, CgState] [u8, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 listCs :: [CgInfoDownwards -> CgState -> CgState] -> CgInfoDownwards -> CgState -> CgState
 listCs :: [CgInfoDownwards -> CgState -> CgState] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 listFCs :: [CgInfoDownwards -> CgState -> (a, CgState)] -> CgInfoDownwards -> CgState -> ([a], CgState)
 listFCs :: [CgInfoDownwards -> CgState -> (a, CgState)] -> CgInfoDownwards -> CgState -> ([a], CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 lookupBindC :: Id -> CgInfoDownwards -> CgState -> (CgIdInfo, CgState)
 lookupBindC :: Id -> CgInfoDownwards -> CgState -> (CgIdInfo, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(ALA)U(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mapCs :: (a -> CgInfoDownwards -> CgState -> CgState) -> [a] -> CgInfoDownwards -> CgState -> CgState
 mapCs :: (a -> CgInfoDownwards -> CgState -> CgState) -> [a] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LSLL" _N_ _N_ #-}
 mapFCs :: (a -> CgInfoDownwards -> CgState -> (b, CgState)) -> [a] -> CgInfoDownwards -> CgState -> ([b], CgState)
 mapFCs :: (a -> CgInfoDownwards -> CgState -> (b, CgState)) -> [a] -> CgInfoDownwards -> CgState -> ([b], CgState)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LSLL" _N_ _N_ #-}
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> CgInfoDownwards -> CgState -> CgState
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 1201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 moduleName :: CgInfoDownwards -> CgState -> (_PackedString, CgState)
 moduleName :: CgInfoDownwards -> CgState -> (_PackedString, CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(AL)AA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: CgState) -> _!_ _TUP_2 [_PackedString, CgState] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CX 5 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> case u0 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u2 :: CompilationInfo) (u3 :: UniqFM CgIdInfo) (u4 :: EndOfBlockInfo) -> case u2 of { _ALG_ _ORIG_ CgMonad MkCompInfo (u5 :: GlobalSwitch -> Bool) (u6 :: _PackedString) -> _!_ _TUP_2 [_PackedString, CgState] [u6, u1]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 noBlackHolingFlag :: CgInfoDownwards -> CgState -> (Bool, CgState)
 noBlackHolingFlag :: CgInfoDownwards -> CgState -> (Bool, CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(LA)AA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 nopC :: CgInfoDownwards -> CgState -> CgState
 nopC :: CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLL)" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: AbstractC) (u1 :: UniqFM CgIdInfo) (u2 :: ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))) -> _!_ _ORIG_ CgMonad MkCgState [] [u0, u1, u2] _N_} _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> u1 _N_ #-}
 nukeDeadBindings :: UniqFM Id -> CgInfoDownwards -> CgState -> CgState
 nukeDeadBindings :: UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(U(LLLL)U(LLLL)L))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 profCtrC :: _PackedString -> [CAddrMode] -> CgInfoDownwards -> CgState -> CgState
 profCtrC :: _PackedString -> [CAddrMode] -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2211 _N_ _S_ "LLU(U(SA)AA)U(LLL)" {_A_ 4 _U_ 2211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnFC :: a -> CgInfoDownwards -> CgState -> (a, CgState)
 returnFC :: a -> CgInfoDownwards -> CgState -> (a, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: CgInfoDownwards) (u3 :: CgState) -> _!_ _TUP_2 [u0, CgState] [u1, u3] _N_ #-}
 sequelToAmode :: Sequel -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
 sequelToAmode :: Sequel -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "SAL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setEndOfBlockInfo :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 setEndOfBlockInfo :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2112 _N_ _S_ "LSU(LLA)L" {_A_ 5 _U_ 21222 _N_ _N_ _F_ _IF_ARGS_ 0 5 XXXXX 8 \ (u0 :: EndOfBlockInfo) (u1 :: CgInfoDownwards -> CgState -> CgState) (u2 :: CompilationInfo) (u3 :: UniqFM CgIdInfo) (u4 :: CgState) -> let {(u5 :: CgInfoDownwards) = _!_ _ORIG_ CgMonad MkCgInfoDown [] [u2, u3, u0]} in _APP_  u1 [ u5, u4 ] _N_} _F_ _ALWAYS_ \ (u0 :: EndOfBlockInfo) (u1 :: CgInfoDownwards -> CgState -> CgState) (u2 :: CgInfoDownwards) (u3 :: CgState) -> case u2 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u4 :: CompilationInfo) (u5 :: UniqFM CgIdInfo) (u6 :: EndOfBlockInfo) -> let {(u7 :: CgInfoDownwards) = _!_ _ORIG_ CgMonad MkCgInfoDown [] [u4, u5, u0]} in _APP_  u1 [ u7, u3 ]; _NO_DEFLT_ } _N_ #-}
 stableAmodeIdInfo :: Id -> CAddrMode -> LambdaFormInfo -> CgIdInfo
 stableAmodeIdInfo :: Id -> CAddrMode -> LambdaFormInfo -> CgIdInfo
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 thenC :: (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> a) -> CgInfoDownwards -> CgState -> a
 thenC :: (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> a) -> CgInfoDownwards -> CgState -> a
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "LSLL" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: CgInfoDownwards -> CgState -> CgState) (u2 :: CgInfoDownwards -> CgState -> u0) (u3 :: CgInfoDownwards) (u4 :: CgState) -> let {(u5 :: CgState) = _APP_  u1 [ u3, u4 ]} in _APP_  u2 [ u3, u5 ] _N_ #-}
 thenFC :: (CgInfoDownwards -> CgState -> (a, CgState)) -> (a -> CgInfoDownwards -> CgState -> b) -> CgInfoDownwards -> CgState -> b
 thenFC :: (CgInfoDownwards -> CgState -> (a, CgState)) -> (a -> CgInfoDownwards -> CgState -> b) -> CgInfoDownwards -> CgState -> b
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "LSLL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: CgInfoDownwards -> CgState -> (u0, CgState)) (u3 :: u0 -> CgInfoDownwards -> CgState -> u1) (u4 :: CgInfoDownwards) (u5 :: CgState) -> let {(u6 :: (u0, CgState)) = _APP_  u2 [ u4, u5 ]} in let {(u9 :: u0) = case u6 of { _ALG_ _TUP_2 (u7 :: u0) (u8 :: CgState) -> u7; _NO_DEFLT_ }} in let {(uc :: CgState) = case u6 of { _ALG_ _TUP_2 (ua :: u0) (ub :: CgState) -> ub; _NO_DEFLT_ }} in _APP_  u3 [ u9, u4, uc ] _N_ #-}
 instance Eq CLabel
 instance Eq CLabel
-       {-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool)] [_CONSTM_ Eq (==) (CLabel), _CONSTM_ Eq (/=) (CLabel)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq GlobalSwitch
 instance Eq GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool)] [_CONSTM_ Eq (==) (GlobalSwitch), _CONSTM_ Eq (/=) (GlobalSwitch)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord CLabel
 instance Ord CLabel
-       {-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq CLabel}}, (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> _CMP_TAG)] [_DFUN_ Eq (CLabel), _CONSTM_ Ord (<) (CLabel), _CONSTM_ Ord (<=) (CLabel), _CONSTM_ Ord (>=) (CLabel), _CONSTM_ Ord (>) (CLabel), _CONSTM_ Ord max (CLabel), _CONSTM_ Ord min (CLabel), _CONSTM_ Ord _tagCmp (CLabel)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord GlobalSwitch
 instance Ord GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq GlobalSwitch}}, (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> _CMP_TAG)] [_DFUN_ Eq (GlobalSwitch), _CONSTM_ Ord (<) (GlobalSwitch), _CONSTM_ Ord (<=) (GlobalSwitch), _CONSTM_ Ord (>=) (GlobalSwitch), _CONSTM_ Ord (>) (GlobalSwitch), _CONSTM_ Ord max (GlobalSwitch), _CONSTM_ Ord min (GlobalSwitch), _CONSTM_ Ord _tagCmp (GlobalSwitch)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index ce063c8..2090787 100644 (file)
@@ -36,7 +36,7 @@ module CgMonad (
 --     addFreeASlots,  -- no need to export it
        addFreeBSlots,  -- ToDo: Belong elsewhere
 
 --     addFreeASlots,  -- no need to export it
        addFreeBSlots,  -- ToDo: Belong elsewhere
 
-       isSwitchSetC, isStringSwitchSetC,
+       isSwitchSetC, isStringSwitchSetC, getIntSwitchChkrC,
 
        noBlackHolingFlag,
        profCtrC, --UNUSED: concurrentC,
 
        noBlackHolingFlag,
        profCtrC, --UNUSED: concurrentC,
@@ -50,7 +50,7 @@ module CgMonad (
        CgBindings(..),
        CgInfoDownwards(..), CgState(..),       -- non-abstract
        CgIdInfo, -- abstract
        CgBindings(..),
        CgInfoDownwards(..), CgState(..),       -- non-abstract
        CgIdInfo, -- abstract
-       CompilationInfo(..),
+       CompilationInfo(..), IntSwitchChecker(..),
        GlobalSwitch, -- abstract
 
        stableAmodeIdInfo, heapIdInfo,
        GlobalSwitch, -- abstract
 
        stableAmodeIdInfo, heapIdInfo,
@@ -111,8 +111,11 @@ data CompilationInfo
   = MkCompInfo
        (GlobalSwitch -> Bool)
                        -- use it to look up whatever we like in command-line flags
   = MkCompInfo
        (GlobalSwitch -> Bool)
                        -- use it to look up whatever we like in command-line flags
+       IntSwitchChecker-- similar; for flags that have an Int assoc.
+                       -- with them, notably number of regs available.
        FAST_STRING     -- the module name
        FAST_STRING     -- the module name
-               
+
+type IntSwitchChecker = (Int -> GlobalSwitch) -> Maybe Int
 
 data CgState
   = MkCgState
 
 data CgState
   = MkCgState
@@ -599,17 +602,22 @@ nothing.
 \begin{code}
 isSwitchSetC :: GlobalSwitch -> FCode Bool
 
 \begin{code}
 isSwitchSetC :: GlobalSwitch -> FCode Bool
 
-isSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+isSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr switch, state)
 
 isStringSwitchSetC :: (String -> GlobalSwitch) -> FCode Bool
 
   = (sw_chkr switch, state)
 
 isStringSwitchSetC :: (String -> GlobalSwitch) -> FCode Bool
 
-isStringSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+isStringSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr (switch (panic "isStringSwitchSetC")), state)
 
   = (sw_chkr (switch (panic "isStringSwitchSetC")), state)
 
+getIntSwitchChkrC :: FCode IntSwitchChecker
+
+getIntSwitchChkrC (MkCgInfoDown (MkCompInfo _ isw_chkr _) _ _) state
+  = (isw_chkr, state)
+
 costCentresC :: FAST_STRING -> [CAddrMode] -> Code
 
 costCentresC :: FAST_STRING -> [CAddrMode] -> Code
 
-costCentresC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
+costCentresC macro args (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _)
                        state@(MkCgState absC binds usage)
   = if sw_chkr SccProfilingOn
     then MkCgState (mkAbsCStmts absC (CCallProfCCMacro macro args)) binds usage
                        state@(MkCgState absC binds usage)
   = if sw_chkr SccProfilingOn
     then MkCgState (mkAbsCStmts absC (CCallProfCCMacro macro args)) binds usage
@@ -617,7 +625,7 @@ costCentresC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
 
 profCtrC :: FAST_STRING -> [CAddrMode] -> Code
 
 
 profCtrC :: FAST_STRING -> [CAddrMode] -> Code
 
-profCtrC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
+profCtrC macro args (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _)
                        state@(MkCgState absC binds usage)
   = if not (sw_chkr DoTickyProfiling)
     then state
                        state@(MkCgState absC binds usage)
   = if not (sw_chkr DoTickyProfiling)
     then state
@@ -635,7 +643,7 @@ profCtrC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
 {- UNUSED, as it happens:
 concurrentC :: AbstractC -> Code
 
 {- UNUSED, as it happens:
 concurrentC :: AbstractC -> Code
 
-concurrentC more_absC (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
+concurrentC more_absC (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _)
                        state@(MkCgState absC binds usage)
   = if not (sw_chkr ForConcurrent)
     then state
                        state@(MkCgState absC binds usage)
   = if not (sw_chkr ForConcurrent)
     then state
@@ -661,17 +669,17 @@ getAbsC code info_down (MkCgState absC binds usage)
 \begin{code}
 noBlackHolingFlag, costCentresFlag :: FCode Bool
 
 \begin{code}
 noBlackHolingFlag, costCentresFlag :: FCode Bool
 
-noBlackHolingFlag (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+noBlackHolingFlag (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr OmitBlackHoling, state)
 
   = (sw_chkr OmitBlackHoling, state)
 
-costCentresFlag          (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+costCentresFlag          (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr SccProfilingOn, state)
 \end{code}
 
 \begin{code}
 
 moduleName :: FCode FAST_STRING
   = (sw_chkr SccProfilingOn, state)
 \end{code}
 
 \begin{code}
 
 moduleName :: FCode FAST_STRING
-moduleName (MkCgInfoDown (MkCompInfo _ mod_name) _ _) state
+moduleName (MkCgInfoDown (MkCompInfo _ _ mod_name) _ _) state
   = (mod_name, state)
 
 \end{code}
   = (mod_name, state)
 
 \end{code}
index f722d30..dd4b59d 100644 (file)
@@ -2,38 +2,25 @@
 interface CgRetConv where
 import AbsCSyn(AbstractC, CAddrMode, MagicId)
 import CLabelInfo(CLabel)
 interface CgRetConv where
 import AbsCSyn(AbstractC, CAddrMode, MagicId)
 import CLabelInfo(CLabel)
-import Class(Class)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import CmdLineOpts(GlobalSwitch)
+import Id(Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import TyCon(TyCon)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
-import Unique(Unique)
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data MagicId 
 data CLabel 
 data CtrlReturnConvention   = VectoredReturn Int | UnvectoredReturn Int
 data DataReturnConvention   = ReturnInHeap | ReturnInRegs [MagicId]
 data CLabel 
 data CtrlReturnConvention   = VectoredReturn Int | UnvectoredReturn Int
 data DataReturnConvention   = ReturnInHeap | ReturnInRegs [MagicId]
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
+data Id 
+data PrimKind 
+data TyCon 
 assignPrimOpResultRegs :: PrimOp -> [MagicId]
 assignPrimOpResultRegs :: PrimOp -> [MagicId]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-assignRegs :: [MagicId] -> [PrimKind] -> ([MagicId], [PrimKind])
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
+assignRegs :: ((Int -> GlobalSwitch) -> Labda Int) -> [MagicId] -> [PrimKind] -> ([MagicId], [PrimKind])
 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-dataReturnConvAlg :: Id -> DataReturnConvention
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+dataReturnConvAlg :: ((Int -> GlobalSwitch) -> Labda Int) -> Id -> DataReturnConvention
 dataReturnConvPrim :: PrimKind -> MagicId
 dataReturnConvPrim :: PrimKind -> MagicId
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "E" _N_ _N_ #-}
 makePrimOpArgsRobust :: PrimOp -> [CAddrMode] -> ([CAddrMode], Int, AbstractC)
 makePrimOpArgsRobust :: PrimOp -> [CAddrMode] -> ([CAddrMode], Int, AbstractC)
-       {-# GHC_PRAGMA _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkLiveRegsBitMask :: [MagicId] -> Int
 mkLiveRegsBitMask :: [MagicId] -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 noLiveRegsMask :: Int
 noLiveRegsMask :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [0#] _N_ #-}
 
 
index 9b6a130..679b7c0 100644 (file)
@@ -30,7 +30,7 @@ module CgRetConv (
 import AbsCSyn
 
 import AbsPrel         ( PrimOp(..), PrimOpResultInfo(..), primOpCanTriggerGC,
 import AbsCSyn
 
 import AbsPrel         ( PrimOp(..), PrimOpResultInfo(..), primOpCanTriggerGC,
-                         getPrimOpResultInfo, PrimKind
+                         getPrimOpResultInfo, integerDataCon, PrimKind
                          IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
                          IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
                        )
                          IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
                          IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
                        )
@@ -41,7 +41,8 @@ import AbsUniType     ( getTyConFamilySize, kindFromType, getTyConDataCons,
                          IF_ATTACK_PRAGMAS(COMMA cmpUniType)
                        )
 import CgCompInfo      -- various things
                          IF_ATTACK_PRAGMAS(COMMA cmpUniType)
                        )
 import CgCompInfo      -- various things
-
+import CgMonad         ( IntSwitchChecker(..) )
+import CmdLineOpts     ( GlobalSwitch(..) )
 import Id              ( Id, getDataConSig, fIRST_TAG, isDataCon,
                          DataCon(..), ConTag(..)
                        )
 import Id              ( Id, getDataConSig, fIRST_TAG, isDataCon,
                          DataCon(..), ConTag(..)
                        )
@@ -88,6 +89,7 @@ The register assignment given by a @ReturnInRegs@ obeys three rules:
 
 \begin{code}
 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 
 \begin{code}
 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
+
 ctrlReturnConvAlg tycon
   = case (getTyConFamilySize tycon) of
       Nothing -> -- pprPanic "ctrlReturnConvAlg:" (ppr PprDebug tycon)
 ctrlReturnConvAlg tycon
   = case (getTyConFamilySize tycon) of
       Nothing -> -- pprPanic "ctrlReturnConvAlg:" (ppr PprDebug tycon)
@@ -111,17 +113,28 @@ types.    If @assign_reg@ runs out of a particular kind of register,
 then it gives up, returning @ReturnInHeap@.
 
 \begin{code}
 then it gives up, returning @ReturnInHeap@.
 
 \begin{code}
-dataReturnConvAlg :: DataCon -> DataReturnConvention
+dataReturnConvAlg :: IntSwitchChecker -> DataCon -> DataReturnConvention
 
 
-dataReturnConvAlg data_con
+dataReturnConvAlg isw_chkr data_con
   = ASSERT(isDataCon data_con)
     case leftover_kinds of
        []    ->        ReturnInRegs reg_assignment
        other ->        ReturnInHeap    -- Didn't fit in registers
   where
     (_, _, arg_tys, _) = getDataConSig data_con
   = ASSERT(isDataCon data_con)
     case leftover_kinds of
        []    ->        ReturnInRegs reg_assignment
        other ->        ReturnInHeap    -- Didn't fit in registers
   where
     (_, _, arg_tys, _) = getDataConSig data_con
-    (reg_assignment, leftover_kinds) = assignRegs [node,infoptr] 
-                                                 (map kindFromType arg_tys)
+
+    (reg_assignment, leftover_kinds)
+      = assignRegs isw_chkr_to_use
+                  [node, infoptr] -- taken...
+                  (map kindFromType arg_tys)
+    isw_chkr_to_use = isw_chkr
+{-OLD:
+      = if is_prim_result_ty {-and therefore *ignore* any return-in-regs threshold-}
+       then \ x -> Nothing
+       else isw_chkr
+-}
+    is_prim_result_ty = data_con == integerDataCon -- ***HACK***! (WDP 95/11)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
@@ -213,7 +226,7 @@ dataReturnConvPrim kind         = DataReg kind 2 -- Don't Hog a Modifier reg.
 
 \begin{code}
 assignPrimOpResultRegs
 
 \begin{code}
 assignPrimOpResultRegs
-    :: PrimOp  -- The constructors in canonical order
+    :: PrimOp          -- The constructors in canonical order
     -> [MagicId]       -- The return regs all concatenated to together,
                        -- (*including* one for the tag if necy)
 
     -> [MagicId]       -- The return regs all concatenated to together,
                        -- (*including* one for the tag if necy)
 
@@ -222,18 +235,23 @@ assignPrimOpResultRegs op
 
        ReturnsPrim kind -> [dataReturnConvPrim kind]
 
 
        ReturnsPrim kind -> [dataReturnConvPrim kind]
 
-       ReturnsAlg tycon -> let cons        = getTyConDataCons tycon
-                               result_regs = concat (map get_return_regs cons)
-                           in
-                               -- Since R1 is dead, it can hold the tag if necessary
-                           case cons of
-                               [_]   -> result_regs
-                               other -> (VanillaReg IntKind ILIT(1)) : result_regs
+       ReturnsAlg tycon
+         -> let
+               cons        = getTyConDataCons tycon
+               result_regs = concat (map get_return_regs cons)
+            in
+            -- As R1 is dead, it can hold the tag if necessary
+            case cons of
+               [_]   -> result_regs
+               other -> (VanillaReg IntKind ILIT(1)) : result_regs
+  where
+    get_return_regs con
+      = case (dataReturnConvAlg fake_isw_chkr con) of
+         ReturnInRegs regs -> regs
+         ReturnInHeap      -> panic "getPrimOpAlgResultRegs"
 
 
- where
-   get_return_regs con = case (dataReturnConvAlg con) of
-                             ReturnInHeap      -> panic "getPrimOpAlgResultRegs"
-                             ReturnInRegs regs -> regs
+    fake_isw_chkr :: IntSwitchChecker
+    fake_isw_chkr x = Nothing
 \end{code}
 
 @assignPrimOpArgsRobust@ is used only for primitive ops which may
 \end{code}
 
 @assignPrimOpArgsRobust@ is used only for primitive ops which may
@@ -263,24 +281,28 @@ makePrimOpArgsRobust op arg_amodes
        non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
        arg_kinds = map getAmodeKind non_robust_amodes
 
        non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
        arg_kinds = map getAmodeKind non_robust_amodes
 
-       (arg_regs, extra_args) = assignRegs [{-nothing live-}] arg_kinds
+       (arg_regs, extra_args)
+         = assignRegs fake_isw_chkr [{-nothing live-}] arg_kinds
 
                -- Check that all the args fit before returning arg_regs
        final_arg_regs = case extra_args of
                           []    -> arg_regs
                           other -> error ("Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?) " ++ ppShow 80 (ppr PprDebug op))
 
 
                -- Check that all the args fit before returning arg_regs
        final_arg_regs = case extra_args of
                           []    -> arg_regs
                           other -> error ("Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?) " ++ ppShow 80 (ppr PprDebug op))
 
-       arg_assts = mkAbstractCs (zipWith assign_to_reg arg_regs non_robust_amodes)
+       arg_assts = mkAbstractCs (zipWith assign_to_reg final_arg_regs non_robust_amodes)
        assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 
        safe_arg regs arg 
                | amodeCanSurviveGC arg = (regs, arg) 
                | otherwise             = (tail regs, CReg (head regs))
        assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 
        safe_arg regs arg 
                | amodeCanSurviveGC arg = (regs, arg) 
                | otherwise             = (tail regs, CReg (head regs))
-       safe_amodes = snd (mapAccumL safe_arg arg_regs arg_amodes)
+       safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
 
 
-       liveness_mask = mkLiveRegsBitMask arg_regs
+       liveness_mask = mkLiveRegsBitMask final_arg_regs
     in
     (safe_amodes, liveness_mask, arg_assts)
     in
     (safe_amodes, liveness_mask, arg_assts)
+  where
+    fake_isw_chkr :: IntSwitchChecker
+    fake_isw_chkr x = Nothing
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -297,15 +319,15 @@ any further registers (even though we might have run out of only one kind of
 register); we just return immediately with the left-overs specified.
 
 \begin{code}
 register); we just return immediately with the left-overs specified.
 
 \begin{code}
-assignRegs  :: [MagicId]       -- Unavailable registers
+assignRegs  :: IntSwitchChecker
+           -> [MagicId]        -- Unavailable registers
            -> [PrimKind]       -- Arg or result kinds to assign
            -> ([MagicId],      -- Register assignment in same order
                                -- for *initial segment of* input list
                [PrimKind])-- leftover kinds
 
            -> [PrimKind]       -- Arg or result kinds to assign
            -> ([MagicId],      -- Register assignment in same order
                                -- for *initial segment of* input list
                [PrimKind])-- leftover kinds
 
-#ifndef DPH
-assignRegs regs_in_use kinds
- = assign_reg kinds [] (mkRegTbl regs_in_use)
+assignRegs isw_chkr regs_in_use kinds
+ = assign_reg kinds [] (mkRegTbl isw_chkr regs_in_use)
  where
 
     assign_reg :: [PrimKind]  -- arg kinds being scrutinized
  where
 
     assign_reg :: [PrimKind]  -- arg kinds being scrutinized
@@ -333,53 +355,6 @@ assignRegs regs_in_use kinds
     --  or, I suppose,
     --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
     assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
     --  or, I suppose,
     --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
     assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
-#else
-assignRegs node_using_Ret1 kinds
- = if node_using_Ret1
-   then assign_reg kinds [] (tail vanillaRegNos) (tail datRegNos)
-   else assign_reg kinds [] vanillaRegNos        (tail datRegNos)
- where
-    assign_reg:: [PrimKind]  -- arg kinds being scrutinized
-             -> [MagicId]        -- accum. regs assigned so far (reversed)
-             -> [Int]     -- Vanilla Regs (ptr, int, char, float or double)
-             -> [Int]     -- Data Regs    (     int, char, float or double)
-             -> ([MagicId], [PrimKind])
-
-    assign_reg (k:ks) acc (IBOX(p):ptr_regs) dat_regs
-      | isFollowableKind k      
-      = assign_reg ks (VanillaReg k p:acc) ptr_regs dat_regs
-
-    assign_reg (CharKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg CharKind d:acc) ptr_regs dat_regs
-
-    assign_reg (IntKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg IntKind d:acc) ptr_regs dat_regs
-
-    assign_reg (WordKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg WordKind d:acc) ptr_regs dat_regs
-
-    assign_reg (AddrKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg AddrKind d:acc) ptr_regs dat_regs
-
-    assign_reg (FloatKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg FloatKind d:acc) ptr_regs dat_regs
-
-    -- Notice how doubles take up two data registers....
-    assign_reg (DoubleKind:ks)   acc ptr_regs (IBOX(d1):d2:dat_regs)
-      = assign_reg ks (DoubleReg d1:acc) ptr_regs dat_regs
-
-    assign_reg (VoidKind:ks) acc ptr_regs dat_regs
-      = assign_reg ks (VoidReg:acc) ptr_regs dat_regs
-
-    -- The catch-all.  It can happen because either
-    -- (a) we've assigned all the regs so leftover_ks is []
-    --  (b) we couldn't find a spare register in the appropriate supply
-    --  or, I suppose,
-    --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
-    --  ToDo Maybe when dataReg becomes empty, we can start using the
-    --       vanilla registers ????
-    assign_reg leftover_ks acc _ _ = (reverse acc, leftover_ks)
-#endif {- Data Parallel Haskell -}
 \end{code}
 
 Register supplies.  Vanilla registers can contain pointers, Ints, Chars.
 \end{code}
 
 Register supplies.  Vanilla registers can contain pointers, Ints, Chars.
@@ -389,35 +364,28 @@ vanillaRegNos :: [Int]
 vanillaRegNos  = [1 .. mAX_Vanilla_REG]
 \end{code}
 
 vanillaRegNos  = [1 .. mAX_Vanilla_REG]
 \end{code}
 
-Only a subset of the registers on the DAP can be used to hold pointers (and most
-of these are taken up with things like the heap pointer and stack pointers). 
-However the resulting registers can hold integers, floats or chars. We therefore
-allocate pointer like things into the @vanillaRegNos@ (and Ints Chars or Floats
-if the remaining registers are empty). See NOTE.regsiterMap for an outline of
-the global and local register allocation scheme.
-
-\begin{code}
-#ifdef DPH
-datRegNos ::[Int]              
-datRegNos = [1..mAX_Data_REG]          -- For Ints, Floats, Doubles or Chars
-#endif {- Data Parallel Haskell -}
-\end{code}
-
 Floats and doubles have separate register supplies.
 
 \begin{code}
 Floats and doubles have separate register supplies.
 
 \begin{code}
-#ifndef DPH
 floatRegNos, doubleRegNos :: [Int]
 floatRegNos    = [1 .. mAX_Float_REG]
 doubleRegNos   = [1 .. mAX_Double_REG]
 
 floatRegNos, doubleRegNos :: [Int]
 floatRegNos    = [1 .. mAX_Float_REG]
 doubleRegNos   = [1 .. mAX_Double_REG]
 
-mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
-mkRegTbl regs_in_use = (ok_vanilla, ok_float, ok_double)
+mkRegTbl :: IntSwitchChecker -> [MagicId] -> ([Int], [Int], [Int])
+
+mkRegTbl isw_chkr regs_in_use
+  = (ok_vanilla, ok_float, ok_double)
   where
   where
-    ok_vanilla = catMaybes (map (select (VanillaReg VoidKind)) vanillaRegNos)
+    ok_vanilla = catMaybes (map (select (VanillaReg VoidKind)) (taker vanillaRegNos))
     ok_float   = catMaybes (map (select FloatReg)             floatRegNos)
     ok_double  = catMaybes (map (select DoubleReg)            doubleRegNos)
 
     ok_float   = catMaybes (map (select FloatReg)             floatRegNos)
     ok_double  = catMaybes (map (select DoubleReg)            doubleRegNos)
 
+    taker :: [Int] -> [Int]
+    taker rs
+      = case (isw_chkr ReturnInRegsThreshold) of
+         Nothing -> rs -- no flag set; use all of them
+         Just  n -> take n rs
+
     select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
        -- one we've unboxed the Int, we make a MagicId
        -- and see if it is already in use; if not, return its number.
     select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
        -- one we've unboxed the Int, we make a MagicId
        -- and see if it is already in use; if not, return its number.
@@ -431,6 +399,4 @@ mkRegTbl regs_in_use = (ok_vanilla, ok_float, ok_double)
        else Nothing
       where
        not_elem = isn'tIn "mkRegTbl"
        else Nothing
       where
        not_elem = isn'tIn "mkRegTbl"
-
-#endif {- Data Parallel Haskell -}
 \end{code}
 \end{code}
index 25448fd..e9f79db 100644 (file)
@@ -14,22 +14,15 @@ import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import PrimOps(PrimOp)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data AbstractC 
+data CAddrMode 
+data CgState 
+data PrimKind 
 adjustRealSps :: Int -> Int -> CgInfoDownwards -> CgState -> CgState
 adjustRealSps :: Int -> Int -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLU(U(LLLL)U(LLLL)L))" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 allocAStack :: CgInfoDownwards -> CgState -> (Int, CgState)
 allocAStack :: CgInfoDownwards -> CgState -> (Int, CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLU(U(LLLL)LL))" {_A_ 5 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 allocBStack :: Int -> CgInfoDownwards -> CgState -> (Int, CgState)
 allocBStack :: Int -> CgInfoDownwards -> CgState -> (Int, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LU(LLLL)L))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 allocUpdateFrame :: Int -> CAddrMode -> ((Int, Int, Int) -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 allocUpdateFrame :: Int -> CAddrMode -> ((Int, Int, Int) -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 12111 _N_ _S_ "LLSU(LLU(LLS))U(LLU(LU(LLLL)L))" _N_ _N_ #-}
 getFinalStackHW :: (Int -> Int -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 getFinalStackHW :: (Int -> Int -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "SLU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkStkAmodes :: Int -> Int -> [CAddrMode] -> CgInfoDownwards -> CgState -> ((Int, Int, AbstractC), CgState)
 mkStkAmodes :: Int -> Int -> [CAddrMode] -> CgInfoDownwards -> CgState -> ((Int, Int, AbstractC), CgState)
-       {-# GHC_PRAGMA _A_ 5 _U_ 22201 _N_ _S_ "LLLAU(LLL)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkVirtStkOffsets :: Int -> Int -> (a -> PrimKind) -> [a] -> (Int, Int, [(a, Int)], [(a, Int)])
 mkVirtStkOffsets :: Int -> Int -> (a -> PrimKind) -> [a] -> (Int, Int, [(a, Int)], [(a, Int)])
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 
 
index 3ec30f0..cb1a4ec 100644 (file)
@@ -158,7 +158,7 @@ allocBStack size info_down (MkCgState absC binds
     find_block :: [VirtualSpBOffset] -> Maybe VirtualSpBOffset
     find_block [] = Nothing
     find_block (slot:slots)
     find_block :: [VirtualSpBOffset] -> Maybe VirtualSpBOffset
     find_block [] = Nothing
     find_block (slot:slots)
-      | take size (slot:slots) == take size (repeat slot)
+      | take size (slot:slots) == [slot..slot+size-1]
       = Just slot
       | otherwise
       = find_block slots
       = Just slot
       | otherwise
       = find_block slots
index fe77b1f..9cd0eec 100644 (file)
@@ -5,40 +5,29 @@ import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, Sequel, StubFlag)
 import CLabelInfo(CLabel)
 import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, Sequel, StubFlag)
-import Class(Class)
 import ClosureInfo(LambdaFormInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import ClosureInfo(LambdaFormInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import StgSyn(StgAtom)
 import TyCon(TyCon)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import StgSyn(StgAtom)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CgInfoDownwards   {-# GHC_PRAGMA MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
+data CAddrMode 
+data CgInfoDownwards 
+data CgState 
 data HeapOffset 
 data HeapOffset 
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data StgAtom a         {-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
+data Id 
+data Labda a 
+data StgAtom a 
+data TyCon 
 cgTailCall :: StgAtom Id -> [StgAtom Id] -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
 cgTailCall :: StgAtom Id -> [StgAtom Id] -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "SSL" _N_ _N_ #-}
 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> CgInfoDownwards -> CgState -> CgState
 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "SLS" _N_ _N_ #-}
 mkPrimReturnCode :: Sequel -> CgInfoDownwards -> CgState -> CgState
 mkPrimReturnCode :: Sequel -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 mkStaticAlgReturnCode :: Id -> Labda CLabel -> Sequel -> CgInfoDownwards -> CgState -> CgState
 mkStaticAlgReturnCode :: Id -> Labda CLabel -> Sequel -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "LLS" _N_ _N_ #-}
 performReturn :: AbstractC -> (Sequel -> CgInfoDownwards -> CgState -> CgState) -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
 performReturn :: AbstractC -> (Sequel -> CgInfoDownwards -> CgState -> CgState) -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 21221 _N_ _S_ "LSLU(LLU(LLL))L" _N_ _N_ #-}
 tailCallBusiness :: Id -> CAddrMode -> LambdaFormInfo -> [CAddrMode] -> UniqFM Id -> AbstractC -> CgInfoDownwards -> CgState -> CgState
 tailCallBusiness :: Id -> CAddrMode -> LambdaFormInfo -> [CAddrMode] -> UniqFM Id -> AbstractC -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 6 _U_ 22222222 _N_ _S_ "LSLLLL" _N_ _N_ #-}
 
 
index a292b04..c2ece1e 100644 (file)
@@ -169,8 +169,8 @@ mkStaticAlgReturnCode :: Id         -- The constructor
 mkStaticAlgReturnCode con maybe_info_lbl sequel
   =    -- Generate profiling code if necessary
     (case return_convention of
 mkStaticAlgReturnCode con maybe_info_lbl sequel
   =    -- Generate profiling code if necessary
     (case return_convention of
-       VectoredReturn _ -> profCtrC SLIT("VEC_RETURN") []
-       other            -> nopC
+       VectoredReturn sz -> profCtrC SLIT("VEC_RETURN") [mkIntCLit sz]
+       other             -> nopC
     )                                  `thenC`
 
        -- Set tag if necessary
     )                                  `thenC`
 
        -- Set tag if necessary
@@ -194,7 +194,8 @@ mkStaticAlgReturnCode con maybe_info_lbl sequel
 
                                -- Set the info pointer, and jump
                        set_info_ptr            `thenC`
 
                                -- Set the info pointer, and jump
                        set_info_ptr            `thenC`
-                       absC (CJump (CLbl update_label CodePtrKind))
+                       getIntSwitchChkrC       `thenFC` \ isw_chkr ->
+                       absC (CJump (CLbl (update_label isw_chkr) CodePtrKind))
 
        CaseAlts _ (Just (alts, _)) ->  -- Ho! We know the constructor so
                                        -- we can go right to the alternative
 
        CaseAlts _ (Just (alts, _)) ->  -- Ho! We know the constructor so
                                        -- we can go right to the alternative
@@ -224,9 +225,10 @@ mkStaticAlgReturnCode con maybe_info_lbl sequel
     zero_indexed_tag  = tag - fIRST_TAG              -- Adjust tag to be zero-indexed
                                              -- cf AbsCFuns.mkAlgAltsCSwitch
 
     zero_indexed_tag  = tag - fIRST_TAG              -- Adjust tag to be zero-indexed
                                              -- cf AbsCFuns.mkAlgAltsCSwitch
 
-    update_label      = case dataReturnConvAlg con of
-                           ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag
-                           ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
+    update_label isw_chkr
+      = case (dataReturnConvAlg isw_chkr con) of
+         ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag
+         ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
 
     return_info = case return_convention of
                        UnvectoredReturn _ -> DirectReturn
 
     return_info = case return_convention of
                        UnvectoredReturn _ -> DirectReturn
@@ -241,9 +243,9 @@ mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
 
 mkDynamicAlgReturnCode tycon dyn_tag sequel
   = case ctrlReturnConvAlg tycon of
 
 mkDynamicAlgReturnCode tycon dyn_tag sequel
   = case ctrlReturnConvAlg tycon of
-       VectoredReturn _ ->     
+       VectoredReturn sz ->
 
 
-               profCtrC SLIT("VEC_RETURN") []  `thenC`
+               profCtrC SLIT("VEC_RETURN") [mkIntCLit sz] `thenC`
                sequelToAmode sequel            `thenFC` \ ret_addr ->  
                absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
 
                sequelToAmode sequel            `thenFC` \ ret_addr ->  
                absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
 
@@ -321,9 +323,7 @@ tailCallBusiness :: Id -> CAddrMode -- Function and its amode
                 -> Code
 
 tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
                 -> Code
 
 tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
-  = profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_TAILCALL") IntKind]  `thenC`
-
-    isSwitchSetC EmitArityChecks               `thenFC` \ do_arity_chks ->
+  = isSwitchSetC EmitArityChecks               `thenFC` \ do_arity_chks ->
 
     nodeMustPointToIt lf_info                  `thenFC` \ node_points ->
     getEntryConvention fun lf_info
 
     nodeMustPointToIt lf_info                  `thenFC` \ node_points ->
     getEntryConvention fun lf_info
@@ -446,8 +446,6 @@ tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
                -- Here, lit.3 is built as a re-entrant thing, which you must enter.
                -- (OK, the simplifier should have eliminated this, but it's
                --  easy to deal with the case anyway.)
                -- Here, lit.3 is built as a re-entrant thing, which you must enter.
                -- (OK, the simplifier should have eliminated this, but it's
                --  easy to deal with the case anyway.)
-
-
                let
                    join_details_to_code (load_regs_and_profiling_code, join_lbl)
                        = load_regs_and_profiling_code          `mkAbsCStmts`
                let
                    join_details_to_code (load_regs_and_profiling_code, join_lbl)
                        = load_regs_and_profiling_code          `mkAbsCStmts`
@@ -458,14 +456,13 @@ tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
                                       | (tag, join_details) <- st_alts
                                       ]
 
                                       | (tag, join_details) <- st_alts
                                       ]
 
-                       -- This alternative is for the unevaluated case; oTHER_TAG is -1
-                   un_evald_alt = (mkMachInt oTHER_TAG, enter_jump)
-
-                   enter_jump = CJump (CMacroExpr CodePtrKind ENTRY_CODE [CReg infoptr])
+                   enter_jump
                      -- Enter Node (we know infoptr will have the info ptr in it)!
                      -- Enter Node (we know infoptr will have the info ptr in it)!
-
+                     = mkAbstractCs [
+                       CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
+                                       [CMacroExpr IntKind INFO_TAG [CReg infoptr]],
+                       CJump (CMacroExpr CodePtrKind ENTRY_CODE [CReg infoptr]) ]
                in
                in
-
                        -- Final switch
                absC (mkAbstractCs [
                            CAssign (CReg infoptr)
                        -- Final switch
                absC (mkAbstractCs [
                            CAssign (CReg infoptr)
index 0ff61fa..6762d3e 100644 (file)
@@ -3,5 +3,4 @@ interface CgUpdate where
 import AbsCSyn(CAddrMode)
 import CgMonad(CgInfoDownwards, CgState)
 pushUpdateFrame :: CAddrMode -> CAddrMode -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 import AbsCSyn(CAddrMode)
 import CgMonad(CgInfoDownwards, CgState)
 pushUpdateFrame :: CAddrMode -> CAddrMode -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _S_ "LLSU(U(LL)LU(LLS))U(LLU(LU(LLLL)L))" _N_ _N_ #-}
 
 
index 0a1ecaf..b41e473 100644 (file)
@@ -12,28 +12,18 @@ import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
 import UniqFM(UniqFM)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
 import UniqFM(UniqFM)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data RegRelative       {-# GHC_PRAGMA HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
+data AbstractC 
+data RegRelative 
+data CgState 
 data HeapOffset 
 freeBStkSlot :: Int -> CgInfoDownwards -> CgState -> CgState
 data HeapOffset 
 freeBStkSlot :: Int -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LU(LLLL)L))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getHpRelOffset :: HeapOffset -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
 getHpRelOffset :: HeapOffset -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LLU(LL)))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSpARelOffset :: Int -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
 getSpARelOffset :: Int -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(U(LLLL)LL))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSpBRelOffset :: Int -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
 getSpBRelOffset :: Int -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LU(LLLL)L))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getVirtAndRealHp :: CgInfoDownwards -> CgState -> ((HeapOffset, HeapOffset), CgState)
 getVirtAndRealHp :: CgInfoDownwards -> CgState -> ((HeapOffset, HeapOffset), CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLU(LLU(LL)))" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> case u1 of { _ALG_ _ORIG_ CgMonad MkCgState (u2 :: AbstractC) (u3 :: UniqFM CgIdInfo) (u4 :: ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))) -> case u4 of { _ALG_ _TUP_3 (u5 :: (Int, [(Int, StubFlag)], Int, Int)) (u6 :: (Int, [Int], Int, Int)) (u7 :: (HeapOffset, HeapOffset)) -> case u7 of { _ALG_ _TUP_2 (u8 :: HeapOffset) (u9 :: HeapOffset) -> _!_ _TUP_2 [(HeapOffset, HeapOffset), CgState] [u7, u1]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getVirtSps :: CgInfoDownwards -> CgState -> ((Int, Int), CgState)
 getVirtSps :: CgInfoDownwards -> CgState -> ((Int, Int), CgState)
-       {-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLU(U(LLLL)U(LLLL)L))" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 initHeapUsage :: (HeapOffset -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
 initHeapUsage :: (HeapOffset -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLU(LLU(LLL))" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setRealAndVirtualSps :: Int -> Int -> CgInfoDownwards -> CgState -> CgState
 setRealAndVirtualSps :: Int -> Int -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLU(U(ALAA)U(ALAA)L))" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setRealHp :: HeapOffset -> CgInfoDownwards -> CgState -> CgState
 setRealHp :: HeapOffset -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LLU(LA)))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setVirtHp :: HeapOffset -> CgInfoDownwards -> CgState -> CgState
 setVirtHp :: HeapOffset -> CgInfoDownwards -> CgState -> CgState
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LLU(AL)))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 8914c9f..95addbc 100644 (file)
 interface ClosureInfo where
 import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelative, ReturnInfo)
 import BasicLit(BasicLit)
 interface ClosureInfo where
 import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelative, ReturnInfo)
 import BasicLit(BasicLit)
-import CLabelInfo(CLabel, mkClosureLabel)
-import CgBindery(CgIdInfo, StableLoc, VolatileLoc)
+import CLabelInfo(CLabel)
+import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, FCode(..), StubFlag)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, FCode(..), StubFlag)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import CmdLineOpts(GlobalSwitch)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(DataCon(..), Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(DataCon(..), Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind, getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr, ltSMRepHdr)
 import StgSyn(PlainStgAtom(..), PlainStgExpr(..), PlainStgLiveVars(..), StgAtom, StgBinderInfo, StgBinding, StgCaseAlternatives, StgExpr, UpdateFlag(..))
 import TyCon(TyCon)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind, getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr, ltSMRepHdr)
 import StgSyn(PlainStgAtom(..), PlainStgExpr(..), PlainStgLiveVars(..), StgAtom, StgBinderInfo, StgBinding, StgCaseAlternatives, StgExpr, UpdateFlag(..))
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniTyFuns(getUniDataSpecTyCon_maybe)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data AbstractC 
+data CAddrMode 
+data MagicId 
 data CLabel 
 data CLabel 
-data CgIdInfo  {-# GHC_PRAGMA MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo #-}
-data CgInfoDownwards   {-# GHC_PRAGMA MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo #-}
-data CgState   {-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data ClosureInfo       {-# GHC_PRAGMA MkClosureInfo Id LambdaFormInfo SMRep #-}
-data CompilationInfo   {-# GHC_PRAGMA MkCompInfo (GlobalSwitch -> Bool) _PackedString #-}
+data CgIdInfo 
+data CgInfoDownwards 
+data CgState 
+data ClosureInfo 
+data CompilationInfo 
 data EntryConvention   = ViaNode | StdEntry CLabel (Labda CLabel) | DirectEntry CLabel Int [MagicId]
 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
 data HeapOffset 
 type DataCon = Id
 data EntryConvention   = ViaNode | StdEntry CLabel (Labda CLabel) | DirectEntry CLabel Int [MagicId]
 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
 data HeapOffset 
 type DataCon = Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data LambdaFormInfo    {-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
+data Id 
+data Labda a 
+data LambdaFormInfo 
+data PrimKind 
+data SMRep 
 type PlainStgAtom = StgAtom Id
 type PlainStgExpr = StgExpr Id Id
 type PlainStgLiveVars = UniqFM Id
 type PlainStgAtom = StgAtom Id
 type PlainStgExpr = StgExpr Id Id
 type PlainStgLiveVars = UniqFM Id
-data StandardFormInfo  {-# GHC_PRAGMA NonStandardThunk | SelectorThunk Id Id Int | VapThunk Id [StgAtom Id] Bool #-}
-data StgAtom a         {-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data StgBinderInfo     {-# GHC_PRAGMA NoStgBinderInfo | StgBinderInfo Bool Bool Bool Bool Bool #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data StandardFormInfo 
+data StgAtom a 
+data StgBinderInfo 
+data StgExpr a b 
 data UpdateFlag   = ReEntrant | Updatable | SingleEntry
 data UpdateFlag   = ReEntrant | Updatable | SingleEntry
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data TyCon 
+data UniqFM a 
 type UniqSet a = UniqFM a
 allocProfilingMsg :: ClosureInfo -> _PackedString
 type UniqSet a = UniqFM a
 allocProfilingMsg :: ClosureInfo -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 blackHoleClosureInfo :: ClosureInfo -> ClosureInfo
 blackHoleClosureInfo :: ClosureInfo -> ClosureInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 blackHoleOnEntry :: Bool -> ClosureInfo -> Bool
 blackHoleOnEntry :: Bool -> ClosureInfo -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LU(ALS)" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureGoodStuffSize :: ClosureInfo -> Int
 closureGoodStuffSize :: ClosureInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureHdrSize :: ClosureInfo -> HeapOffset
 closureHdrSize :: ClosureInfo -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ HeapOffs totHdrSize _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> _APP_  _ORIG_ HeapOffs totHdrSize [ u3 ]; _NO_DEFLT_ } _N_ #-}
 closureId :: ClosureInfo -> Id
 closureId :: ClosureInfo -> Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(LLLL)AA)" {_A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: UniType) (u2 :: IdInfo) (u3 :: IdDetails) -> _!_ _ORIG_ Id Id [] [u0, u1, u2, u3] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> u1; _NO_DEFLT_ } _N_ #-}
 closureKind :: ClosureInfo -> [Char]
 closureKind :: ClosureInfo -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureLFInfo :: ClosureInfo -> LambdaFormInfo
 closureLFInfo :: ClosureInfo -> LambdaFormInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: LambdaFormInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> u2; _NO_DEFLT_ } _N_ #-}
 closureLabelFromCI :: ClosureInfo -> CLabel
 closureLabelFromCI :: ClosureInfo -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ CLabelInfo mkClosureLabel _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> _APP_  _ORIG_ CLabelInfo mkClosureLabel [ u1 ]; _NO_DEFLT_ } _N_ #-}
 closureNonHdrSize :: ClosureInfo -> Int
 closureNonHdrSize :: ClosureInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closurePtrsSize :: ClosureInfo -> Int
 closurePtrsSize :: ClosureInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureReturnsUnboxedType :: ClosureInfo -> Bool
 closureReturnsUnboxedType :: ClosureInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSA)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSMRep :: ClosureInfo -> SMRep
 closureSMRep :: ClosureInfo -> SMRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SMRep) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> u3; _NO_DEFLT_ } _N_ #-}
 closureSemiTag :: ClosureInfo -> Int
 closureSemiTag :: ClosureInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSingleEntry :: ClosureInfo -> Bool
 closureSingleEntry :: ClosureInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSize :: ClosureInfo -> HeapOffset
 closureSize :: ClosureInfo -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSizeWithoutFixedHdr :: ClosureInfo -> HeapOffset
 closureSizeWithoutFixedHdr :: ClosureInfo -> HeapOffset
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureType :: ClosureInfo -> Labda (TyCon, [UniType], [Id])
 closureType :: ClosureInfo -> Labda (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSA)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureTypeDescr :: ClosureInfo -> [Char]
 closureTypeDescr :: ClosureInfo -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(ALAS)AA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureUpdReqd :: ClosureInfo -> Bool
 closureUpdReqd :: ClosureInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 12 \ (u0 :: LambdaFormInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo LFThunk (u1 :: Bool) (u2 :: Bool) (u3 :: Bool) (u4 :: StandardFormInfo) -> u3; _ORIG_ ClosureInfo LFBlackHole  -> _!_ True [] []; (u5 :: LambdaFormInfo) -> _!_ False [] [] } _N_} _N_ _N_ #-}
-dataConLiveness :: ClosureInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+dataConLiveness :: ((Int -> GlobalSwitch) -> Labda Int) -> ClosureInfo -> Int
 entryLabelFromCI :: ClosureInfo -> CLabel
 entryLabelFromCI :: ClosureInfo -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSL)" {_A_ 3 _U_ 211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fastLabelFromCI :: ClosureInfo -> CLabel
 fastLabelFromCI :: ClosureInfo -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fitsMinUpdSize :: ClosureInfo -> Bool
 fitsMinUpdSize :: ClosureInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 funInfoTableRequired :: Id -> StgBinderInfo -> LambdaFormInfo -> Bool
 funInfoTableRequired :: Id -> StgBinderInfo -> LambdaFormInfo -> Bool
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LSL" _N_ _N_ #-}
 getEntryConvention :: Id -> LambdaFormInfo -> [PrimKind] -> CgInfoDownwards -> CgState -> (EntryConvention, CgState)
 getEntryConvention :: Id -> LambdaFormInfo -> [PrimKind] -> CgInfoDownwards -> CgState -> (EntryConvention, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
-mkClosureLabel :: Id -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 getSMInfoStr :: SMRep -> [Char]
 getSMInfoStr :: SMRep -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMInitHdrStr :: SMRep -> [Char]
 getSMInitHdrStr :: SMRep -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMUpdInplaceHdrStr :: SMRep -> [Char]
 getSMUpdInplaceHdrStr :: SMRep -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getStandardFormThunkInfo :: LambdaFormInfo -> Labda [StgAtom Id]
 getStandardFormThunkInfo :: LambdaFormInfo -> Labda [StgAtom Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-getUniDataSpecTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 infoTableLabelFromCI :: ClosureInfo -> CLabel
 infoTableLabelFromCI :: ClosureInfo -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSL)" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isConstantRep :: SMRep -> Bool
 isConstantRep :: SMRep -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isPhantomRep :: SMRep -> Bool
 isPhantomRep :: SMRep -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: SMRep) -> case u0 of { _ALG_ _ORIG_ SMRep PhantomRep  -> _!_ True [] []; (u1 :: SMRep) -> _!_ False [] [] } _N_ #-}
 isSpecRep :: SMRep -> Bool
 isSpecRep :: SMRep -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: SMRep) -> case u0 of { _ALG_ _ORIG_ SMRep SpecialisedRep (u1 :: SMSpecRepKind) (u2 :: Int) (u3 :: Int) (u4 :: SMUpdateKind) -> _!_ True [] []; (u5 :: SMRep) -> _!_ False [] [] } _N_ #-}
 isStaticClosure :: ClosureInfo -> Bool
 isStaticClosure :: ClosureInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: SMRep) -> case u0 of { _ALG_ _ORIG_ SMRep StaticRep (u1 :: Int) (u2 :: Int) -> _!_ True [] []; (u3 :: SMRep) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 layOutDynClosure :: Id -> (a -> PrimKind) -> [a] -> LambdaFormInfo -> (ClosureInfo, [(a, HeapOffset)])
 layOutDynClosure :: Id -> (a -> PrimKind) -> [a] -> LambdaFormInfo -> (ClosureInfo, [(a, HeapOffset)])
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 layOutDynCon :: Id -> (a -> PrimKind) -> [a] -> (ClosureInfo, [(a, HeapOffset)])
 layOutDynCon :: Id -> (a -> PrimKind) -> [a] -> (ClosureInfo, [(a, HeapOffset)])
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 layOutPhantomClosure :: Id -> LambdaFormInfo -> ClosureInfo
 layOutPhantomClosure :: Id -> LambdaFormInfo -> ClosureInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 layOutStaticClosure :: Id -> (a -> PrimKind) -> [a] -> LambdaFormInfo -> (ClosureInfo, [(a, HeapOffset)])
 layOutStaticClosure :: Id -> (a -> PrimKind) -> [a] -> LambdaFormInfo -> (ClosureInfo, [(a, HeapOffset)])
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 layOutStaticNoFVClosure :: Id -> LambdaFormInfo -> ClosureInfo
 layOutStaticNoFVClosure :: Id -> LambdaFormInfo -> ClosureInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 ltSMRepHdr :: SMRep -> SMRep -> Bool
 ltSMRepHdr :: SMRep -> SMRep -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 maybeSelectorInfo :: ClosureInfo -> Labda (Id, Int)
 maybeSelectorInfo :: ClosureInfo -> Labda (Id, Int)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkClosureLFInfo :: Bool -> [Id] -> UpdateFlag -> [Id] -> StgExpr Id Id -> LambdaFormInfo
 mkClosureLFInfo :: Bool -> [Id] -> UpdateFlag -> [Id] -> StgExpr Id Id -> LambdaFormInfo
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _S_ "LLLSL" _N_ _N_ #-}
 mkConLFInfo :: Id -> LambdaFormInfo
 mkConLFInfo :: Id -> LambdaFormInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkLFArgument :: LambdaFormInfo
 mkLFArgument :: LambdaFormInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ ClosureInfo LFArgument [] [] _N_ #-}
 mkLFImported :: Id -> LambdaFormInfo
 mkLFImported :: Id -> LambdaFormInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(SAAAAAAAAA)A)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkLFLetNoEscape :: Int -> UniqFM Id -> LambdaFormInfo
 mkLFLetNoEscape :: Int -> UniqFM Id -> LambdaFormInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: UniqFM Id) -> _!_ _ORIG_ ClosureInfo LFLetNoEscape [] [u0, u1] _N_ #-}
 mkVirtHeapOffsets :: SMRep -> (a -> PrimKind) -> [a] -> (Int, Int, [(a, HeapOffset)])
 mkVirtHeapOffsets :: SMRep -> (a -> PrimKind) -> [a] -> (Int, Int, [(a, HeapOffset)])
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 noUpdVapRequired :: StgBinderInfo -> Bool
 noUpdVapRequired :: StgBinderInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: StgBinderInfo) -> case u0 of { _ALG_ _ORIG_ StgSyn NoStgBinderInfo  -> _!_ False [] []; _ORIG_ StgSyn StgBinderInfo (u1 :: Bool) (u2 :: Bool) (u3 :: Bool) (u4 :: Bool) (u5 :: Bool) -> u4; _NO_DEFLT_ } _N_ #-}
 nodeMustPointToIt :: LambdaFormInfo -> CgInfoDownwards -> CgState -> (Bool, CgState)
 nodeMustPointToIt :: LambdaFormInfo -> CgInfoDownwards -> CgState -> (Bool, CgState)
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 slopSize :: ClosureInfo -> Int
 slopSize :: ClosureInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 slowFunEntryCodeRequired :: Id -> StgBinderInfo -> Bool
 slowFunEntryCodeRequired :: Id -> StgBinderInfo -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 staticClosureRequired :: Id -> StgBinderInfo -> LambdaFormInfo -> Bool
 staticClosureRequired :: Id -> StgBinderInfo -> LambdaFormInfo -> Bool
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LSL" _N_ _N_ #-}
 stdVapRequired :: StgBinderInfo -> Bool
 stdVapRequired :: StgBinderInfo -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: StgBinderInfo) -> case u0 of { _ALG_ _ORIG_ StgSyn NoStgBinderInfo  -> _!_ False [] []; _ORIG_ StgSyn StgBinderInfo (u1 :: Bool) (u2 :: Bool) (u3 :: Bool) (u4 :: Bool) (u5 :: Bool) -> u3; _NO_DEFLT_ } _N_ #-}
 
 
index d705356..055abe8 100644 (file)
@@ -297,7 +297,7 @@ data LambdaFormInfo
 
   -- This last one is really only for completeness;
   -- it isn't actually used for anything interesting
 
   -- This last one is really only for completeness;
   -- it isn't actually used for anything interesting
-  | LFIndirection
+  {- | LFIndirection -}
 
 data StandardFormInfo  -- Tells whether this thunk has one of a small number
                        -- of standard forms
 
 data StandardFormInfo  -- Tells whether this thunk has one of a small number
                        -- of standard forms
@@ -858,8 +858,9 @@ getEntryConvention :: Id                    -- Function being applied
                   -> FCode EntryConvention
 
 getEntryConvention id lf_info arg_kinds
                   -> FCode EntryConvention
 
 getEntryConvention id lf_info arg_kinds
- =  nodeMustPointToIt lf_info          `thenFC` \ node_points ->
-    isSwitchSetC ForConcurrent         `thenFC` \ is_concurrent -> 
+ =  nodeMustPointToIt lf_info  `thenFC` \ node_points ->
+    isSwitchSetC ForConcurrent `thenFC` \ is_concurrent -> 
+    getIntSwitchChkrC          `thenFC` \ isw_chkr ->
     returnFC (
 
     if (node_points && is_concurrent) then ViaNode else
     returnFC (
 
     if (node_points && is_concurrent) then ViaNode else
@@ -872,7 +873,7 @@ getEntryConvention id lf_info arg_kinds
            else 
                DirectEntry (mkFastEntryLabel id arity) arity arg_regs
          where
            else 
                DirectEntry (mkFastEntryLabel id arity) arity arg_regs
          where
-           (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
+           (arg_regs, _) = assignRegs isw_chkr live_regs (take arity arg_kinds)
            live_regs = if node_points then [node] else []
 
         LFCon con zero_arity  
            live_regs = if node_points then [node] else []
 
         LFCon con zero_arity  
@@ -900,9 +901,9 @@ getEntryConvention id lf_info arg_kinds
 
        LFLetNoEscape arity _
          -> ASSERT(arity == length arg_kinds)
 
        LFLetNoEscape arity _
          -> ASSERT(arity == length arg_kinds)
-            DirectEntry (mkFastEntryLabel id arity) arity arg_regs
+            DirectEntry (mkStdEntryLabel id) arity arg_regs
         where
         where
-           (arg_regs, _) = assignRegs live_regs arg_kinds
+           (arg_regs, _) = assignRegs isw_chkr live_regs arg_kinds
            live_regs     = if node_points then [node] else []
     )
 
            live_regs     = if node_points then [node] else []
     )
 
@@ -1171,7 +1172,7 @@ closureSemiTag (MkClosureInfo _ lf_info _)
   = case lf_info of
       LFCon data_con _ -> getDataConTag data_con - fIRST_TAG
       LFTuple _ _      -> 0
   = case lf_info of
       LFCon data_con _ -> getDataConTag data_con - fIRST_TAG
       LFTuple _ _      -> 0
-      LFIndirection    -> fromInteger iND_TAG
+      --UNUSED: LFIndirection  -> fromInteger iND_TAG
       _                       -> fromInteger oTHER_TAG
 \end{code}
 
       _                       -> fromInteger oTHER_TAG
 \end{code}
 
@@ -1204,9 +1205,9 @@ infoTableLabelFromCI (MkClosureInfo id lf_info rep)
                                        -- Ditto for selectors
 -}
 
                                        -- Ditto for selectors
 -}
 
-       other -> if isStaticRep rep
+       other -> {-NO: if isStaticRep rep
                 then mkStaticInfoTableLabel id
                 then mkStaticInfoTableLabel id
-                else mkInfoTableLabel       id
+                else -} mkInfoTableLabel id
 
 mkConInfoPtr :: Id -> SMRep -> CLabel
 mkConInfoPtr id rep = 
 
 mkConInfoPtr :: Id -> SMRep -> CLabel
 mkConInfoPtr id rep = 
@@ -1261,7 +1262,7 @@ allocProfilingMsg (MkClosureInfo _ lf_info _)
       LFTuple _ _              -> SLIT("ALLOC_CON")
       LFThunk _ _ _ _          -> SLIT("ALLOC_THK")
       LFBlackHole              -> SLIT("ALLOC_BH")
       LFTuple _ _              -> SLIT("ALLOC_CON")
       LFThunk _ _ _ _          -> SLIT("ALLOC_THK")
       LFBlackHole              -> SLIT("ALLOC_BH")
-      LFIndirection            -> panic "ALLOC_IND"
+      --UNUSED: LFIndirection  -> panic "ALLOC_IND"
       LFImported               -> panic "ALLOC_IMP"
 \end{code}
 
       LFImported               -> panic "ALLOC_IMP"
 \end{code}
 
@@ -1279,12 +1280,12 @@ information is never used, we don't care.
 
 \begin{code}
 
 
 \begin{code}
 
-dataConLiveness (MkClosureInfo con _ PhantomRep)
-  = case dataReturnConvAlg con of
+dataConLiveness isw_chkr (MkClosureInfo con _ PhantomRep)
+  = case (dataReturnConvAlg isw_chkr con) of
       ReturnInRegs regs -> mkLiveRegsBitMask regs
       ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
 
       ReturnInRegs regs -> mkLiveRegsBitMask regs
       ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
 
-dataConLiveness _ = mkLiveRegsBitMask [node]
+dataConLiveness _ _ = mkLiveRegsBitMask [node]
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -1315,7 +1316,7 @@ closureKind (MkClosureInfo _ lf _)
       LFTuple _ _              -> "CON_K"
       LFThunk _ _ _ _          -> "THK_K"
       LFBlackHole              -> "THK_K" -- consider BHs as thunks for the moment... (ToDo?)
       LFTuple _ _              -> "CON_K"
       LFThunk _ _ _ _          -> "THK_K"
       LFBlackHole              -> "THK_K" -- consider BHs as thunks for the moment... (ToDo?)
-      LFIndirection            -> panic "IND_KIND"
+      --UNUSED: LFIndirection  -> panic "IND_KIND"
       LFImported               -> panic "IMP_KIND"
 
 closureTypeDescr :: ClosureInfo -> String
       LFImported               -> panic "IMP_KIND"
 
 closureTypeDescr :: ClosureInfo -> String
index 28362e7..0b93b98 100644 (file)
@@ -7,8 +7,7 @@ import ClosureInfo(ClosureInfo)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CostCentre(CostCentre)
 import FiniteMap(FiniteMap)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CostCentre(CostCentre)
 import FiniteMap(FiniteMap)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
@@ -16,12 +15,10 @@ import StgSyn(StgBinding, StgRhs)
 import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
-import Unique(Unique)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data StgBinding a b    {-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data AbstractC 
+data FiniteMap a b 
+data Id 
+data StgBinding a b 
+data UniqFM a 
 codeGen :: _PackedString -> ([CostCentre], [CostCentre]) -> [_PackedString] -> (GlobalSwitch -> SwitchResult) -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> [StgBinding Id Id] -> AbstractC
 codeGen :: _PackedString -> ([CostCentre], [CostCentre]) -> [_PackedString] -> (GlobalSwitch -> SwitchResult) -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> [StgBinding Id Id] -> AbstractC
-       {-# GHC_PRAGMA _A_ 7 _U_ 2112112 _N_ _S_ "LU(LL)LSLLL" _N_ _N_ #-}
 
 
index a1aa854..795f2ec 100644 (file)
@@ -34,9 +34,10 @@ import CgClosure     ( cgTopRhsClosure )
 import CgCon           ( cgTopRhsCon )
 import CgConTbls       ( genStaticConBits, TCE(..), UniqFM )
 import ClosureInfo     ( LambdaFormInfo, mkClosureLFInfo )
 import CgCon           ( cgTopRhsCon )
 import CgConTbls       ( genStaticConBits, TCE(..), UniqFM )
 import ClosureInfo     ( LambdaFormInfo, mkClosureLFInfo )
-import CmdLineOpts     ( GlobalSwitch(..), switchIsOn, stringSwitchSet, SwitchResult )
+import CmdLineOpts
 import FiniteMap       ( FiniteMap )
 import Maybes          ( Maybe(..) )
 import FiniteMap       ( FiniteMap )
 import Maybes          ( Maybe(..) )
+import Pretty          -- debugging only
 import PrimKind                ( getKindSize )
 import Util
 \end{code}
 import PrimKind                ( getKindSize )
 import Util
 \end{code}
@@ -56,15 +57,36 @@ codeGen :: FAST_STRING              -- module name
 
 codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons tycon_specs stg_pgm
   = let
 
 codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons tycon_specs stg_pgm
   = let
-       switch_is_on      = switchIsOn sw_lookup_fn
+       switch_is_on      = switchIsOn   sw_lookup_fn
+       int_switch_set    = intSwitchSet sw_lookup_fn
        doing_profiling   = switch_is_on SccProfilingOn
        compiling_prelude = switch_is_on CompilingPrelude
        splitting         = switch_is_on (EnsureSplittableC (panic "codeGen:esc"))
        doing_profiling   = switch_is_on SccProfilingOn
        compiling_prelude = switch_is_on CompilingPrelude
        splitting         = switch_is_on (EnsureSplittableC (panic "codeGen:esc"))
+
+       cinfo = MkCompInfo switch_is_on int_switch_set mod_name
     in
     in
+
+{- OLD:
+    pprTrace "codeGen:" (ppCat [
+    (case (switch_is_on StgDoLetNoEscapes) of
+       False -> ppStr "False?"
+       True  -> ppStr "True?"
+    ),
+    (case (int_switch_set ReturnInRegsThreshold) of
+       Nothing -> ppStr "Nothing!"
+       Just  n -> ppCat [ppStr "Just", ppInt n]
+    ),
+    (case (int_switch_set UnfoldingUseThreshold) of
+       Nothing -> ppStr "Nothing!"
+       Just  n -> ppCat [ppStr "Just", ppInt n]
+    ),
+    (case (int_switch_set UnfoldingCreationThreshold) of
+       Nothing -> ppStr "Nothing!"
+       Just  n -> ppCat [ppStr "Just", ppInt n]
+    )
+    ]) $
+-}
     if not doing_profiling then
     if not doing_profiling then
-       let
-           cinfo = MkCompInfo switch_is_on mod_name
-       in
        mkAbstractCs [
            genStaticConBits cinfo gen_tycons tycon_specs,
            initC cinfo (cgTopBindings splitting stg_pgm) ]
        mkAbstractCs [
            genStaticConBits cinfo gen_tycons tycon_specs,
            initC cinfo (cgTopBindings splitting stg_pgm) ]
@@ -80,9 +102,7 @@ codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons ty
         -- into the code-generator, as are the imported-modules' names.)
         --
         -- Note: we don't register/etc if compiling Prelude bits.
         -- into the code-generator, as are the imported-modules' names.)
         --
         -- Note: we don't register/etc if compiling Prelude bits.
-       let
-           cinfo = MkCompInfo switch_is_on mod_name
-       in
+
        mkAbstractCs [
                if compiling_prelude
                then AbsCNop
        mkAbstractCs [
                if compiling_prelude
                then AbsCNop
index bad95d4..e8d86a3 100644 (file)
@@ -5,33 +5,11 @@ data SMRep   = StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdate
 data SMSpecRepKind   = SpecRep | ConstantRep | CharLikeRep | IntLikeRep
 data SMUpdateKind   = SMNormalForm | SMSingleEntry | SMUpdatable
 getSMInfoStr :: SMRep -> [Char]
 data SMSpecRepKind   = SpecRep | ConstantRep | CharLikeRep | IntLikeRep
 data SMUpdateKind   = SMNormalForm | SMSingleEntry | SMUpdatable
 getSMInfoStr :: SMRep -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMInitHdrStr :: SMRep -> [Char]
 getSMInitHdrStr :: SMRep -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMUpdInplaceHdrStr :: SMRep -> [Char]
 getSMUpdInplaceHdrStr :: SMRep -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 ltSMRepHdr :: SMRep -> SMRep -> Bool
 ltSMRepHdr :: SMRep -> SMRep -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq SMRep
 instance Eq SMRep
-       {-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool)] [_CONSTM_ Eq (==) (SMRep), _CONSTM_ Eq (/=) (SMRep)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord SMRep
 instance Ord SMRep
-       {-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq SMRep}}, (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> SMRep), (SMRep -> SMRep -> SMRep), (SMRep -> SMRep -> _CMP_TAG)] [_DFUN_ Eq (SMRep), _CONSTM_ Ord (<) (SMRep), _CONSTM_ Ord (<=) (SMRep), _CONSTM_ Ord (>=) (SMRep), _CONSTM_ Ord (>) (SMRep), _CONSTM_ Ord max (SMRep), _CONSTM_ Ord min (SMRep), _CONSTM_ Ord _tagCmp (SMRep)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: SMRep) (u1 :: SMRep) -> _APP_  _CONSTM_ Ord (<=) (SMRep) [ u1, u0 ] _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: SMRep) (u1 :: SMRep) -> _APP_  _CONSTM_ Ord (<) (SMRep) [ u1, u0 ] _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Outputable SMRep
 instance Outputable SMRep
-       {-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (SMRep) _N_
-        ppr = _A_ 2 _U_ 0220 _N_ _S_ "AL" {_A_ 1 _U_ 220 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Text SMRep
 instance Text SMRep
-       {-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SMRep, [Char])]), (Int -> SMRep -> [Char] -> [Char]), ([Char] -> [([SMRep], [Char])]), ([SMRep] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SMRep), _CONSTM_ Text showsPrec (SMRep), _CONSTM_ Text readList (SMRep), _CONSTM_ Text showList (SMRep)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(SMRep, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "ASL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index fb5b113..c7656af 100644 (file)
@@ -83,6 +83,52 @@ data SMRep
                        -- Used for mutable tuples
        Int             -- # ptr words
 
                        -- Used for mutable tuples
        Int             -- # ptr words
 
+{- Mattson review:
+
+To: simonpj@dcs.gla.ac.uk, partain@dcs.gla.ac.uk
+Cc: kh@dcs.gla.ac.uk, trinder@dcs.gla.ac.uk, areid@dcs.gla.ac.uk
+Subject: Correct me if I'm wrong...
+Date: Fri, 17 Feb 1995 18:09:00 +0000
+From: Jim Mattson <mattson@dcs.gla.ac.uk>
+
+BigTupleRep == TUPLE
+
+    Never generated by the compiler, and only used in the RTS when
+    mutuples don't require special attention at GC time (e.g. 2s)
+    When it is used, it is a primitive object (never entered).
+    May be mutable...probably should never be used in the parallel 
+    system, since we need to distinguish mutables from immutables when
+    deciding whether to copy or move closures across processors.
+
+DataRep == DATA (aka MutableByteArray & ByteArray)
+    Never generated by the compiler, and only used in the RTS for
+    ArrayOfData.  Always a primitive object (never entered).  May
+    be mutable...though we don't distinguish between mutable and
+    immutable data arrays in the sequential world, it would probably
+    be useful in the parallel world to know when it is safe to just
+    copy one of these.  I believe the hooks are in place for changing
+    the InfoPtr on a MutableByteArray when it's frozen to a ByteArray
+    if we want to do so.
+
+DynamicRep == DYN
+    Never generated by the compiler, and only used in the RTS for
+    PAPs and the Stable Pointer table.  PAPs are non-primitive,
+    non-updatable, normal-form objects, but the SPT is a primitive,
+    mutable object.  At the moment, there is no SPT in the parallel
+    world.  Presumably, it would be possible to have an SPT on each
+    processor, and we could identify a stable pointer as a (processor,
+    SPT-entry) pair, but would it be worth it?
+
+MuTupleRep == MUTUPLE
+    Never generated by the compiler, and only used in the RTS when
+    mutuples *do* require special attention at GC time.
+    When it is used, it is a primitive object (never entered).
+    Always mutable...there is an IMMUTUPLE in the RTS, but no
+    corresponding type in the compiler.
+
+--jim
+-}
+
 instance Eq SMRep where
     (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2)
                                                               && a1 == a2 && b1 == b2
 instance Eq SMRep where
     (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2)
                                                               && a1 == a2 && b1 == b2
@@ -137,8 +183,8 @@ tagOf_SMRep PhantomRep                   = ILIT(8)
 tagOf_SMRep (MuTupleRep _)          = ILIT(9)
 
 instance Text SMRep where
 tagOf_SMRep (MuTupleRep _)          = ILIT(9)
 
 instance Text SMRep where
-    showsPrec d rep rest
-      = (case rep of
+    showsPrec d rep
+      = showString (case rep of
           StaticRep _ _                         -> "STATIC"
           SpecialisedRep kind _ _ SMNormalForm  -> "SPEC_N"
           SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S"
           StaticRep _ _                         -> "STATIC"
           SpecialisedRep kind _ _ SMNormalForm  -> "SPEC_N"
           SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S"
@@ -146,12 +192,12 @@ instance Text SMRep where
           GenericRep _ _ SMNormalForm           -> "GEN_N"
           GenericRep _ _ SMSingleEntry          -> "GEN_S"
           GenericRep _ _ SMUpdatable            -> "GEN_U"
           GenericRep _ _ SMNormalForm           -> "GEN_N"
           GenericRep _ _ SMSingleEntry          -> "GEN_S"
           GenericRep _ _ SMUpdatable            -> "GEN_U"
-          BigTupleRep _                 -> "TUPLE"
-          DataRep       _               -> "DATA"
-          DynamicRep                    -> "DYN"
-          BlackHoleRep                  -> "BH"
-          PhantomRep                    -> "INREGS"
-          MuTupleRep _                  -> "MUTUPLE") ++ rest
+          BigTupleRep _                         -> "TUPLE"
+          DataRep       _                       -> "DATA"
+          DynamicRep                            -> "DYN"
+          BlackHoleRep                          -> "BH"
+          PhantomRep                            -> "INREGS"
+          MuTupleRep _                          -> "MUTUPLE")
 
 instance Outputable SMRep where
     ppr sty rep = ppStr (show rep)
 
 instance Outputable SMRep where
     ppr sty rep = ppStr (show rep)
index fbc7e7a..663fad9 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AnnCoreSyn where
 import BasicLit(BasicLit)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AnnCoreSyn where
 import BasicLit(BasicLit)
-import Class(Class)
 import CoreSyn(CoreAtom, CoreExpr)
 import CoreSyn(CoreAtom, CoreExpr)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Maybes(Labda)
-import NameTypes(FullName, ShortName)
+import CostCentre(CostCentre)
+import Id(Id)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
-import TyCon(TyCon, cmpTyCon)
-import TyVar(TyVar, TyVarTemplate, cmpTyVar)
-import UniType(UniType, cmpUniType)
-import Unique(Unique)
+import TyCon(TyCon)
+import TyVar(TyVar)
+import UniType(UniType)
 data AnnCoreBinding a b c   = AnnCoNonRec a (c, AnnCoreExpr' a b c) | AnnCoRec [(a, (c, AnnCoreExpr' a b c))]
 data AnnCoreCaseAlternatives a b c   = AnnCoAlgAlts [(Id, [a], (c, AnnCoreExpr' a b c))] (AnnCoreCaseDefault a b c) | AnnCoPrimAlts [(BasicLit, (c, AnnCoreExpr' a b c))] (AnnCoreCaseDefault a b c)
 data AnnCoreCaseDefault a b c   = AnnCoNoDefault | AnnCoBindDefault a (c, AnnCoreExpr' a b c)
 type AnnCoreExpr a b c = (c, AnnCoreExpr' a b c)
 data AnnCoreExpr' a b c   = AnnCoVar b | AnnCoLit BasicLit | AnnCoCon Id [UniType] [CoreAtom b] | AnnCoPrim PrimOp [UniType] [CoreAtom b] | AnnCoLam [a] (c, AnnCoreExpr' a b c) | AnnCoTyLam TyVar (c, AnnCoreExpr' a b c) | AnnCoApp (c, AnnCoreExpr' a b c) (CoreAtom b) | AnnCoTyApp (c, AnnCoreExpr' a b c) UniType | AnnCoCase (c, AnnCoreExpr' a b c) (AnnCoreCaseAlternatives a b c) | AnnCoLet (AnnCoreBinding a b c) (c, AnnCoreExpr' a b c) | AnnCoSCC CostCentre (c, AnnCoreExpr' a b c)
 data AnnCoreBinding a b c   = AnnCoNonRec a (c, AnnCoreExpr' a b c) | AnnCoRec [(a, (c, AnnCoreExpr' a b c))]
 data AnnCoreCaseAlternatives a b c   = AnnCoAlgAlts [(Id, [a], (c, AnnCoreExpr' a b c))] (AnnCoreCaseDefault a b c) | AnnCoPrimAlts [(BasicLit, (c, AnnCoreExpr' a b c))] (AnnCoreCaseDefault a b c)
 data AnnCoreCaseDefault a b c   = AnnCoNoDefault | AnnCoBindDefault a (c, AnnCoreExpr' a b c)
 type AnnCoreExpr a b c = (c, AnnCoreExpr' a b c)
 data AnnCoreExpr' a b c   = AnnCoVar b | AnnCoLit BasicLit | AnnCoCon Id [UniType] [CoreAtom b] | AnnCoPrim PrimOp [UniType] [CoreAtom b] | AnnCoLam [a] (c, AnnCoreExpr' a b c) | AnnCoTyLam TyVar (c, AnnCoreExpr' a b c) | AnnCoApp (c, AnnCoreExpr' a b c) (CoreAtom b) | AnnCoTyApp (c, AnnCoreExpr' a b c) UniType | AnnCoCase (c, AnnCoreExpr' a b c) (AnnCoreCaseAlternatives a b c) | AnnCoLet (AnnCoreBinding a b c) (c, AnnCoreExpr' a b c) | AnnCoSCC CostCentre (c, AnnCoreExpr' a b c)
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-cmpTyCon :: TyCon -> TyCon -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpTyVar :: TyVar -> TyVar -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpUniType :: Bool -> UniType -> UniType -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
+data BasicLit 
+data CostCentre 
+data Id 
+data PrimOp 
+data TyCon 
+data TyVar 
+data UniType 
 deAnnotate :: (a, AnnCoreExpr' b c a) -> CoreExpr b c
 deAnnotate :: (a, AnnCoreExpr' b c a) -> CoreExpr b c
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq BasicLit
 instance Eq BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool)] [_CONSTM_ Eq (==) (BasicLit), _CONSTM_ Eq (/=) (BasicLit)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq PrimOp
 instance Eq PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq TyCon
 instance Eq TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVar
 instance Eq TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool)] [_CONSTM_ Eq (==) (TyVar), _CONSTM_ Eq (/=) (TyVar)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq UniType
 instance Eq UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UniType -> UniType -> Bool), (UniType -> UniType -> Bool)] [_CONSTM_ Eq (==) (UniType), _CONSTM_ Eq (/=) (UniType)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord BasicLit
 instance Ord BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq BasicLit}}, (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> _CMP_TAG)] [_DFUN_ Eq (BasicLit), _CONSTM_ Ord (<) (BasicLit), _CONSTM_ Ord (<=) (BasicLit), _CONSTM_ Ord (>=) (BasicLit), _CONSTM_ Ord (>) (BasicLit), _CONSTM_ Ord max (BasicLit), _CONSTM_ Ord min (BasicLit), _CONSTM_ Ord _tagCmp (BasicLit)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyCon
 instance Ord TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVar
 instance Ord TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVar}}, (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> _CMP_TAG)] [_DFUN_ Eq (TyVar), _CONSTM_ Ord (<) (TyVar), _CONSTM_ Ord (<=) (TyVar), _CONSTM_ Ord (>=) (TyVar), _CONSTM_ Ord (>) (TyVar), _CONSTM_ Ord max (TyVar), _CONSTM_ Ord min (TyVar), _CONSTM_ Ord _tagCmp (TyVar)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance NamedThing TyCon
 instance NamedThing TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance NamedThing TyVar
 instance NamedThing TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVar -> ExportFlag), (TyVar -> Bool), (TyVar -> (_PackedString, _PackedString)), (TyVar -> _PackedString), (TyVar -> [_PackedString]), (TyVar -> SrcLoc), (TyVar -> Unique), (TyVar -> Bool), (TyVar -> UniType), (TyVar -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVar), _CONSTM_ NamedThing isLocallyDefined (TyVar), _CONSTM_ NamedThing getOrigName (TyVar), _CONSTM_ NamedThing getOccurrenceName (TyVar), _CONSTM_ NamedThing getInformingModules (TyVar), _CONSTM_ NamedThing getSrcLoc (TyVar), _CONSTM_ NamedThing getTheUnique (TyVar), _CONSTM_ NamedThing hasType (TyVar), _CONSTM_ NamedThing getType (TyVar), _CONSTM_ NamedThing fromPreludeCore (TyVar)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVar" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar UserTyVar (u1 :: Unique) (u2 :: ShortName) -> case u2 of { _ALG_ _ORIG_ NameTypes ShortName (u3 :: _PackedString) (u4 :: SrcLoc) -> u4; _NO_DEFLT_ }; (u5 :: TyVar) -> _ORIG_ SrcLoc mkUnknownSrcLoc } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar PolySysTyVar (u1 :: Unique) -> u1; _ORIG_ TyVar PrimSysTyVar (u2 :: Unique) -> u2; _ORIG_ TyVar OpenSysTyVar (u3 :: Unique) -> u3; _ORIG_ TyVar UserTyVar (u4 :: Unique) (u5 :: ShortName) -> u4; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ False [] [] _N_ #-}
 instance Outputable BasicLit
 instance Outputable BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BasicLit) _N_
-        ppr = _A_ 0 _U_ 2122 _N_ _N_ _N_ _N_ #-}
 instance Outputable PrimOp
 instance Outputable PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-}
 instance Outputable TyCon
 instance Outputable TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVar
 instance Outputable TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVar) _N_
-        ppr = _A_ 2 _U_ 1122 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable UniType
 instance Outputable UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_ #-}
 
 
index 3cef698..2abb196 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CoreFuns where
 import BasicLit(BasicLit)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CoreFuns where
 import BasicLit(BasicLit)
-import Class(Class)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(IdInfo)
 import Maybes(Labda)
 import PrimOps(PrimOp)
 import Maybes(Labda)
 import PrimOps(PrimOp)
-import SplitUniq(SplitUniqSupply)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import TyVarEnv(TyVarEnv(..))
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(UniqSM(..), Unique, UniqueSupply)
 import TyVarEnv(TyVarEnv(..))
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(UniqSM(..), Unique, UniqueSupply)
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CoreAtom a 
+data CoreExpr a b 
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 type TyVarEnv a = UniqFM a
 type TyVarEnv a = UniqFM a
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniType 
+data UniqFM a 
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data Unique 
+data UniqueSupply 
 atomToExpr :: CoreAtom b -> CoreExpr a b
 atomToExpr :: CoreAtom b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: CoreAtom u1) -> case u2 of { _ALG_ _ORIG_ CoreSyn CoVarAtom (u3 :: u1) -> _!_ _ORIG_ CoreSyn CoVar [u0, u1] [u3]; _ORIG_ CoreSyn CoLitAtom (u4 :: BasicLit) -> _!_ _ORIG_ CoreSyn CoLit [u0, u1] [u4]; _NO_DEFLT_ } _N_ #-}
 bindersOf :: CoreBinding b a -> [b]
 bindersOf :: CoreBinding b a -> [b]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 coreExprArity :: (Id -> Labda (CoreExpr a Id)) -> CoreExpr a Id -> Int
 coreExprArity :: (Id -> Labda (CoreExpr a Id)) -> CoreExpr a Id -> Int
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 digForLambdas :: CoreExpr a b -> ([TyVar], [a], CoreExpr a b)
 digForLambdas :: CoreExpr a b -> ([TyVar], [a], CoreExpr a b)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 escErrorMsg :: [Char] -> [Char]
 escErrorMsg :: [Char] -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 exprSmallEnoughToDup :: CoreExpr a Id -> Bool
 exprSmallEnoughToDup :: CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instCoreBindings :: UniqueSupply -> [CoreBinding Id Id] -> (UniqueSupply, [CoreBinding Id Id])
 instCoreBindings :: UniqueSupply -> [CoreBinding Id Id] -> (UniqueSupply, [CoreBinding Id Id])
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 instCoreExpr :: UniqueSupply -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
 instCoreExpr :: UniqueSupply -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 isWrapperFor :: CoreExpr Id Id -> Id -> Bool
 isWrapperFor :: CoreExpr Id Id -> Id -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 manifestlyBottom :: CoreExpr a Id -> Bool
 manifestlyBottom :: CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 manifestlyWHNF :: CoreExpr a Id -> Bool
 manifestlyWHNF :: CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 maybeErrorApp :: CoreExpr a Id -> Labda UniType -> Labda (CoreExpr a Id)
 maybeErrorApp :: CoreExpr a Id -> Labda UniType -> Labda (CoreExpr a Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoApps :: CoreExpr Id Id -> [CoreExpr Id Id] -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
 mkCoApps :: CoreExpr Id Id -> [CoreExpr Id Id] -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 mkCoLam :: [a] -> CoreExpr a b -> CoreExpr a b
 mkCoLam :: [a] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 mkCoLetAny :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetAny :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetNoUnboxed :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetNoUnboxed :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetUnboxedToCase :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetUnboxedToCase :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetrecAny :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetrecAny :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetrecNoUnboxed :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetrecNoUnboxed :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetsAny :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetsAny :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: [CoreBinding Id Id]) (u1 :: CoreExpr Id Id) -> case u0 of { _ALG_ (:) (u2 :: CoreBinding Id Id) (u3 :: [CoreBinding Id Id]) -> _APP_  _TYAPP_  _TYAPP_  foldr { (CoreBinding Id Id) } { (CoreExpr Id Id) } [ _ORIG_ CoreFuns mkCoLetAny, u1, u0 ]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkCoLetsNoUnboxed :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetsNoUnboxed :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: [CoreBinding Id Id]) (u1 :: CoreExpr Id Id) -> case u0 of { _ALG_ (:) (u2 :: CoreBinding Id Id) (u3 :: [CoreBinding Id Id]) -> _APP_  _TYAPP_  _TYAPP_  foldr { (CoreBinding Id Id) } { (CoreExpr Id Id) } [ _ORIG_ CoreFuns mkCoLetNoUnboxed, u1, u0 ]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkCoLetsUnboxedToCase :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetsUnboxedToCase :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: [CoreBinding Id Id]) (u1 :: CoreExpr Id Id) -> case u0 of { _ALG_ (:) (u2 :: CoreBinding Id Id) (u3 :: [CoreBinding Id Id]) -> _APP_  _TYAPP_  _TYAPP_  foldr { (CoreBinding Id Id) } { (CoreExpr Id Id) } [ _ORIG_ CoreFuns mkCoLetUnboxedToCase, u1, u0 ]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkCoTyApps :: CoreExpr a b -> [UniType] -> CoreExpr a b
 mkCoTyApps :: CoreExpr a b -> [UniType] -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 mkCoTyLam :: [TyVar] -> CoreExpr a b -> CoreExpr a b
 mkCoTyLam :: [TyVar] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoreIfThenElse :: CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id
 mkCoreIfThenElse :: CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 mkErrorCoApp :: UniType -> Id -> [Char] -> CoreExpr Id Id
 mkErrorCoApp :: UniType -> Id -> [Char] -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 mkFunction :: [TyVar] -> [a] -> CoreExpr a b -> CoreExpr a b
 mkFunction :: [TyVar] -> [a] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 nonErrorRHSs :: CoreCaseAlternatives a Id -> [CoreExpr a Id]
 nonErrorRHSs :: CoreCaseAlternatives a Id -> [CoreExpr a Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 pairsFromCoreBinds :: [CoreBinding a b] -> [(a, CoreExpr a b)]
 pairsFromCoreBinds :: [CoreBinding a b] -> [(a, CoreExpr a b)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 squashableDictishCcExpr :: CostCentre -> CoreExpr a b -> Bool
 squashableDictishCcExpr :: CostCentre -> CoreExpr a b -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 substCoreExpr :: UniqueSupply -> UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
 substCoreExpr :: UniqueSupply -> UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "LSLL" _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: UniqueSupply) (u1 :: UniqFM (CoreExpr Id Id)) (u2 :: UniqFM UniType) (u3 :: CoreExpr Id Id) -> _APP_  _ORIG_ CoreFuns substCoreExprUS [ u1, u2, u3, u0 ] _N_ #-}
 substCoreExprUS :: UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
 substCoreExprUS :: UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 3 _U_ 2222 _N_ _S_ "SLL" _N_ _N_ #-}
 typeOfCoreAlts :: CoreCaseAlternatives Id Id -> UniType
 typeOfCoreAlts :: CoreCaseAlternatives Id Id -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 typeOfCoreExpr :: CoreExpr Id Id -> UniType
 typeOfCoreExpr :: CoreExpr Id Id -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 unTagBinders :: CoreExpr (Id, a) b -> CoreExpr Id b
 unTagBinders :: CoreExpr (Id, a) b -> CoreExpr Id b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 unTagBindersAlts :: CoreCaseAlternatives (Id, a) b -> CoreCaseAlternatives Id b
 unTagBindersAlts :: CoreCaseAlternatives (Id, a) b -> CoreCaseAlternatives Id b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 
 
index 38d4f0d..0bd7297 100644 (file)
@@ -3,29 +3,23 @@ interface CoreLift where
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreBinding(..), PlainCoreExpr(..))
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import TyVar(TyVar)
 import UniType(UniType)
 import Unique(Unique)
 import PlainCore(PlainCoreBinding(..), PlainCoreExpr(..))
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import TyVar(TyVar)
 import UniType(UniType)
 import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
 type PlainCoreBinding = CoreBinding Id Id
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreBinding = CoreBinding Id Id
 type PlainCoreExpr = CoreExpr Id Id
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data SplitUniqSupply 
+data Unique 
 applyBindUnlifts :: [CoreExpr Id Id -> CoreExpr Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 applyBindUnlifts :: [CoreExpr Id Id -> CoreExpr Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 bindUnlift :: Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id
 bindUnlift :: Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 liftCoreBindings :: SplitUniqSupply -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 liftCoreBindings :: SplitUniqSupply -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 liftExpr :: Id -> CoreExpr Id Id -> CoreExpr Id Id
 liftExpr :: Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkLiftedId :: Id -> Unique -> (Id, Id)
 mkLiftedId :: Id -> Unique -> (Id, Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index aa9ebfe..81f152d 100644 (file)
@@ -2,19 +2,14 @@
 interface CoreLint where
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreBinding, CoreExpr)
 interface CoreLint where
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreBinding, CoreExpr)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreBinding(..))
 import Pretty(PprStyle)
 import SrcLoc(SrcLoc)
 import PlainCore(PlainCoreBinding(..))
 import Pretty(PprStyle)
 import SrcLoc(SrcLoc)
-import UniType(UniType)
-import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CoreBinding a b 
+data Id 
 type PlainCoreBinding = CoreBinding Id Id
 type PlainCoreBinding = CoreBinding Id Id
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 lintCoreBindings :: PprStyle -> [Char] -> Bool -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 lintCoreBindings :: PprStyle -> [Char] -> Bool -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LLLS" _N_ _N_ #-}
 lintUnfolding :: SrcLoc -> CoreExpr Id Id -> CoreExpr Id Id
 lintUnfolding :: SrcLoc -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 7454e8d..e874553 100644 (file)
@@ -2,13 +2,10 @@
 interface CoreSyn where
 import BasicLit(BasicLit)
 import CharSeq(CSeq)
 interface CoreSyn where
 import BasicLit(BasicLit)
 import CharSeq(CSeq)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import CmdLineOpts(GlobalSwitch)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import CostCentre(CostCentre)
+import Id(Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName, ShortName)
 import Outputable(Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Outputable(Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
@@ -16,48 +13,34 @@ import Pretty(Delay, PprStyle, PrettyRep)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import TyCon(TyCon)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniType(UniType)
-import Unique(Unique)
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
+data BasicLit 
 data CoreArg a   = TypeArg UniType | ValArg (CoreAtom a)
 data CoreAtom a   = CoVarAtom a | CoLitAtom BasicLit
 data CoreBinding a b   = CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)]
 data CoreCaseAlternatives a b   = CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b)
 data CoreCaseDefault a b   = CoNoDefault | CoBindDefault a (CoreExpr a b)
 data CoreExpr a b   = CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b)
 data CoreArg a   = TypeArg UniType | ValArg (CoreAtom a)
 data CoreAtom a   = CoVarAtom a | CoLitAtom BasicLit
 data CoreBinding a b   = CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)]
 data CoreCaseAlternatives a b   = CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b)
 data CoreCaseDefault a b   = CoNoDefault | CoBindDefault a (CoreExpr a b)
 data CoreExpr a b   = CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b)
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data CostCentre 
+data Id 
+data Labda a 
+data PprStyle 
+data PrettyRep 
+data PrimOp 
+data TyCon 
+data TyVar 
+data UniType 
 applyToArgs :: CoreExpr a b -> [CoreArg b] -> CoreExpr a b
 applyToArgs :: CoreExpr a b -> [CoreArg b] -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 collectArgs :: CoreExpr a b -> (CoreExpr a b, [CoreArg b])
 collectArgs :: CoreExpr a b -> (CoreExpr a b, [CoreArg b])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 decomposeArgs :: [CoreArg a] -> ([UniType], [CoreAtom a], [CoreArg a])
 decomposeArgs :: [CoreArg a] -> ([UniType], [CoreAtom a], [CoreArg a])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkCoTyApp :: CoreExpr a b -> UniType -> CoreExpr a b
 mkCoTyApp :: CoreExpr a b -> UniType -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 2 2 XX 3 _/\_ u0 u1 -> \ (u2 :: CoreExpr u0 u1) (u3 :: UniType) -> _!_ _ORIG_ CoreSyn CoTyApp [u0, u1] [u2, u3] _N_ #-}
 pprCoreBinding :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreBinding a b -> Int -> Bool -> PrettyRep
 pprCoreBinding :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreBinding a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222122 _N_ _S_ "LLLLS" _N_ _N_ #-}
 pprCoreExpr :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreExpr a b -> Int -> Bool -> PrettyRep
 pprCoreExpr :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreExpr a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _S_ "LLLLS" _N_ _N_ #-}
 instance Outputable a => Outputable (CoreArg a)
 instance Outputable a => Outputable (CoreArg a)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (CoreAtom a)
 instance Outputable a => Outputable (CoreAtom a)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreBinding a b)
 instance (Outputable a, Outputable b) => Outputable (CoreBinding a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _F_ _IF_ARGS_ 2 4 XXXX 6 _/\_ u0 u1 -> \ (u2 :: {{Outputable u0}}) (u3 :: {{Outputable u1}}) (u4 :: PprStyle) (u5 :: CoreBinding u0 u1) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ CoreSyn pprCoreBinding { u0 } { u1 } [ u4, u2, u2, u3, u5 ] _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreCaseAlternatives a b)
 instance (Outputable a, Outputable b) => Outputable (CoreCaseAlternatives a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreCaseDefault a b)
 instance (Outputable a, Outputable b) => Outputable (CoreCaseDefault a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreExpr a b)
 instance (Outputable a, Outputable b) => Outputable (CoreExpr a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _F_ _IF_ARGS_ 2 4 XXXX 6 _/\_ u0 u1 -> \ (u2 :: {{Outputable u0}}) (u3 :: {{Outputable u1}}) (u4 :: PprStyle) (u5 :: CoreExpr u0 u1) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ CoreSyn pprCoreExpr { u0 } { u1 } [ u4, u2, u2, u3, u5 ] _N_ #-}
 
 
index 41c263d..26619fc 100644 (file)
@@ -7,9 +7,6 @@ import Pretty(PrettyRep)
 import SimplEnv(UnfoldingGuidance)
 import TyCon(TyCon)
 calcUnfoldingGuidance :: Bool -> Int -> CoreExpr Id Id -> UnfoldingGuidance
 import SimplEnv(UnfoldingGuidance)
 import TyCon(TyCon)
 calcUnfoldingGuidance :: Bool -> Int -> CoreExpr Id Id -> UnfoldingGuidance
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LLS" _N_ _N_ #-}
 mentionedInUnfolding :: (a -> Id) -> CoreExpr a Id -> ([Id], [TyCon], [Class], Bool)
 mentionedInUnfolding :: (a -> Id) -> CoreExpr a Id -> ([Id], [TyCon], [Class], Bool)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 pprCoreUnfolding :: CoreExpr Id Id -> Int -> Bool -> PrettyRep
 pprCoreUnfolding :: CoreExpr Id Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index ca22a00..6f87f67 100644 (file)
@@ -2,40 +2,32 @@
 interface FreeVars where
 import AnnCoreSyn(AnnCoreBinding, AnnCoreCaseAlternatives, AnnCoreCaseDefault, AnnCoreExpr', AnnCoreExpr(..))
 import BasicLit(BasicLit)
 interface FreeVars where
 import AnnCoreSyn(AnnCoreBinding, AnnCoreCaseAlternatives, AnnCoreCaseDefault, AnnCoreExpr', AnnCoreExpr(..))
 import BasicLit(BasicLit)
-import Class(Class)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PrimOps(PrimOp)
 import PrimOps(PrimOp)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(IdSet(..), TyVarSet(..), UniqSet(..))
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(IdSet(..), TyVarSet(..), UniqSet(..))
-import Unique(Unique)
-data AnnCoreBinding a b c      {-# GHC_PRAGMA AnnCoNonRec a (c, AnnCoreExpr' a b c) | AnnCoRec [(a, (c, AnnCoreExpr' a b c))] #-}
-data AnnCoreCaseAlternatives a b c     {-# GHC_PRAGMA AnnCoAlgAlts [(Id, [a], (c, AnnCoreExpr' a b c))] (AnnCoreCaseDefault a b c) | AnnCoPrimAlts [(BasicLit, (c, AnnCoreExpr' a b c))] (AnnCoreCaseDefault a b c) #-}
-data AnnCoreCaseDefault a b c  {-# GHC_PRAGMA AnnCoNoDefault | AnnCoBindDefault a (c, AnnCoreExpr' a b c) #-}
+data AnnCoreBinding a b c 
+data AnnCoreCaseAlternatives a b c 
+data AnnCoreCaseDefault a b c 
 type AnnCoreExpr a b c = (c, AnnCoreExpr' a b c)
 type AnnCoreExpr a b c = (c, AnnCoreExpr' a b c)
-data AnnCoreExpr' a b c        {-# GHC_PRAGMA AnnCoVar b | AnnCoLit BasicLit | AnnCoCon Id [UniType] [CoreAtom b] | AnnCoPrim PrimOp [UniType] [CoreAtom b] | AnnCoLam [a] (c, AnnCoreExpr' a b c) | AnnCoTyLam TyVar (c, AnnCoreExpr' a b c) | AnnCoApp (c, AnnCoreExpr' a b c) (CoreAtom b) | AnnCoTyApp (c, AnnCoreExpr' a b c) UniType | AnnCoCase (c, AnnCoreExpr' a b c) (AnnCoreCaseAlternatives a b c) | AnnCoLet (AnnCoreBinding a b c) (c, AnnCoreExpr' a b c) | AnnCoSCC CostCentre (c, AnnCoreExpr' a b c) #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
+data AnnCoreExpr' a b c 
+data CoreExpr a b 
 type CoreExprWithFVs = (FVInfo, AnnCoreExpr' Id Id FVInfo)
 type FVCoreBinding = CoreBinding (Id, UniqFM Id) Id
 type FVCoreExpr = CoreExpr (Id, UniqFM Id) Id
 data FVInfo   = FVInfo (UniqFM Id) (UniqFM TyVar) LeakInfo
 type CoreExprWithFVs = (FVInfo, AnnCoreExpr' Id Id FVInfo)
 type FVCoreBinding = CoreBinding (Id, UniqFM Id) Id
 type FVCoreExpr = CoreExpr (Id, UniqFM Id) Id
 data FVInfo   = FVInfo (UniqFM Id) (UniqFM TyVar) LeakInfo
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data Id 
+data UniType 
 type IdSet = UniqFM Id
 data LeakInfo   = MightLeak | LeakFree Int
 type TyVarSet = UniqFM TyVar
 type UniqSet a = UniqFM a
 addTopBindsFVs :: (UniqFM Id -> Id -> Bool) -> [CoreBinding Id Id] -> ([CoreBinding (Id, UniqFM Id) Id], UniqFM Id)
 type IdSet = UniqFM Id
 data LeakInfo   = MightLeak | LeakFree Int
 type TyVarSet = UniqFM TyVar
 type UniqSet a = UniqFM a
 addTopBindsFVs :: (UniqFM Id -> Id -> Bool) -> [CoreBinding Id Id] -> ([CoreBinding (Id, UniqFM Id) Id], UniqFM Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 freeTyVarsOf :: (FVInfo, AnnCoreExpr' Id Id FVInfo) -> UniqFM TyVar
 freeTyVarsOf :: (FVInfo, AnnCoreExpr' Id Id FVInfo) -> UniqFM TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(ASA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniqFM TyVar) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: (FVInfo, AnnCoreExpr' Id Id FVInfo)) -> case u0 of { _ALG_ _TUP_2 (u1 :: FVInfo) (u2 :: AnnCoreExpr' Id Id FVInfo) -> case u1 of { _ALG_ _ORIG_ FreeVars FVInfo (u3 :: UniqFM Id) (u4 :: UniqFM TyVar) (u5 :: LeakInfo) -> u4; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 freeVars :: CoreExpr Id Id -> (FVInfo, AnnCoreExpr' Id Id FVInfo)
 freeVars :: CoreExpr Id Id -> (FVInfo, AnnCoreExpr' Id Id FVInfo)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 freeVarsOf :: (FVInfo, AnnCoreExpr' Id Id FVInfo) -> UniqFM Id
 freeVarsOf :: (FVInfo, AnnCoreExpr' Id Id FVInfo) -> UniqFM Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(SAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniqFM Id) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: (FVInfo, AnnCoreExpr' Id Id FVInfo)) -> case u0 of { _ALG_ _TUP_2 (u1 :: FVInfo) (u2 :: AnnCoreExpr' Id Id FVInfo) -> case u1 of { _ALG_ _ORIG_ FreeVars FVInfo (u3 :: UniqFM Id) (u4 :: UniqFM TyVar) (u5 :: LeakInfo) -> u3; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 
 
index 842fb14..d55bf95 100644 (file)
@@ -2,92 +2,66 @@
 interface PlainCore where
 import Bag(Bag)
 import BasicLit(BasicLit)
 interface PlainCore where
 import Bag(Bag)
 import BasicLit(BasicLit)
-import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
+import BinderInfo(BinderInfo)
 import CharSeq(CSeq)
 import CharSeq(CSeq)
-import Class(Class, ClassOp, cmpClass)
+import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import CoreFuns(atomToExpr, bindersOf, coreExprArity, digForLambdas, escErrorMsg, exprSmallEnoughToDup, instCoreBindings, instCoreExpr, isWrapperFor, manifestlyBottom, manifestlyWHNF, maybeErrorApp, mkCoApps, mkCoLam, mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase, mkCoLetrecAny, mkCoLetrecNoUnboxed, mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase, mkCoTyApps, mkCoTyLam, mkCoreIfThenElse, mkErrorCoApp, mkFunction, nonErrorRHSs, pairsFromCoreBinds, squashableDictishCcExpr, substCoreExpr, substCoreExprUS, typeOfCoreAlts, typeOfCoreExpr)
 import CoreSyn(CoreArg(..), CoreAtom(..), CoreBinding(..), CoreCaseAlternatives(..), CoreCaseDefault(..), CoreExpr(..), applyToArgs, collectArgs, decomposeArgs, mkCoTyApp, pprCoreExpr)
 import CoreUnfold(calcUnfoldingGuidance, mentionedInUnfolding, pprCoreUnfolding)
 import CmdLineOpts(GlobalSwitch)
 import CoreFuns(atomToExpr, bindersOf, coreExprArity, digForLambdas, escErrorMsg, exprSmallEnoughToDup, instCoreBindings, instCoreExpr, isWrapperFor, manifestlyBottom, manifestlyWHNF, maybeErrorApp, mkCoApps, mkCoLam, mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase, mkCoLetrecAny, mkCoLetrecNoUnboxed, mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase, mkCoTyApps, mkCoTyLam, mkCoreIfThenElse, mkErrorCoApp, mkFunction, nonErrorRHSs, pairsFromCoreBinds, squashableDictishCcExpr, substCoreExpr, substCoreExprUS, typeOfCoreAlts, typeOfCoreExpr)
 import CoreSyn(CoreArg(..), CoreAtom(..), CoreBinding(..), CoreCaseAlternatives(..), CoreCaseDefault(..), CoreExpr(..), applyToArgs, collectArgs, decomposeArgs, mkCoTyApp, pprCoreExpr)
 import CoreUnfold(calcUnfoldingGuidance, mentionedInUnfolding, pprCoreUnfolding)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
+import CostCentre(CostCentre)
 import FreeVars(FVCoreBinding(..), FVCoreExpr(..), addTopBindsFVs)
 import FreeVars(FVCoreBinding(..), FVCoreExpr(..), addTopBindsFVs)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBTypeInfo, IdInfo, SpecEnv, StrictnessInfo, UpdateInfo)
-import InstEnv(InstTemplate)
+import IdInfo(Demand, IdInfo)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName, Provenance, ShortName)
+import NameTypes(FullName)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
-import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
-import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import PrimOps(PrimOp)
-import SimplEnv(UnfoldingDetails, UnfoldingGuidance)
-import SplitUniq(SplitUniqSupply)
+import SimplEnv(UnfoldingGuidance)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import TyVarEnv(TyVarEnv(..), TypeEnv(..))
 import TyVarEnv(TyVarEnv(..), TypeEnv(..))
-import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType, cmpUniType)
+import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType)
 import UniqFM(UniqFM)
 import UniqSet(IdSet(..), UniqSet(..))
 import UniqFM(UniqFM)
 import UniqSet(IdSet(..), UniqSet(..))
-import Unique(UniqSM(..), Unique, UniqueSupply, initUs)
+import Unique(UniqSM(..), Unique, UniqueSupply)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Bag a 
+data BasicLit 
+data BinderInfo 
+data Class 
 data CoreArg a   = TypeArg UniType | ValArg (CoreAtom a)
 data CoreAtom a   = CoVarAtom a | CoLitAtom BasicLit
 data CoreBinding a b   = CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)]
 data CoreCaseAlternatives a b   = CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b)
 data CoreCaseDefault a b   = CoNoDefault | CoBindDefault a (CoreExpr a b)
 data CoreExpr a b   = CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b)
 data CoreArg a   = TypeArg UniType | ValArg (CoreAtom a)
 data CoreAtom a   = CoVarAtom a | CoLitAtom BasicLit
 data CoreBinding a b   = CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)]
 data CoreCaseAlternatives a b   = CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b)
 data CoreCaseDefault a b   = CoNoDefault | CoBindDefault a (CoreExpr a b)
 data CoreExpr a b   = CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b)
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
+data CostCentre 
 type FVCoreBinding = CoreBinding (Id, UniqFM Id) Id
 type FVCoreExpr = CoreExpr (Id, UniqFM Id) Id
 type FVCoreBinding = CoreBinding (Id, UniqFM Id) Id
 type FVCoreExpr = CoreExpr (Id, UniqFM Id) Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data Demand    {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-}
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
+data Demand 
+data IdInfo 
+data Labda a 
+data FullName 
+data ExportFlag 
 type PlainCoreArg = CoreArg Id
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreBinding = CoreBinding Id Id
 type PlainCoreArg = CoreArg Id
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreBinding = CoreBinding Id Id
@@ -95,263 +69,99 @@ type PlainCoreCaseAlternatives = CoreCaseAlternatives Id Id
 type PlainCoreCaseDefault = CoreCaseDefault Id Id
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 type PlainCoreCaseDefault = CoreCaseDefault Id Id
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data UnfoldingGuidance         {-# GHC_PRAGMA UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
+data PrettyRep 
+data PrimOp 
+data UnfoldingGuidance 
+data SrcLoc 
+data TyCon 
+data TyVar 
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniType 
+data UniqFM a 
 type IdSet = UniqFM Id
 type UniqSet a = UniqFM a
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
 type IdSet = UniqFM Id
 type UniqSet a = UniqFM a
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
-cmpClass :: Class -> Class -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+data Unique 
+data UniqueSupply 
 atomToExpr :: CoreAtom b -> CoreExpr a b
 atomToExpr :: CoreAtom b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: CoreAtom u1) -> case u2 of { _ALG_ _ORIG_ CoreSyn CoVarAtom (u3 :: u1) -> _!_ _ORIG_ CoreSyn CoVar [u0, u1] [u3]; _ORIG_ CoreSyn CoLitAtom (u4 :: BasicLit) -> _!_ _ORIG_ CoreSyn CoLit [u0, u1] [u4]; _NO_DEFLT_ } _N_ #-}
 bindersOf :: CoreBinding b a -> [b]
 bindersOf :: CoreBinding b a -> [b]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 coreExprArity :: (Id -> Labda (CoreExpr a Id)) -> CoreExpr a Id -> Int
 coreExprArity :: (Id -> Labda (CoreExpr a Id)) -> CoreExpr a Id -> Int
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 digForLambdas :: CoreExpr a b -> ([TyVar], [a], CoreExpr a b)
 digForLambdas :: CoreExpr a b -> ([TyVar], [a], CoreExpr a b)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 escErrorMsg :: [Char] -> [Char]
 escErrorMsg :: [Char] -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 exprSmallEnoughToDup :: CoreExpr a Id -> Bool
 exprSmallEnoughToDup :: CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instCoreBindings :: UniqueSupply -> [CoreBinding Id Id] -> (UniqueSupply, [CoreBinding Id Id])
 instCoreBindings :: UniqueSupply -> [CoreBinding Id Id] -> (UniqueSupply, [CoreBinding Id Id])
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 instCoreExpr :: UniqueSupply -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
 instCoreExpr :: UniqueSupply -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 isWrapperFor :: CoreExpr Id Id -> Id -> Bool
 isWrapperFor :: CoreExpr Id Id -> Id -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 manifestlyBottom :: CoreExpr a Id -> Bool
 manifestlyBottom :: CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 manifestlyWHNF :: CoreExpr a Id -> Bool
 manifestlyWHNF :: CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 maybeErrorApp :: CoreExpr a Id -> Labda UniType -> Labda (CoreExpr a Id)
 maybeErrorApp :: CoreExpr a Id -> Labda UniType -> Labda (CoreExpr a Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoApps :: CoreExpr Id Id -> [CoreExpr Id Id] -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
 mkCoApps :: CoreExpr Id Id -> [CoreExpr Id Id] -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 mkCoLam :: [a] -> CoreExpr a b -> CoreExpr a b
 mkCoLam :: [a] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 mkCoLetAny :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetAny :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetNoUnboxed :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetNoUnboxed :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetUnboxedToCase :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetUnboxedToCase :: CoreBinding Id Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetrecAny :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetrecAny :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetrecNoUnboxed :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetrecNoUnboxed :: [(Id, CoreExpr Id Id)] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoLetsAny :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetsAny :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: [CoreBinding Id Id]) (u1 :: CoreExpr Id Id) -> case u0 of { _ALG_ (:) (u2 :: CoreBinding Id Id) (u3 :: [CoreBinding Id Id]) -> _APP_  _TYAPP_  _TYAPP_  foldr { (CoreBinding Id Id) } { (CoreExpr Id Id) } [ _ORIG_ CoreFuns mkCoLetAny, u1, u0 ]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkCoLetsNoUnboxed :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetsNoUnboxed :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: [CoreBinding Id Id]) (u1 :: CoreExpr Id Id) -> case u0 of { _ALG_ (:) (u2 :: CoreBinding Id Id) (u3 :: [CoreBinding Id Id]) -> _APP_  _TYAPP_  _TYAPP_  foldr { (CoreBinding Id Id) } { (CoreExpr Id Id) } [ _ORIG_ CoreFuns mkCoLetNoUnboxed, u1, u0 ]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkCoLetsUnboxedToCase :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLetsUnboxedToCase :: [CoreBinding Id Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: [CoreBinding Id Id]) (u1 :: CoreExpr Id Id) -> case u0 of { _ALG_ (:) (u2 :: CoreBinding Id Id) (u3 :: [CoreBinding Id Id]) -> _APP_  _TYAPP_  _TYAPP_  foldr { (CoreBinding Id Id) } { (CoreExpr Id Id) } [ _ORIG_ CoreFuns mkCoLetUnboxedToCase, u1, u0 ]; _NIL_  -> u1; _NO_DEFLT_ } _N_ #-}
 mkCoTyApps :: CoreExpr a b -> [UniType] -> CoreExpr a b
 mkCoTyApps :: CoreExpr a b -> [UniType] -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 mkCoTyLam :: [TyVar] -> CoreExpr a b -> CoreExpr a b
 mkCoTyLam :: [TyVar] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mkCoreIfThenElse :: CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id
 mkCoreIfThenElse :: CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id -> CoreExpr a Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 mkErrorCoApp :: UniType -> Id -> [Char] -> CoreExpr Id Id
 mkErrorCoApp :: UniType -> Id -> [Char] -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 mkFunction :: [TyVar] -> [a] -> CoreExpr a b -> CoreExpr a b
 mkFunction :: [TyVar] -> [a] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 nonErrorRHSs :: CoreCaseAlternatives a Id -> [CoreExpr a Id]
 nonErrorRHSs :: CoreCaseAlternatives a Id -> [CoreExpr a Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 pairsFromCoreBinds :: [CoreBinding a b] -> [(a, CoreExpr a b)]
 pairsFromCoreBinds :: [CoreBinding a b] -> [(a, CoreExpr a b)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-pprBigCoreBinder :: PprStyle -> Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
-pprPlainCoreBinding :: PprStyle -> CoreBinding Id Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
-pprTypedCoreBinder :: PprStyle -> Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 squashableDictishCcExpr :: CostCentre -> CoreExpr a b -> Bool
 squashableDictishCcExpr :: CostCentre -> CoreExpr a b -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 substCoreExpr :: UniqueSupply -> UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
 substCoreExpr :: UniqueSupply -> UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "LSLL" _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: UniqueSupply) (u1 :: UniqFM (CoreExpr Id Id)) (u2 :: UniqFM UniType) (u3 :: CoreExpr Id Id) -> _APP_  _ORIG_ CoreFuns substCoreExprUS [ u1, u2, u3, u0 ] _N_ #-}
 substCoreExprUS :: UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
 substCoreExprUS :: UniqFM (CoreExpr Id Id) -> UniqFM UniType -> CoreExpr Id Id -> UniqueSupply -> (UniqueSupply, CoreExpr Id Id)
-       {-# GHC_PRAGMA _A_ 3 _U_ 2222 _N_ _S_ "SLL" _N_ _N_ #-}
 typeOfCoreAlts :: CoreCaseAlternatives Id Id -> UniType
 typeOfCoreAlts :: CoreCaseAlternatives Id Id -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 typeOfCoreExpr :: CoreExpr Id Id -> UniType
 typeOfCoreExpr :: CoreExpr Id Id -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 applyToArgs :: CoreExpr a b -> [CoreArg b] -> CoreExpr a b
 applyToArgs :: CoreExpr a b -> [CoreArg b] -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 collectArgs :: CoreExpr a b -> (CoreExpr a b, [CoreArg b])
 collectArgs :: CoreExpr a b -> (CoreExpr a b, [CoreArg b])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 decomposeArgs :: [CoreArg a] -> ([UniType], [CoreAtom a], [CoreArg a])
 decomposeArgs :: [CoreArg a] -> ([UniType], [CoreAtom a], [CoreArg a])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkCoTyApp :: CoreExpr a b -> UniType -> CoreExpr a b
 mkCoTyApp :: CoreExpr a b -> UniType -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 2 2 XX 3 _/\_ u0 u1 -> \ (u2 :: CoreExpr u0 u1) (u3 :: UniType) -> _!_ _ORIG_ CoreSyn CoTyApp [u0, u1] [u2, u3] _N_ #-}
 pprCoreExpr :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreExpr a b -> Int -> Bool -> PrettyRep
 pprCoreExpr :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreExpr a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _S_ "LLLLS" _N_ _N_ #-}
 calcUnfoldingGuidance :: Bool -> Int -> CoreExpr Id Id -> UnfoldingGuidance
 calcUnfoldingGuidance :: Bool -> Int -> CoreExpr Id Id -> UnfoldingGuidance
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LLS" _N_ _N_ #-}
 mentionedInUnfolding :: (a -> Id) -> CoreExpr a Id -> ([Id], [TyCon], [Class], Bool)
 mentionedInUnfolding :: (a -> Id) -> CoreExpr a Id -> ([Id], [TyCon], [Class], Bool)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 pprCoreUnfolding :: CoreExpr Id Id -> Int -> Bool -> PrettyRep
 pprCoreUnfolding :: CoreExpr Id Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 addTopBindsFVs :: (UniqFM Id -> Id -> Bool) -> [CoreBinding Id Id] -> ([CoreBinding (Id, UniqFM Id) Id], UniqFM Id)
 addTopBindsFVs :: (UniqFM Id -> Id -> Bool) -> [CoreBinding Id Id] -> ([CoreBinding (Id, UniqFM Id) Id], UniqFM Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
-cmpUniType :: Bool -> UniType -> UniType -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
-initUs :: UniqueSupply -> (UniqueSupply -> (UniqueSupply, a)) -> (UniqueSupply, a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: UniqueSupply) (u2 :: UniqueSupply -> (UniqueSupply, u0)) -> _APP_  u2 [ u1 ] _N_ #-}
+pprBigCoreBinder :: PprStyle -> Id -> Int -> Bool -> PrettyRep
+pprPlainCoreBinding :: PprStyle -> CoreBinding Id Id -> Int -> Bool -> PrettyRep
+pprTypedCoreBinder :: PprStyle -> Id -> Int -> Bool -> PrettyRep
 instance Eq Class
 instance Eq Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Class -> Class -> Bool), (Class -> Class -> Bool)] [_CONSTM_ Eq (==) (Class), _CONSTM_ Eq (/=) (Class)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ eqInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Eq (/=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq Demand
 instance Eq Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Demand -> Demand -> Bool), (Demand -> Demand -> Bool)] [_CONSTM_ Eq (==) (Demand), _CONSTM_ Eq (/=) (Demand)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq UniType
 instance Eq UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UniType -> UniType -> Bool), (UniType -> UniType -> Bool)] [_CONSTM_ Eq (==) (UniType), _CONSTM_ Eq (/=) (UniType)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord Class
 instance Ord Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Class}}, (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Class), (Class -> Class -> Class), (Class -> Class -> _CMP_TAG)] [_DFUN_ Eq (Class), _CONSTM_ Ord (<) (Class), _CONSTM_ Ord (<=) (Class), _CONSTM_ Ord (>=) (Class), _CONSTM_ Ord (>) (Class), _CONSTM_ Ord max (Class), _CONSTM_ Ord min (Class), _CONSTM_ Ord _tagCmp (Class)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ ltInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ leInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord Demand
 instance Ord Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Demand}}, (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Demand), (Demand -> Demand -> Demand), (Demand -> Demand -> _CMP_TAG)] [_DFUN_ Eq (Demand), _CONSTM_ Ord (<) (Demand), _CONSTM_ Ord (<=) (Demand), _CONSTM_ Ord (>=) (Demand), _CONSTM_ Ord (>) (Demand), _CONSTM_ Ord max (Demand), _CONSTM_ Ord min (Demand), _CONSTM_ Ord _tagCmp (Demand)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Class
 instance NamedThing Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Class -> ExportFlag), (Class -> Bool), (Class -> (_PackedString, _PackedString)), (Class -> _PackedString), (Class -> [_PackedString]), (Class -> SrcLoc), (Class -> Unique), (Class -> Bool), (Class -> UniType), (Class -> Bool)] [_CONSTM_ NamedThing getExportFlag (Class), _CONSTM_ NamedThing isLocallyDefined (Class), _CONSTM_ NamedThing getOrigName (Class), _CONSTM_ NamedThing getOccurrenceName (Class), _CONSTM_ NamedThing getInformingModules (Class), _CONSTM_ NamedThing getSrcLoc (Class), _CONSTM_ NamedThing getTheUnique (Class), _CONSTM_ NamedThing hasType (Class), _CONSTM_ NamedThing getType (Class), _CONSTM_ NamedThing fromPreludeCore (Class)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(LLAAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [ub, uc]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(ALSAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAAAS)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ug; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Unique) } [ _NOREP_S_ "NamedThing.Class.getTheUnique", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Bool) } [ _NOREP_S_ "NamedThing.Class.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> UniType) } [ _NOREP_S_ "NamedThing.Class.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing FullName
 instance NamedThing FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(FullName -> ExportFlag), (FullName -> Bool), (FullName -> (_PackedString, _PackedString)), (FullName -> _PackedString), (FullName -> [_PackedString]), (FullName -> SrcLoc), (FullName -> Unique), (FullName -> Bool), (FullName -> UniType), (FullName -> Bool)] [_CONSTM_ NamedThing getExportFlag (FullName), _CONSTM_ NamedThing isLocallyDefined (FullName), _CONSTM_ NamedThing getOrigName (FullName), _CONSTM_ NamedThing getOccurrenceName (FullName), _CONSTM_ NamedThing getInformingModules (FullName), _CONSTM_ NamedThing getSrcLoc (FullName), _CONSTM_ NamedThing getTheUnique (FullName), _CONSTM_ NamedThing hasType (FullName), _CONSTM_ NamedThing getType (FullName), _CONSTM_ NamedThing fromPreludeCore (FullName)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAEAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ThisModule  -> _!_ True [] []; _ORIG_ NameTypes InventedInThisModule  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LLAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [u1, u2]; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(ALSAAA)" {_A_ 2 _U_ 11 _N_ _N_ _F_ _IF_ARGS_ 0 2 XC 10 \ (u0 :: _PackedString) (u1 :: Provenance) -> case u1 of { _ALG_ _ORIG_ NameTypes OtherPrelude (u2 :: _PackedString) -> u2; _ORIG_ NameTypes OtherModule (u3 :: _PackedString) (u4 :: [_PackedString]) -> u3; (u5 :: Provenance) -> u0 } _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ExportedByPreludeCore  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (a, b)
 instance (Outputable a, Outputable b) => Outputable (a, b)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-}
 instance Outputable Bool
 instance Outputable Bool
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Class
 instance Outputable Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Class) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(AU(LLLLAA)AAAAAAAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable a => Outputable (CoreArg a)
 instance Outputable a => Outputable (CoreArg a)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (CoreAtom a)
 instance Outputable a => Outputable (CoreAtom a)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreBinding a b)
 instance (Outputable a, Outputable b) => Outputable (CoreBinding a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _F_ _IF_ARGS_ 2 4 XXXX 6 _/\_ u0 u1 -> \ (u2 :: {{Outputable u0}}) (u3 :: {{Outputable u1}}) (u4 :: PprStyle) (u5 :: CoreBinding u0 u1) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ CoreSyn pprCoreBinding { u0 } { u1 } [ u4, u2, u2, u3, u5 ] _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreCaseAlternatives a b)
 instance (Outputable a, Outputable b) => Outputable (CoreCaseAlternatives a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreCaseDefault a b)
 instance (Outputable a, Outputable b) => Outputable (CoreCaseDefault a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreExpr a b)
 instance (Outputable a, Outputable b) => Outputable (CoreExpr a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _F_ _IF_ARGS_ 2 4 XXXX 6 _/\_ u0 u1 -> \ (u2 :: {{Outputable u0}}) (u3 :: {{Outputable u1}}) (u4 :: PprStyle) (u5 :: CoreExpr u0 u1) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ CoreSyn pprCoreExpr { u0 } { u1 } [ u4, u2, u2, u3, u5 ] _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable Demand
 instance Outputable Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Demand) _N_
-        ppr = _A_ 2 _U_ 0220 _N_ _S_ "AL" {_A_ 1 _U_ 220 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable FullName
 instance Outputable FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FullName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LLLLAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable UniType
 instance Outputable UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_ #-}
 instance Outputable a => Outputable [a]
 instance Outputable a => Outputable [a]
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Text Demand
 instance Text Demand
-       {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Demand, [Char])]), (Int -> Demand -> [Char] -> [Char]), ([Char] -> [([Demand], [Char])]), ([Demand] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Demand), _CONSTM_ Text showsPrec (Demand), _CONSTM_ Text readList (Demand), _CONSTM_ Text showList (Demand)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(Demand, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Demand) (u2 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> Demand -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_,
-        readList = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        showList = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index dab7658..966745c 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TaggedCore where
 import BasicLit(BasicLit)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TaggedCore where
 import BasicLit(BasicLit)
-import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
-import CharSeq(CSeq)
-import Class(Class)
+import BinderInfo(BinderInfo)
 import CmdLineOpts(GlobalSwitch)
 import CoreFuns(unTagBinders, unTagBindersAlts)
 import CoreSyn(CoreArg(..), CoreAtom(..), CoreBinding(..), CoreCaseAlternatives(..), CoreCaseDefault(..), CoreExpr(..), applyToArgs, collectArgs, decomposeArgs)
 import CmdLineOpts(GlobalSwitch)
 import CoreFuns(unTagBinders, unTagBindersAlts)
 import CoreSyn(CoreArg(..), CoreAtom(..), CoreBinding(..), CoreCaseAlternatives(..), CoreCaseDefault(..), CoreExpr(..), applyToArgs, collectArgs, decomposeArgs)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Maybes(Labda)
-import NameTypes(FullName, ShortName)
+import CostCentre(CostCentre)
+import Id(Id)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
-import PreludeRatio(Ratio(..))
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
-import PrimKind(PrimKind)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import PrimOps(PrimOp)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import PrimOps(PrimOp)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import Unique(Unique)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 import UniType(UniType)
 import Unique(Unique)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data BasicLit 
+data BinderInfo 
+data GlobalSwitch 
 data CoreArg a   = TypeArg UniType | ValArg (CoreAtom a)
 data CoreAtom a   = CoVarAtom a | CoLitAtom BasicLit
 data CoreBinding a b   = CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)]
 data CoreCaseAlternatives a b   = CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b)
 data CoreCaseDefault a b   = CoNoDefault | CoBindDefault a (CoreExpr a b)
 data CoreExpr a b   = CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b)
 data CoreArg a   = TypeArg UniType | ValArg (CoreAtom a)
 data CoreAtom a   = CoVarAtom a | CoLitAtom BasicLit
 data CoreBinding a b   = CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)]
 data CoreCaseAlternatives a b   = CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b)
 data CoreCaseDefault a b   = CoNoDefault | CoBindDefault a (CoreExpr a b)
 data CoreExpr a b   = CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b)
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data CostCentre 
+data Id 
+data ExportFlag 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
+data PrettyRep 
+data PrimOp 
 type SimplifiableBinder = (Id, BinderInfo)
 type SimplifiableCoreAtom = CoreAtom Id
 type SimplifiableCoreBinding = CoreBinding (Id, BinderInfo) Id
 type SimplifiableCoreCaseAlternatives = CoreCaseAlternatives (Id, BinderInfo) Id
 type SimplifiableCoreCaseDefault = CoreCaseDefault (Id, BinderInfo) Id
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
 type SimplifiableBinder = (Id, BinderInfo)
 type SimplifiableCoreAtom = CoreAtom Id
 type SimplifiableCoreBinding = CoreBinding (Id, BinderInfo) Id
 type SimplifiableCoreCaseAlternatives = CoreCaseAlternatives (Id, BinderInfo) Id
 type SimplifiableCoreCaseDefault = CoreCaseDefault (Id, BinderInfo) Id
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data SrcLoc 
 type TaggedBinder a = (Id, a)
 type TaggedCoreAtom a = CoreAtom Id
 type TaggedCoreBinding a = CoreBinding (Id, a) Id
 type TaggedCoreCaseAlternatives a = CoreCaseAlternatives (Id, a) Id
 type TaggedCoreCaseDefault a = CoreCaseDefault (Id, a) Id
 type TaggedCoreExpr a = CoreExpr (Id, a) Id
 type TaggedBinder a = (Id, a)
 type TaggedCoreAtom a = CoreAtom Id
 type TaggedCoreBinding a = CoreBinding (Id, a) Id
 type TaggedCoreCaseAlternatives a = CoreCaseAlternatives (Id, a) Id
 type TaggedCoreCaseDefault a = CoreCaseDefault (Id, a) Id
 type TaggedCoreExpr a = CoreExpr (Id, a) Id
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data TyCon 
+data TyVar 
+data UniType 
+data Unique 
 unTagBinders :: CoreExpr (Id, a) b -> CoreExpr Id b
 unTagBinders :: CoreExpr (Id, a) b -> CoreExpr Id b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 unTagBindersAlts :: CoreCaseAlternatives (Id, a) b -> CoreCaseAlternatives Id b
 unTagBindersAlts :: CoreCaseAlternatives (Id, a) b -> CoreCaseAlternatives Id b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 applyToArgs :: CoreExpr a b -> [CoreArg b] -> CoreExpr a b
 applyToArgs :: CoreExpr a b -> [CoreArg b] -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 collectArgs :: CoreExpr a b -> (CoreExpr a b, [CoreArg b])
 collectArgs :: CoreExpr a b -> (CoreExpr a b, [CoreArg b])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 decomposeArgs :: [CoreArg a] -> ([UniType], [CoreAtom a], [CoreArg a])
 decomposeArgs :: [CoreArg a] -> ([UniType], [CoreAtom a], [CoreArg a])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (a, b)
 instance (Outputable a, Outputable b) => Outputable (a, b)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-}
 instance Outputable BinderInfo
 instance Outputable BinderInfo
-       {-# GHC_PRAGMA _M_ BinderInfo {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BinderInfo) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Bool
 instance Outputable Bool
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable a => Outputable (CoreArg a)
 instance Outputable a => Outputable (CoreArg a)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable a => Outputable (CoreAtom a)
 instance Outputable a => Outputable (CoreAtom a)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreBinding a b)
 instance (Outputable a, Outputable b) => Outputable (CoreBinding a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _F_ _IF_ARGS_ 2 4 XXXX 6 _/\_ u0 u1 -> \ (u2 :: {{Outputable u0}}) (u3 :: {{Outputable u1}}) (u4 :: PprStyle) (u5 :: CoreBinding u0 u1) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ CoreSyn pprCoreBinding { u0 } { u1 } [ u4, u2, u2, u3, u5 ] _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreCaseAlternatives a b)
 instance (Outputable a, Outputable b) => Outputable (CoreCaseAlternatives a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreCaseDefault a b)
 instance (Outputable a, Outputable b) => Outputable (CoreCaseDefault a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (CoreExpr a b)
 instance (Outputable a, Outputable b) => Outputable (CoreExpr a b)
-       {-# GHC_PRAGMA _M_ CoreSyn {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _F_ _IF_ARGS_ 2 4 XXXX 6 _/\_ u0 u1 -> \ (u2 :: {{Outputable u0}}) (u3 :: {{Outputable u1}}) (u4 :: PprStyle) (u5 :: CoreExpr u0 u1) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ CoreSyn pprCoreExpr { u0 } { u1 } [ u4, u2, u2, u3, u5 ] _N_ #-}
 instance Outputable a => Outputable [a]
 instance Outputable a => Outputable [a]
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 457c148..564e214 100644 (file)
@@ -10,27 +10,23 @@ import HsLit(Literal)
 import HsMatches(Match)
 import HsPat(TypecheckedPat)
 import HsTypes(PolyType)
 import HsMatches(Match)
 import HsPat(TypecheckedPat)
 import HsTypes(PolyType)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Inst(Inst)
 import PreludePS(_PackedString)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyVar(TyVar)
 import UniType(UniType)
 import Inst(Inst)
 import PreludePS(_PackedString)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyVar(TyVar)
 import UniType(UniType)
-import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data DsMatchContext    {-# GHC_PRAGMA DsMatchContext DsMatchKind [TypecheckedPat] SrcLoc | NoMatchContext #-}
-data DsMatchKind       {-# GHC_PRAGMA FunMatch Id | CaseMatch | LambdaMatch | PatBindMatch #-}
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data Bag a 
+data GlobalSwitch 
+data SwitchResult 
+data CoreBinding a b 
+data DsMatchContext 
+data DsMatchKind 
+data Binds a b 
+data Expr a b 
+data TypecheckedPat 
+data Id 
+data SplitUniqSupply 
 deSugar :: SplitUniqSupply -> (GlobalSwitch -> SwitchResult) -> _PackedString -> (Binds Id TypecheckedPat, Binds Id TypecheckedPat, Binds Id TypecheckedPat, [(Inst, Expr Id TypecheckedPat)]) -> ([CoreBinding Id Id], Bag DsMatchContext)
 deSugar :: SplitUniqSupply -> (GlobalSwitch -> SwitchResult) -> _PackedString -> (Binds Id TypecheckedPat, Binds Id TypecheckedPat, Binds Id TypecheckedPat, [(Inst, Expr Id TypecheckedPat)]) -> ([CoreBinding Id Id], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1221 _N_ _S_ "LLLU(LLLL)" _N_ _N_ #-}
 
 
index 8fbdc3c..dfa1e5d 100644 (file)
@@ -15,7 +15,5 @@ import SrcLoc(SrcLoc)
 import TyVar(TyVar)
 import UniqFM(UniqFM)
 dsBinds :: Binds Id TypecheckedPat -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([CoreBinding Id Id], Bag DsMatchContext)
 import TyVar(TyVar)
 import UniqFM(UniqFM)
 dsBinds :: Binds Id TypecheckedPat -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([CoreBinding Id Id], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 dsInstBinds :: [TyVar] -> [(Inst, Expr Id TypecheckedPat)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([(Id, CoreExpr Id Id)], [(Id, CoreExpr Id Id)]), Bag DsMatchContext)
 dsInstBinds :: [TyVar] -> [(Inst, Expr Id TypecheckedPat)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([(Id, CoreExpr Id Id)], [(Id, CoreExpr Id Id)]), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 33faf57..1beb8b9 100644 (file)
@@ -11,5 +11,4 @@ import SrcLoc(SrcLoc)
 import UniType(UniType)
 import UniqFM(UniqFM)
 dsCCall :: _PackedString -> [CoreExpr Id Id] -> Bool -> Bool -> UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 import UniType(UniType)
 import UniqFM(UniqFM)
 dsCCall :: _PackedString -> [CoreExpr Id Id] -> Bool -> Bool -> UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 11 _U_ 22222122222 _N_ _S_ "LLLLSU(ALS)LLLLL" _N_ _N_ #-}
 
 
index 84b0490..7aaaf48 100644 (file)
@@ -12,5 +12,4 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 dsExpr :: Expr Id TypecheckedPat -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 dsExpr :: Expr Id TypecheckedPat -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 41bd2c4..ec2f749 100644 (file)
@@ -14,7 +14,5 @@ import SrcLoc(SrcLoc)
 import UniType(UniType)
 import UniqFM(UniqFM)
 dsGRHSs :: UniType -> DsMatchKind -> [TypecheckedPat] -> [GRHS Id TypecheckedPat] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 import UniType(UniType)
 import UniqFM(UniqFM)
 dsGRHSs :: UniType -> DsMatchKind -> [TypecheckedPat] -> [GRHS Id TypecheckedPat] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 10 _U_ 2221222222 _N_ _S_ "LLLS" _N_ _N_ #-}
 dsGuarded :: GRHSsAndBinds Id TypecheckedPat -> SrcLoc -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 dsGuarded :: GRHSsAndBinds Id TypecheckedPat -> SrcLoc -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12222222 _N_ _S_ "SL" _N_ _N_ #-}
 
 
index a6455a0..a682df8 100644 (file)
@@ -12,5 +12,4 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 dsListComp :: CoreExpr Id Id -> [Qual Id TypecheckedPat] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 dsListComp :: CoreExpr Id Id -> [Qual Id TypecheckedPat] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222222 _N_ _N_ _N_ _N_ #-}
 
 
index 8ffc667..acc7df5 100644 (file)
@@ -7,112 +7,62 @@ import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import HsPat(TypecheckedPat)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import HsPat(TypecheckedPat)
-import Id(DataCon(..), Id, IdDetails, mkIdWithNewUniq, mkSysLocal)
-import IdEnv(lookupIdEnv)
-import IdInfo(IdInfo)
+import Id(DataCon(..), Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(ShortName)
-import Outputable(NamedThing)
 import PlainCore(PlainCoreExpr(..))
 import PreludePS(_PackedString)
 import Pretty(PprStyle, PrettyRep)
 import PrimOps(PrimOp)
 import PlainCore(PlainCoreExpr(..))
 import PreludePS(_PackedString)
 import Pretty(PprStyle, PrettyRep)
 import PrimOps(PrimOp)
-import SplitUniq(SplitUniqSupply, getSUnique, splitUniqSupply)
-import SrcLoc(SrcLoc, unpackSrcLoc)
-import TyCon(TyCon)
+import SplitUniq(SplitUniqSupply)
+import SrcLoc(SrcLoc)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType)
-import UniqFM(UniqFM, lookupUFM)
-import Unique(UniqSM(..), Unique, UniqueSupply, mkUniqueGrimily, mkUniqueSupplyGrimily)
+import UniqFM(UniqFM)
+import Unique(UniqSM(..), UniqueSupply)
 infixr 9 `thenDs`
 infixr 9 `thenDs`
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
+data GlobalSwitch 
+data SwitchResult 
+data CoreExpr a b 
 type DataCon = Id
 type DsIdEnv = UniqFM (CoreExpr Id Id)
 type DsM a = SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 data DsMatchContext   = DsMatchContext DsMatchKind [TypecheckedPat] SrcLoc | NoMatchContext
 data DsMatchKind   = FunMatch Id | CaseMatch | LambdaMatch | PatBindMatch
 type DataCon = Id
 type DsIdEnv = UniqFM (CoreExpr Id Id)
 type DsM a = SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 data DsMatchContext   = DsMatchContext DsMatchKind [TypecheckedPat] SrcLoc | NoMatchContext
 data DsMatchKind   = FunMatch Id | CaseMatch | LambdaMatch | PatBindMatch
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreExpr = CoreExpr Id Id
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data SplitUniqSupply 
+data SrcLoc 
+data TyVar 
+data TyVarTemplate 
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data UniType 
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
 andDs :: (a -> a -> a) -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 type UniqSM a = UniqueSupply -> (UniqueSupply, a)
 andDs :: (a -> a -> a) -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 9 _U_ 111122222 _N_ _S_ "LSSU(ALL)LLLLL" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0 -> u0 -> u0) (u2 :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (u0, Bag DsMatchContext)) (u3 :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (u0, Bag DsMatchContext)) (u4 :: SplitUniqSupply) (u5 :: SrcLoc) (u6 :: GlobalSwitch -> SwitchResult) (u7 :: (_PackedString, _PackedString)) (u8 :: UniqFM (CoreExpr Id Id)) (u9 :: Bag DsMatchContext) -> case u4 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ ub, u5, u6, u7, u8, u9 ] of { _ALG_ _TUP_2 (ud :: u0) (ue :: Bag DsMatchContext) -> case _APP_  u3 [ uc, u5, u6, u7, u8, ue ] of { _ALG_ _TUP_2 (uf :: u0) (ug :: Bag DsMatchContext) -> let {(uh :: u0) = _APP_  u1 [ ud, uf ]} in _!_ _TUP_2 [u0, (Bag DsMatchContext)] [uh, ug]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 cloneTyVarsDs :: [TyVar] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([TyVar], Bag DsMatchContext)
 cloneTyVarsDs :: [TyVar] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([TyVar], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2200002 _N_ _S_ "LLAAAAL" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 dsShadowError :: DsMatchContext -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((), Bag DsMatchContext)
 dsShadowError :: DsMatchContext -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2000002 _N_ _S_ "LAAAAAL" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 XXXXXXX 9 \ (u0 :: DsMatchContext) (u1 :: SplitUniqSupply) (u2 :: SrcLoc) (u3 :: GlobalSwitch -> SwitchResult) (u4 :: (_PackedString, _PackedString)) (u5 :: UniqFM (CoreExpr Id Id)) (u6 :: Bag DsMatchContext) -> let {(u7 :: ()) = _!_ _TUP_0 [] []} in let {(u8 :: Bag DsMatchContext) = _APP_  _TYAPP_  _ORIG_ Bag snocBag { DsMatchContext } [ u6, u0 ]} in _!_ _TUP_2 [(), (Bag DsMatchContext)] [u7, u8] _N_ #-}
 duplicateLocalDs :: Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Id, Bag DsMatchContext)
 duplicateLocalDs :: Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1100002 _N_ _S_ "LLAAAAL" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 extendEnvDs :: [(Id, CoreExpr Id Id)] -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 extendEnvDs :: [(Id, CoreExpr Id Id)] -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 8 _U_ 11122222 _N_ _S_ "SSU(ALL)LLLLL" _N_ _N_ #-}
 getModuleAndGroupDs :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((_PackedString, _PackedString), Bag DsMatchContext)
 getModuleAndGroupDs :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((_PackedString, _PackedString), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 6 _U_ 000202 _N_ _S_ "AAALAL" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: (_PackedString, _PackedString)) (u1 :: Bag DsMatchContext) -> _!_ _TUP_2 [(_PackedString, _PackedString), (Bag DsMatchContext)] [u0, u1] _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 3 \ (u0 :: SplitUniqSupply) (u1 :: SrcLoc) (u2 :: GlobalSwitch -> SwitchResult) (u3 :: (_PackedString, _PackedString)) (u4 :: UniqFM (CoreExpr Id Id)) (u5 :: Bag DsMatchContext) -> _!_ _TUP_2 [(_PackedString, _PackedString), (Bag DsMatchContext)] [u3, u5] _N_ #-}
-mkIdWithNewUniq :: Id -> Unique -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(ALLL)L" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-mkSysLocal :: _PackedString -> Unique -> UniType -> SrcLoc -> Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
-lookupIdEnv :: UniqFM a -> Id -> Labda a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-getSUnique :: SplitUniqSupply -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> case u1 of { _ALG_ I# (u4 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u4]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getSrcLocDs :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([Char], [Char]), Bag DsMatchContext)
 getSrcLocDs :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([Char], [Char]), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 6 _U_ 010002 _N_ _S_ "ASAAAL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSwitchCheckerDs :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (GlobalSwitch -> Bool, Bag DsMatchContext)
 getSwitchCheckerDs :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (GlobalSwitch -> Bool, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 6 _U_ 002002 _N_ _S_ "AALAAL" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 8 \ (u0 :: SplitUniqSupply) (u1 :: SrcLoc) (u2 :: GlobalSwitch -> SwitchResult) (u3 :: (_PackedString, _PackedString)) (u4 :: UniqFM (CoreExpr Id Id)) (u5 :: Bag DsMatchContext) -> let {(u7 :: GlobalSwitch -> Bool) = \ (u6 :: GlobalSwitch) -> _APP_  _TYAPP_  _ORIG_ CmdLineOpts switchIsOn { GlobalSwitch } [ u2, u6 ]} in _!_ _TUP_2 [(GlobalSwitch -> Bool), (Bag DsMatchContext)] [u7, u5] _N_ #-}
 ifSwitchSetDs :: GlobalSwitch -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 ifSwitchSetDs :: GlobalSwitch -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 9 _U_ 211222222 _N_ _S_ "LLLLLSLLL" _N_ _N_ #-}
 initDs :: SplitUniqSupply -> UniqFM (CoreExpr Id Id) -> (GlobalSwitch -> SwitchResult) -> _PackedString -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (a, Bag DsMatchContext)
 initDs :: SplitUniqSupply -> UniqFM (CoreExpr Id Id) -> (GlobalSwitch -> SwitchResult) -> _PackedString -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 5 _U_ 22221 _N_ _S_ "LLLLS" _N_ _N_ #-}
 listDs :: [SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([a], Bag DsMatchContext)
 listDs :: [SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([a], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1122222 _N_ _S_ "SLLLLLL" _N_ _N_ #-}
 lookupEnvDs :: Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Labda (CoreExpr Id Id), Bag DsMatchContext)
 lookupEnvDs :: Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Labda (CoreExpr Id Id), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1000022 _N_ _S_ "LAAAALL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 CXXXXXX 9 \ (u0 :: Id) (u1 :: SplitUniqSupply) (u2 :: SrcLoc) (u3 :: GlobalSwitch -> SwitchResult) (u4 :: (_PackedString, _PackedString)) (u5 :: UniqFM (CoreExpr Id Id)) (u6 :: Bag DsMatchContext) -> let {(uc :: Labda (CoreExpr Id Id)) = case u0 of { _ALG_ _ORIG_ Id Id (u7 :: Unique) (u8 :: UniType) (u9 :: IdInfo) (ua :: IdDetails) -> case u7 of { _ALG_ _ORIG_ Unique MkUnique (ub :: Int#) -> _APP_  _TYAPP_  _WRKR_ _ORIG_ IdEnv lookupIdEnv { (CoreExpr Id Id) } [ u5, ub ]; _NO_DEFLT_ }; _NO_DEFLT_ }} in _!_ _TUP_2 [(Labda (CoreExpr Id Id)), (Bag DsMatchContext)] [uc, u6] _N_ #-}
 lookupEnvWithDefaultDs :: Id -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 lookupEnvWithDefaultDs :: Id -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 8 _U_ 11000022 _N_ _S_ "LLAAAALL" {_A_ 4 _U_ 1122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupId :: [(Id, a)] -> Id -> a
 lookupId :: [(Id, a)] -> Id -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 1 2 XX 4 _/\_ u0 -> \ (u1 :: [(Id, u0)]) (u2 :: Id) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ Util assoc [ (Id), _N_ ] { u0 } [ _NOREP_S_ "lookupId", u1, u2 ] _N_ #-}
-lookupUFM :: NamedThing a => UniqFM b -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 mapAndUnzipDs :: (a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((b, c), Bag DsMatchContext)) -> [a] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([b], [c]), Bag DsMatchContext)
 mapAndUnzipDs :: (a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((b, c), Bag DsMatchContext)) -> [a] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([b], [c]), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 mapDs :: (a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (b, Bag DsMatchContext)) -> [a] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([b], Bag DsMatchContext)
 mapDs :: (a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (b, Bag DsMatchContext)) -> [a] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([b], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
-mkUniqueGrimily :: Int# -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_ #-}
-mkUniqueSupplyGrimily :: SplitUniqSupply -> UniqueSupply
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: SplitUniqSupply) -> _!_ _ORIG_ Unique MkNewSupply [] [u0] _N_ #-}
 newFailLocalDs :: UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Id, Bag DsMatchContext)
 newFailLocalDs :: UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2120002 _N_ _N_ _N_ _N_ #-}
 newSysLocalDs :: UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Id, Bag DsMatchContext)
 newSysLocalDs :: UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2120002 _N_ _N_ _N_ _N_ #-}
 newSysLocalsDs :: [UniType] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([Id], Bag DsMatchContext)
 newSysLocalsDs :: [UniType] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([Id], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _N_ _N_ _N_ #-}
 newTyVarsDs :: [TyVarTemplate] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([TyVar], Bag DsMatchContext)
 newTyVarsDs :: [TyVarTemplate] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([TyVar], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2200002 _N_ _S_ "LLAAAAL" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 pprDsWarnings :: PprStyle -> Bag DsMatchContext -> Int -> Bool -> PrettyRep
 pprDsWarnings :: PprStyle -> Bag DsMatchContext -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 putSrcLocDs :: SrcLoc -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 putSrcLocDs :: SrcLoc -> (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 8 _U_ 21202222 _N_ _S_ "LSLALLLL" {_A_ 7 _U_ 2122222 _N_ _N_ _F_ _IF_ARGS_ 1 7 XXXXXXX 7 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (u0, Bag DsMatchContext)) (u3 :: SplitUniqSupply) (u4 :: GlobalSwitch -> SwitchResult) (u5 :: (_PackedString, _PackedString)) (u6 :: UniqFM (CoreExpr Id Id)) (u7 :: Bag DsMatchContext) -> _APP_  u2 [ u3, u1, u4, u5, u6, u7 ] _N_} _F_ _IF_ARGS_ 1 8 XXXXXXXX 7 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (u0, Bag DsMatchContext)) (u3 :: SplitUniqSupply) (u4 :: SrcLoc) (u5 :: GlobalSwitch -> SwitchResult) (u6 :: (_PackedString, _PackedString)) (u7 :: UniqFM (CoreExpr Id Id)) (u8 :: Bag DsMatchContext) -> _APP_  u2 [ u3, u1, u5, u6, u7, u8 ] _N_ #-}
 returnDs :: a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 returnDs :: a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2000002 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: SplitUniqSupply) (u3 :: SrcLoc) (u4 :: GlobalSwitch -> SwitchResult) (u5 :: (_PackedString, _PackedString)) (u6 :: UniqFM (CoreExpr Id Id)) (u7 :: Bag DsMatchContext) -> _!_ _TUP_2 [u0, (Bag DsMatchContext)] [u1, u7] _N_ #-}
-splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
 thenDs :: (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (b, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (b, Bag DsMatchContext)
 thenDs :: (SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)) -> (a -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (b, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (b, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 8 _U_ 11122222 _N_ _S_ "SSU(ALL)LLLLL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (u0, Bag DsMatchContext)) (u3 :: u0 -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (u1, Bag DsMatchContext)) (u4 :: SplitUniqSupply) (u5 :: SrcLoc) (u6 :: GlobalSwitch -> SwitchResult) (u7 :: (_PackedString, _PackedString)) (u8 :: UniqFM (CoreExpr Id Id)) (u9 :: Bag DsMatchContext) -> case u4 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ ub, u5, u6, u7, u8, u9 ] of { _ALG_ _TUP_2 (ud :: u0) (ue :: Bag DsMatchContext) -> _APP_  u3 [ ud, uc, u5, u6, u7, u8, ue ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 uniqSMtoDsM :: (UniqueSupply -> (UniqueSupply, a)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
 uniqSMtoDsM :: (UniqueSupply -> (UniqueSupply, a)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (a, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1200002 _N_ _S_ "LLAAAAL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-unpackSrcLoc :: SrcLoc -> (_PackedString, _PackedString)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 zipWithDs :: (a -> b -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (c, Bag DsMatchContext)) -> [a] -> [b] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([c], Bag DsMatchContext)
 zipWithDs :: (a -> b -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (c, Bag DsMatchContext)) -> [a] -> [b] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([c], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 211222222 _N_ _S_ "LSS" _N_ _N_ #-}
 
 
index ff077e2..bd4691d 100644 (file)
@@ -18,33 +18,18 @@ data CanItFail   = CanFail | CantFail
 data EquationInfo   = EqnInfo [TypecheckedPat] MatchResult
 data MatchResult   = MatchResult CanItFail UniType (CoreExpr Id Id -> CoreExpr Id Id) DsMatchContext
 combineGRHSMatchResults :: MatchResult -> MatchResult -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 data EquationInfo   = EqnInfo [TypecheckedPat] MatchResult
 data MatchResult   = MatchResult CanItFail UniType (CoreExpr Id Id -> CoreExpr Id Id) DsMatchContext
 combineGRHSMatchResults :: MatchResult -> MatchResult -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11222222 _N_ _S_ "U(ELLL)L" {_A_ 5 _U_ 22221222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 combineMatchResults :: MatchResult -> MatchResult -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 combineMatchResults :: MatchResult -> MatchResult -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11222222 _N_ _S_ "U(ELLL)L" {_A_ 5 _U_ 22221222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 dsExprToAtom :: CoreExpr Id Id -> (CoreAtom Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 dsExprToAtom :: CoreExpr Id Id -> (CoreAtom Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222222 _N_ _S_ "SS" _N_ _N_ #-}
 mkCoAlgCaseMatchResult :: Id -> [(Id, [Id], MatchResult)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 mkCoAlgCaseMatchResult :: Id -> [(Id, [Id], MatchResult)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12222222 _N_ _S_ "U(LSLL)L" {_A_ 5 _U_ 22222222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkCoAppDs :: CoreExpr Id Id -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 mkCoAppDs :: CoreExpr Id Id -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222222 _N_ _S_ "LS" _N_ _N_ #-}
 mkCoConDs :: Id -> [UniType] -> [CoreExpr Id Id] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 mkCoConDs :: Id -> [UniType] -> [CoreExpr Id Id] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 221222222 _N_ _S_ "LLS" _N_ _N_ #-}
 mkCoLetsMatchResult :: [CoreBinding Id Id] -> MatchResult -> MatchResult
 mkCoLetsMatchResult :: [CoreBinding Id Id] -> MatchResult -> MatchResult
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkCoPrimCaseMatchResult :: Id -> [(BasicLit, MatchResult)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 mkCoPrimCaseMatchResult :: Id -> [(BasicLit, MatchResult)] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 8 _U_ 22120002 _N_ _S_ "LLU(ALA)LLLLL" _N_ _N_ #-}
 mkCoPrimDs :: PrimOp -> [UniType] -> [CoreExpr Id Id] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 mkCoPrimDs :: PrimOp -> [UniType] -> [CoreExpr Id Id] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 221222222 _N_ _S_ "LLS" _N_ _N_ #-}
 mkFailurePair :: UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((CoreExpr Id Id -> CoreBinding Id Id, CoreExpr Id Id), Bag DsMatchContext)
 mkFailurePair :: UniType -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ((CoreExpr Id Id -> CoreBinding Id Id, CoreExpr Id Id), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222222 _N_ _S_ "S" _N_ _N_ #-}
 mkGuardedMatchResult :: CoreExpr Id Id -> MatchResult -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 mkGuardedMatchResult :: CoreExpr Id Id -> MatchResult -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 8 _U_ 21000002 _N_ _S_ "LU(ALLL)AAAAAL" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkSelectorBinds :: [TyVar] -> TypecheckedPat -> [(Id, Id)] -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([(Id, CoreExpr Id Id)], Bag DsMatchContext)
 mkSelectorBinds :: [TyVar] -> TypecheckedPat -> [(Id, Id)] -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([(Id, CoreExpr Id Id)], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222122222 _N_ _S_ "LSSL" _N_ _N_ #-}
 mkTupleBind :: [TyVar] -> [Id] -> [(Id, Id)] -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([(Id, CoreExpr Id Id)], Bag DsMatchContext)
 mkTupleBind :: [TyVar] -> [Id] -> [(Id, Id)] -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([(Id, CoreExpr Id Id)], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 mkTupleExpr :: [Id] -> CoreExpr Id Id
 mkTupleExpr :: [Id] -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 selectMatchVars :: [TypecheckedPat] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([Id], Bag DsMatchContext)
 selectMatchVars :: [TypecheckedPat] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> ([Id], Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 0a1697c..e4e6b3f 100644 (file)
@@ -14,9 +14,6 @@ import SrcLoc(SrcLoc)
 import UniType(UniType)
 import UniqFM(UniqFM)
 match :: [Id] -> [EquationInfo] -> [EquationInfo] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 import UniType(UniType)
 import UniqFM(UniqFM)
 match :: [Id] -> [EquationInfo] -> [EquationInfo] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222222222 _N_ _S_ "SSS" _N_ _N_ #-}
 matchSimply :: CoreExpr Id Id -> TypecheckedPat -> UniType -> CoreExpr Id Id -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
 matchSimply :: CoreExpr Id Id -> TypecheckedPat -> UniType -> CoreExpr Id Id -> CoreExpr Id Id -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (CoreExpr Id Id, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222222222 _N_ _S_ "SLLLL" _N_ _N_ #-}
 matchWrapper :: DsMatchKind -> [Match Id TypecheckedPat] -> [Char] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([Id], CoreExpr Id Id), Bag DsMatchContext)
 matchWrapper :: DsMatchKind -> [Match Id TypecheckedPat] -> [Char] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (([Id], CoreExpr Id Id), Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222222222 _N_ _S_ "LSL" _N_ _N_ #-}
 
 
index bb10bf1..2c6cedf 100644 (file)
@@ -11,5 +11,4 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 matchConFamily :: [Id] -> [EquationInfo] -> [EquationInfo] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 matchConFamily :: [Id] -> [EquationInfo] -> [EquationInfo] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 122222222 _N_ _S_ "SSL" _N_ _N_ #-}
 
 
index 9f211d9..9b3e476 100644 (file)
@@ -11,5 +11,4 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 matchLiterals :: [Id] -> [EquationInfo] -> [EquationInfo] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
 import SrcLoc(SrcLoc)
 import UniqFM(UniqFM)
 matchLiterals :: [Id] -> [EquationInfo] -> [EquationInfo] -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> SwitchResult) -> (_PackedString, _PackedString) -> UniqFM (CoreExpr Id Id) -> Bag DsMatchContext -> (MatchResult, Bag DsMatchContext)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222222222 _N_ _S_ "SSL" _N_ _N_ #-}
 
 
index a523d9d..a1e84c6 100644 (file)
@@ -1,22 +1,17 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface Core2Def where
 import BinderInfo(BinderInfo)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CoreSyn(CoreBinding, CoreExpr)
 import DefSyn(DefBindee, DefProgram(..))
 interface Core2Def where
 import BinderInfo(BinderInfo)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CoreSyn(CoreBinding, CoreExpr)
 import DefSyn(DefBindee, DefProgram(..))
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreProgram(..))
 import PlainCore(PlainCoreProgram(..))
-import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqFM(UniqFM)
-import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data DefBindee         {-# GHC_PRAGMA DefArgExpr (CoreExpr Id DefBindee) | DefArgVar Id | Label (CoreExpr Id DefBindee) (CoreExpr Id DefBindee) #-}
+data CoreBinding a b 
+data DefBindee 
 type DefProgram = [CoreBinding Id DefBindee]
 type DefProgram = [CoreBinding Id DefBindee]
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type PlainCoreProgram = [CoreBinding Id Id]
 c2d :: UniqFM (CoreExpr Id DefBindee) -> CoreExpr (Id, BinderInfo) Id -> CoreExpr Id DefBindee
 type PlainCoreProgram = [CoreBinding Id Id]
 c2d :: UniqFM (CoreExpr Id DefBindee) -> CoreExpr (Id, BinderInfo) Id -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 core2def :: (GlobalSwitch -> SwitchResult) -> [CoreBinding Id Id] -> [CoreBinding Id DefBindee]
 core2def :: (GlobalSwitch -> SwitchResult) -> [CoreBinding Id Id] -> [CoreBinding Id DefBindee]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ #-}
 
 
index a0c39ff..ed6be34 100644 (file)
@@ -1,11 +1,9 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface Cyclic where
 import CoreSyn(CoreExpr)
 import DefSyn(DefBindee)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 fixupFreeVars :: [Id] -> Id -> CoreExpr Id DefBindee -> ((Id, CoreExpr Id DefBindee), [(Id, CoreExpr Id DefBindee)])
 interface Cyclic where
 import CoreSyn(CoreExpr)
 import DefSyn(DefBindee)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 fixupFreeVars :: [Id] -> Id -> CoreExpr Id DefBindee -> ((Id, CoreExpr Id DefBindee), [(Id, CoreExpr Id DefBindee)])
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLS" _N_ _N_ #-}
 mkLoops :: CoreExpr Id DefBindee -> SplitUniqSupply -> ([(Id, CoreExpr Id DefBindee)], CoreExpr Id DefBindee)
 mkLoops :: CoreExpr Id DefBindee -> SplitUniqSupply -> ([(Id, CoreExpr Id DefBindee)], CoreExpr Id DefBindee)
-       {-# GHC_PRAGMA _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: CoreExpr Id DefBindee) (u1 :: SplitUniqSupply) -> _APP_  _TYAPP_  error { (SplitUniqSupply -> ([(Id, CoreExpr Id DefBindee)], CoreExpr Id DefBindee)) } [ _NOREP_S_ "mkLoops", u1 ] _N_ #-}
 
 
index 4e36e86..13b3c65 100644 (file)
@@ -1,23 +1,17 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface Def2Core where
 import CoreSyn(CoreBinding, CoreExpr)
 import DefSyn(DefBindee, DefBinding(..))
 interface Def2Core where
 import CoreSyn(CoreBinding, CoreExpr)
 import DefSyn(DefBindee, DefBinding(..))
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreProgram(..))
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import PlainCore(PlainCoreProgram(..))
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
-import UniType(UniType)
-import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data DefBindee         {-# GHC_PRAGMA DefArgExpr (CoreExpr Id DefBindee) | DefArgVar Id | Label (CoreExpr Id DefBindee) (CoreExpr Id DefBindee) #-}
+data CoreBinding a b 
+data DefBindee 
 type DefBinding = CoreBinding Id DefBindee
 type DefBinding = CoreBinding Id DefBindee
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type PlainCoreProgram = [CoreBinding Id Id]
 type SUniqSM a = SplitUniqSupply -> a
 d2c :: CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 type SUniqSM a = SplitUniqSupply -> a
 d2c :: CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "S" _N_ _N_ #-}
 def2core :: [CoreBinding Id DefBindee] -> SplitUniqSupply -> [CoreBinding Id Id]
 def2core :: [CoreBinding Id DefBindee] -> SplitUniqSupply -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "S" _N_ _N_ #-}
 defPanic :: [Char] -> [Char] -> CoreExpr Id DefBindee -> SplitUniqSupply -> a
 defPanic :: [Char] -> [Char] -> CoreExpr Id DefBindee -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 3 _U_ 1111 _N_ _S_ _!_ _N_ _N_ #-}
 
 
index f4164ed..56bcc06 100644 (file)
@@ -1,4 +1,4 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface DefExpr where
 import CmdLineOpts(SwitchResult)
 import CoreSyn(CoreArg, CoreExpr)
 interface DefExpr where
 import CmdLineOpts(SwitchResult)
 import CoreSyn(CoreArg, CoreExpr)
@@ -8,5 +8,4 @@ import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tran :: (a -> SwitchResult) -> UniqFM (CoreExpr Id DefBindee) -> UniqFM UniType -> CoreExpr Id DefBindee -> [CoreArg DefBindee] -> SplitUniqSupply -> CoreExpr Id DefBindee
 import UniType(UniType)
 import UniqFM(UniqFM)
 tran :: (a -> SwitchResult) -> UniqFM (CoreExpr Id DefBindee) -> UniqFM UniType -> CoreExpr Id DefBindee -> [CoreArg DefBindee] -> SplitUniqSupply -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 5 _U_ 222222 _N_ _S_ "LLLSL" _N_ _N_ #-}
 
 
index fde9292..7a023f2 100644 (file)
@@ -1,4 +1,4 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface DefSyn where
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr)
 import Id(Id)
 interface DefSyn where
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr)
 import Id(Id)
@@ -11,5 +11,4 @@ type DefCoreArg = CoreArg DefBindee
 type DefExpr = CoreExpr Id DefBindee
 type DefProgram = [CoreBinding Id DefBindee]
 mkLabel :: CoreExpr Id DefBindee -> CoreExpr Id DefBindee -> CoreExpr Id DefBindee
 type DefExpr = CoreExpr Id DefBindee
 type DefProgram = [CoreBinding Id DefBindee]
 mkLabel :: CoreExpr Id DefBindee -> CoreExpr Id DefBindee -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 0baaa9c..bef19d3 100644 (file)
@@ -1,4 +1,4 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface DefUtils where
 import CoreSyn(CoreAtom, CoreCaseAlternatives, CoreExpr)
 import DefSyn(DefBindee)
 interface DefUtils where
 import CoreSyn(CoreAtom, CoreCaseAlternatives, CoreExpr)
 import DefSyn(DefBindee)
@@ -8,37 +8,20 @@ import TyVar(TyVar)
 import UniType(UniType)
 data RenameResult   = NotRenaming | IsRenaming [(Id, Id)] | InconsistentRenaming [(Id, Id)]
 atom2expr :: CoreAtom DefBindee -> CoreExpr Id DefBindee
 import UniType(UniType)
 data RenameResult   = NotRenaming | IsRenaming [(Id, Id)] | InconsistentRenaming [(Id, Id)]
 atom2expr :: CoreAtom DefBindee -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 consistent :: [(Id, Id)] -> Bool
 consistent :: [(Id, Id)] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 deforestable :: Id -> Bool
 deforestable :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAAAAEAAA)A)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: DeforestInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo DoDeforest  -> _!_ True [] []; _ORIG_ IdInfo Don'tDeforest  -> _!_ False [] []; _NO_DEFLT_ } _N_} _F_ _ALWAYS_ \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ IdInfo IdInfo (u5 :: ArityInfo) (u6 :: DemandInfo) (u7 :: SpecEnv) (u8 :: StrictnessInfo) (u9 :: UnfoldingDetails) (ua :: UpdateInfo) (ub :: DeforestInfo) (uc :: ArgUsageInfo) (ud :: FBTypeInfo) (ue :: SrcLoc) -> case ub of { _ALG_ _ORIG_ IdInfo DoDeforest  -> _!_ True [] []; _ORIG_ IdInfo Don'tDeforest  -> _!_ False [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 foldrSUs :: (a -> b -> SplitUniqSupply -> b) -> b -> [a] -> SplitUniqSupply -> b
 foldrSUs :: (a -> b -> SplitUniqSupply -> b) -> b -> [a] -> SplitUniqSupply -> b
-       {-# GHC_PRAGMA _A_ 3 _U_ 2212 _N_ _S_ "LLS" _N_ _N_ #-}
 freeTyVars :: CoreExpr Id DefBindee -> [TyVar]
 freeTyVars :: CoreExpr Id DefBindee -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 freeVars :: CoreExpr Id DefBindee -> [Id]
 freeVars :: CoreExpr Id DefBindee -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isArgId :: Id -> Bool
 isArgId :: Id -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(AAAAAAEAAA)L)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkDefLetrec :: [(a, CoreExpr a b)] -> CoreExpr a b -> CoreExpr a b
 mkDefLetrec :: [(a, CoreExpr a b)] -> CoreExpr a b -> CoreExpr a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 newDefId :: UniType -> SplitUniqSupply -> Id
 newDefId :: UniType -> SplitUniqSupply -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(ALA)" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newTmpId :: UniType -> SplitUniqSupply -> Id
 newTmpId :: UniType -> SplitUniqSupply -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(ALA)" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rebindExpr :: CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id DefBindee
 rebindExpr :: CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "S" _N_ _N_ #-}
 renameExprs :: CoreExpr Id DefBindee -> CoreExpr Id DefBindee -> SplitUniqSupply -> RenameResult
 renameExprs :: CoreExpr Id DefBindee -> CoreExpr Id DefBindee -> SplitUniqSupply -> RenameResult
-       {-# GHC_PRAGMA _A_ 2 _U_ 222 _N_ _S_ "SS" _N_ _N_ #-}
 strip :: CoreExpr Id DefBindee -> CoreExpr Id DefBindee
 strip :: CoreExpr Id DefBindee -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 stripAtom :: CoreAtom DefBindee -> CoreAtom DefBindee
 stripAtom :: CoreAtom DefBindee -> CoreAtom DefBindee
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 stripCaseAlts :: CoreCaseAlternatives Id DefBindee -> CoreCaseAlternatives Id DefBindee
 stripCaseAlts :: CoreCaseAlternatives Id DefBindee -> CoreCaseAlternatives Id DefBindee
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 subst :: [(Id, CoreExpr Id DefBindee)] -> CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id DefBindee
 subst :: [(Id, CoreExpr Id DefBindee)] -> CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 2 _U_ 212 _N_ _S_ "LS" _N_ _N_ #-}
 union :: Eq a => [a] -> [a] -> [a]
 union :: Eq a => [a] -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 212 _N_ _N_ _N_ _SPECIALISE_ [ TyVar ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SS" _N_ _N_ } #-}
 
 
index a985820..6aa23d2 100644 (file)
@@ -1,9 +1,8 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface Deforest where
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 deforestProgram :: (GlobalSwitch -> SwitchResult) -> [CoreBinding Id Id] -> SplitUniqSupply -> [CoreBinding Id Id]
 interface Deforest where
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 deforestProgram :: (GlobalSwitch -> SwitchResult) -> [CoreBinding Id Id] -> SplitUniqSupply -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "SLU(ALL)" {_A_ 4 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index f043c61..68b982e 100644 (file)
@@ -1,4 +1,4 @@
-{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+{-# GHC_PRAGMA INTERFACE VERSION 3 #-}
 interface TreelessForm where
 import CmdLineOpts(SwitchResult)
 import CoreSyn(CoreExpr)
 interface TreelessForm where
 import CmdLineOpts(SwitchResult)
 import CoreSyn(CoreExpr)
@@ -6,5 +6,4 @@ import DefSyn(DefBindee)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 convertToTreelessForm :: (a -> SwitchResult) -> CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id DefBindee
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 convertToTreelessForm :: (a -> SwitchResult) -> CoreExpr Id DefBindee -> SplitUniqSupply -> CoreExpr Id DefBindee
-       {-# GHC_PRAGMA _A_ 2 _U_ 012 _N_ _S_ "AS" {_A_ 1 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 1a2001a..e107775 100644 (file)
@@ -1,51 +1,32 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CE where
 import CharSeq(CSeq)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CE where
 import CharSeq(CSeq)
-import Class(Class, ClassOp)
+import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import Id(Id)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import Id(Id)
-import InstEnv(InstTemplate)
 import Maybes(MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import TyCon(TyCon)
 import Maybes(MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
-import UniqFM(UniqFM, eltsUFM, emptyUFM, plusUFM, singletonDirectlyUFM)
-import Unique(Unique, u2i)
+import UniqFM(UniqFM)
+import Unique(Unique)
 type CE = UniqFM Class
 type CE = UniqFM Class
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Class 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data MaybeErr a b 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data PrettyRep 
+data UniqFM a 
+data Unique 
 checkClassCycles :: UniqFM Class -> MaybeErr () (PprStyle -> Int -> Bool -> PrettyRep)
 checkClassCycles :: UniqFM Class -> MaybeErr () (PprStyle -> Int -> Bool -> PrettyRep)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
 lookupCE :: UniqFM Class -> Name -> Class
 lookupCE :: UniqFM Class -> Name -> Class
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 nullCE :: UniqFM Class
 nullCE :: UniqFM Class
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ UniqFM EmptyUFM [Class] [] _N_ #-}
 plusCE :: UniqFM Class -> UniqFM Class -> UniqFM Class
 plusCE :: UniqFM Class -> UniqFM Class -> UniqFM Class
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ UniqFM plusUFM { Class } _N_ #-}
-plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 rngCE :: UniqFM Class -> [Class]
 rngCE :: UniqFM Class -> [Class]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ UniqFM eltsUFM { Class } _N_ #-}
-singletonDirectlyUFM :: Unique -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 4 _/\_ u0 -> \ (u1 :: Unique) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u3, u2]; _NO_DEFLT_ } _N_ #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 unitCE :: Unique -> Class -> UniqFM Class
 unitCE :: Unique -> Class -> UniqFM Class
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int#) (u1 :: Class) -> _!_ _ORIG_ UniqFM LeafUFM [Class] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: Unique) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [Class] [u2, u1]; _NO_DEFLT_ } _N_ #-}
 
 
index 983265b..7c5b5ad 100644 (file)
@@ -2,8 +2,7 @@
 interface E where
 import CE(CE(..))
 import Class(Class)
 interface E where
 import CE(CE(..))
 import Class(Class)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
@@ -11,55 +10,35 @@ import PreludePS(_PackedString)
 import TCE(TCE(..))
 import TyCon(TyCon)
 import TyVar(TyVar)
 import TCE(TCE(..))
 import TyCon(TyCon)
 import TyVar(TyVar)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 type CE = UniqFM Class
 import UniqFM(UniqFM)
 import Unique(Unique)
 type CE = UniqFM Class
-data E         {-# GHC_PRAGMA MkE (UniqFM TyCon) (UniqFM Id) (UniqFM Id) (UniqFM Class) #-}
+data E 
 type GVE = [(Name, Id)]
 type GVE = [(Name, Id)]
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type LVE = [(Name, Id)]
 type LVE = [(Name, Id)]
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
+data Labda a 
+data Name 
 type TCE = UniqFM TyCon
 type TCE = UniqFM TyCon
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data TyVar 
+data UniqFM a 
 getE_CE :: E -> UniqFM Class
 getE_CE :: E -> UniqFM Class
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniqFM Class) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: E) -> case u0 of { _ALG_ _ORIG_ E MkE (u1 :: UniqFM TyCon) (u2 :: UniqFM Id) (u3 :: UniqFM Id) (u4 :: UniqFM Class) -> u4; _NO_DEFLT_ } _N_ #-}
 getE_GlobalVals :: E -> [Id]
 getE_GlobalVals :: E -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASLA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getE_TCE :: E -> UniqFM TyCon
 getE_TCE :: E -> UniqFM TyCon
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(SAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniqFM TyCon) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: E) -> case u0 of { _ALG_ _ORIG_ E MkE (u1 :: UniqFM TyCon) (u2 :: UniqFM Id) (u3 :: UniqFM Id) (u4 :: UniqFM Class) -> u1; _NO_DEFLT_ } _N_ #-}
 growE_LVE :: E -> [(Name, Id)] -> E
 growE_LVE :: E -> [(Name, Id)] -> E
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupE_Binder :: E -> Name -> Id
 lookupE_Binder :: E -> Name -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AASA)S" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupE_ClassOpByKey :: E -> Unique -> _PackedString -> Id
 lookupE_ClassOpByKey :: E -> Unique -> _PackedString -> Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAS)LL" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupE_Value :: E -> Name -> Id
 lookupE_Value :: E -> Name -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(ALLA)S" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupE_ValueQuietly :: E -> Name -> Labda Id
 lookupE_ValueQuietly :: E -> Name -> Labda Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(ALLA)S" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkE :: UniqFM TyCon -> UniqFM Class -> E
 mkE :: UniqFM TyCon -> UniqFM Class -> E
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 nullE :: E
 nullE :: E
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 nullGVE :: [(Name, Id)]
 nullGVE :: [(Name, Id)]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _NIL_ [(Name, Id)] [] _N_ #-}
 nullLVE :: [(Name, Id)]
 nullLVE :: [(Name, Id)]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _NIL_ [(Name, Id)] [] _N_ #-}
 plusE_CE :: E -> UniqFM Class -> E
 plusE_CE :: E -> UniqFM Class -> E
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 plusE_GVE :: E -> [(Name, Id)] -> E
 plusE_GVE :: E -> [(Name, Id)] -> E
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 plusE_TCE :: E -> UniqFM TyCon -> E
 plusE_TCE :: E -> UniqFM TyCon -> E
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 plusGVE :: [a] -> [a] -> [a]
 plusGVE :: [a] -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludeList (++) _N_ #-}
 plusLVE :: [a] -> [a] -> [a]
 plusLVE :: [a] -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludeList (++) _N_ #-}
 tvOfE :: E -> [TyVar]
 tvOfE :: E -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AASA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 unitGVE :: Name -> Id -> [(Name, Id)]
 unitGVE :: Name -> Id -> [(Name, Id)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 4760b95..196e95e 100644 (file)
@@ -1,73 +1,27 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface IdEnv where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface IdEnv where
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda(..))
 import Maybes(Labda(..))
-import Outputable(NamedThing)
-import UniType(UniType)
-import UniqFM(UniqFM, addToUFM, delFromUFM, delListFromUFM, eltsUFM, emptyUFM, filterUFM, listToUFM, lookupUFM, mapUFM, minusUFM, plusUFM, plusUFM_C, singletonUFM)
-import Unique(Unique, u2i)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+import UniqFM(UniqFM)
+import Unique(Unique)
+data Id 
 type IdEnv a = UniqFM a
 data Labda a   = Hamna | Ni a
 type IdEnv a = UniqFM a
 data Labda a   = Hamna | Ni a
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniqFM a 
+data Unique 
 addOneToIdEnv :: UniqFM a -> Id -> a -> UniqFM a
 addOneToIdEnv :: UniqFM a -> Id -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "SU(U(P)AAA)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-addToUFM :: NamedThing a => UniqFM b -> a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 4 _U_ 1222 _N_ _S_ "U(AAAAAASAAA)SLL" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 3 _U_ 222 _N_ _S_ "SSL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 3 _U_ 222 _N_ _S_ "SSL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "SU(U(P)AAA)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 combineIdEnvs :: (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
 combineIdEnvs :: (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM plusUFM_C _N_ #-}
-delFromUFM :: NamedThing a => UniqFM b -> a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
-delListFromUFM :: NamedThing a => UniqFM b -> [a] -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ } #-}
 delManyFromIdEnv :: UniqFM a -> [Id] -> UniqFM a
 delManyFromIdEnv :: UniqFM a -> [Id] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _SPEC_ _ORIG_ UniqFM delListFromUFM [ (Id), _N_ ] _N_ #-}
 delOneFromIdEnv :: UniqFM a -> Id -> UniqFM a
 delOneFromIdEnv :: UniqFM a -> Id -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
-filterUFM :: (a -> Bool) -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 growIdEnv :: UniqFM a -> UniqFM a -> UniqFM a
 growIdEnv :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM plusUFM _N_ #-}
 growIdEnvList :: UniqFM a -> [(Id, a)] -> UniqFM a
 growIdEnvList :: UniqFM a -> [(Id, a)] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 isNullIdEnv :: UniqFM a -> Bool
 isNullIdEnv :: UniqFM a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-listToUFM :: NamedThing a => [(a, b)] -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ } #-}
 lookupIdEnv :: UniqFM a -> Id -> Labda a
 lookupIdEnv :: UniqFM a -> Id -> Labda a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupNoFailIdEnv :: UniqFM a -> Id -> a
 lookupNoFailIdEnv :: UniqFM a -> Id -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-lookupUFM :: NamedThing a => UniqFM b -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 mapIdEnv :: (a -> b) -> UniqFM a -> UniqFM b
 mapIdEnv :: (a -> b) -> UniqFM a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM mapUFM _N_ #-}
-mapUFM :: (a -> b) -> UniqFM a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
-minusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkIdEnv :: [(Id, a)] -> UniqFM a
 mkIdEnv :: [(Id, a)] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _SPEC_ _ORIG_ UniqFM listToUFM [ (Id), _N_ ] _N_ #-}
 modifyIdEnv :: UniqFM a -> (a -> a) -> Id -> UniqFM a
 modifyIdEnv :: UniqFM a -> (a -> a) -> Id -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "SLU(U(P)AAA)" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 nullIdEnv :: UniqFM a
 nullIdEnv :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
-plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-plusUFM_C :: (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 rngIdEnv :: UniqFM a -> [a]
 rngIdEnv :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM eltsUFM _N_ #-}
-singletonUFM :: NamedThing a => a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)LL" {_A_ 3 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 2 3 XXX 6 _/\_ u0 u1 -> \ (u2 :: u0 -> Unique) (u3 :: u0) (u4 :: u1) -> case _APP_  u2 [ u3 ] of { _ALG_ _ORIG_ Unique MkUnique (u5 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [u5, u4]; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 2 3 CXX 7 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: u0) (u4 :: u1) -> case case u2 of { _ALG_ _TUP_10 (u5 :: u0 -> ExportFlag) (u6 :: u0 -> Bool) (u7 :: u0 -> (_PackedString, _PackedString)) (u8 :: u0 -> _PackedString) (u9 :: u0 -> [_PackedString]) (ua :: u0 -> SrcLoc) (ub :: u0 -> Unique) (uc :: u0 -> Bool) (ud :: u0 -> UniType) (ue :: u0 -> Bool) -> _APP_  ub [ u3 ]; _NO_DEFLT_ } of { _ALG_ _ORIG_ Unique MkUnique (uf :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [uf, u4]; _NO_DEFLT_ } _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "U(U(P)AAA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 5 _/\_ u0 -> \ (u1 :: Id) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Id Id (u3 :: Unique) (u4 :: UniType) (u5 :: IdInfo) (u6 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ Unique MkUnique (u7 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u7, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ } #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 unitIdEnv :: Id -> a -> UniqFM a
 unitIdEnv :: Id -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(P)AAA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 5 _/\_ u0 -> \ (u1 :: Id) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Id Id (u3 :: Unique) (u4 :: UniType) (u5 :: IdInfo) (u6 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ Unique MkUnique (u7 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u7, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 
 
index fae2749..74cccfd 100644 (file)
@@ -10,14 +10,12 @@ import HsLit(Literal)
 import HsMatches(Match)
 import HsPat(InPat, TypecheckedPat)
 import HsTypes(PolyType)
 import HsMatches(Match)
 import HsPat(InPat, TypecheckedPat)
 import HsTypes(PolyType)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo, SpecEnv, SpecInfo)
+import Id(Id)
+import IdInfo(SpecEnv, SpecInfo)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import Maybes(Labda, MaybeErr)
 import Name(Name)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import Maybes(Labda, MaybeErr)
 import Name(Name)
-import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import PreludePS(_PackedString)
-import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
@@ -25,35 +23,30 @@ import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Class 
 type ClassInstEnv = [(UniType, InstTemplate)]
 type ClassInstEnv = [(UniType, InstTemplate)]
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data InstOrigin        {-# GHC_PRAGMA OccurrenceOf Id SrcLoc | InstanceDeclOrigin SrcLoc | LiteralOrigin Literal SrcLoc | ArithSeqOrigin (ArithSeqInfo Name (InPat Name)) SrcLoc | SignatureOrigin | ClassDeclOrigin SrcLoc | DerivingOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class Bool TyCon SrcLoc | InstanceSpecOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class UniType SrcLoc | DefaultDeclOrigin SrcLoc | ValSpecOrigin Name SrcLoc | CCallOrigin SrcLoc [Char] (Labda (Expr Name (InPat Name))) | LitLitOrigin SrcLoc [Char] | UnknownOrigin #-}
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
-data InstTy    {-# GHC_PRAGMA DictTy Class UniType | MethodTy Id [UniType] #-}
+data ClassOp 
+data CoreExpr a b 
+data Expr a b 
+data Id 
+data Inst 
+data InstOrigin 
+data InstTemplate 
+data InstTy 
 type InstanceMapper = Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)
 type InstanceMapper = Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 type MatchEnv a b = [(a, b)]
 type MatchEnv a b = [(a, b)]
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
+data MaybeErr a b 
 type MethodInstInfo = (Id, [UniType], InstTemplate)
 type MethodInstInfo = (Id, [UniType], InstTemplate)
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data SpecInfo  {-# GHC_PRAGMA SpecInfo [Labda UniType] Int Id #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data TypecheckedPat 
+data SpecInfo 
+data SplitUniqSupply 
+data TyCon 
+data TyVarTemplate 
+data UniType 
 addClassInst :: Class -> [(UniType, InstTemplate)] -> UniType -> Id -> [TyVarTemplate] -> [(Class, UniType)] -> SrcLoc -> MaybeErr [(UniType, InstTemplate)] (Class, (UniType, SrcLoc), (UniType, SrcLoc))
 addClassInst :: Class -> [(UniType, InstTemplate)] -> UniType -> Id -> [TyVarTemplate] -> [(Class, UniType)] -> SrcLoc -> MaybeErr [(UniType, InstTemplate)] (Class, (UniType, SrcLoc), (UniType, SrcLoc))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222112 _N_ _S_ "LSLLLLL" _N_ _N_ #-}
 lookupClassInstAtSimpleType :: Class -> UniType -> Labda Id
 lookupClassInstAtSimpleType :: Class -> UniType -> Labda Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAAAAAAASA)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupInst :: SplitUniqSupply -> Inst -> Labda (Expr Id TypecheckedPat, [Inst])
 lookupInst :: SplitUniqSupply -> Inst -> Labda (Expr Id TypecheckedPat, [Inst])
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 lookupNoBindInst :: SplitUniqSupply -> Inst -> Labda [Inst]
 lookupNoBindInst :: SplitUniqSupply -> Inst -> Labda [Inst]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 nullMEnv :: [(a, b)]
 nullMEnv :: [(a, b)]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 2 0 X 1 _/\_ u0 u1 -> _!_ _NIL_ [(u0, u1)] [] _N_ #-}
 
 
index eb0f193..30118af 100644 (file)
@@ -1,20 +1,11 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LIE where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LIE where
-import Class(Class)
-import Id(Id)
-import Inst(Inst, InstOrigin, OverloadedLit)
-import UniType(UniType)
-import Unique(Unique)
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data LIE       {-# GHC_PRAGMA MkLIE [Inst] #-}
+import Inst(Inst)
+data Inst 
+data LIE 
 mkLIE :: [Inst] -> LIE
 mkLIE :: [Inst] -> LIE
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [Inst]) -> _!_ _ORIG_ LIE MkLIE [] [u0] _N_ #-}
 nullLIE :: LIE
 nullLIE :: LIE
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 plusLIE :: LIE -> LIE -> LIE
 plusLIE :: LIE -> LIE -> LIE
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(L)U(L)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 unMkLIE :: LIE -> [Inst]
 unMkLIE :: LIE -> [Inst]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [Inst]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: LIE) -> case u0 of { _ALG_ _ORIG_ LIE MkLIE (u1 :: [Inst]) -> u1; _NO_DEFLT_ } _N_ #-}
 unitLIE :: Inst -> LIE
 unitLIE :: Inst -> LIE
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 7903554..cde124a 100644 (file)
@@ -1,50 +1,30 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TCE where
 import CharSeq(CSeq)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TCE where
 import CharSeq(CSeq)
-import Class(Class)
 import ErrUtils(Error(..))
 import Id(Id)
 import ErrUtils(Error(..))
 import Id(Id)
-import Maybes(Labda, MaybeErr)
+import Maybes(MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
-import PrimKind(PrimKind)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
-import UniqFM(UniqFM, eltsUFM, emptyUFM, plusUFM, singletonDirectlyUFM)
-import Unique(Unique, u2i)
+import UniqFM(UniqFM)
+import Unique(Unique)
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
+data MaybeErr a b 
+data Name 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data PrettyRep 
+data SrcLoc 
 type TCE = UniqFM TyCon
 type TCE = UniqFM TyCon
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data TyCon 
+data UniqFM a 
 checkTypeCycles :: UniqFM TyCon -> MaybeErr () (PprStyle -> Int -> Bool -> PrettyRep)
 checkTypeCycles :: UniqFM TyCon -> MaybeErr () (PprStyle -> Int -> Bool -> PrettyRep)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
 lookupTCE :: UniqFM TyCon -> Name -> TyCon
 lookupTCE :: UniqFM TyCon -> Name -> TyCon
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 nullTCE :: UniqFM TyCon
 nullTCE :: UniqFM TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ UniqFM EmptyUFM [TyCon] [] _N_ #-}
 plusTCE :: UniqFM TyCon -> UniqFM TyCon -> UniqFM TyCon
 plusTCE :: UniqFM TyCon -> UniqFM TyCon -> UniqFM TyCon
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ UniqFM plusUFM { TyCon } _N_ #-}
-plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 rngTCE :: UniqFM TyCon -> [TyCon]
 rngTCE :: UniqFM TyCon -> [TyCon]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ UniqFM eltsUFM { TyCon } _N_ #-}
-singletonDirectlyUFM :: Unique -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 4 _/\_ u0 -> \ (u1 :: Unique) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u3, u2]; _NO_DEFLT_ } _N_ #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 unitTCE :: Unique -> TyCon -> UniqFM TyCon
 unitTCE :: Unique -> TyCon -> UniqFM TyCon
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int#) (u1 :: TyCon) -> _!_ _ORIG_ UniqFM LeafUFM [TyCon] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: Unique) (u1 :: TyCon) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [TyCon] [u2, u1]; _NO_DEFLT_ } _N_ #-}
 
 
index f4bc96a..4edf8d5 100644 (file)
@@ -1,42 +1,25 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TVE where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TVE where
-import Class(Class)
 import Id(Id)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import TyCon(TyCon)
 import Id(Id)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVarTemplate)
 import UniType(UniType)
 import UniType(UniType)
-import UniqFM(UniqFM, eltsUFM, emptyUFM, plusUFM, singletonDirectlyUFM)
-import Unique(Unique, u2i)
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
+import UniqFM(UniqFM)
+import Unique(Unique)
+data Labda a 
+data Name 
 type TVE = UniqFM UniType
 type TVE = UniqFM UniType
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
+data TyVarTemplate 
+data UniType 
+data UniqFM a 
 lookupTVE :: UniqFM UniType -> Name -> UniType
 lookupTVE :: UniqFM UniType -> Name -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ #-}
 lookupTVE_NoFail :: UniqFM a -> Name -> Labda a
 lookupTVE_NoFail :: UniqFM a -> Name -> Labda a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ #-}
 mkTVE :: [Name] -> (UniqFM UniType, [TyVarTemplate], [UniType])
 mkTVE :: [Name] -> (UniqFM UniType, [TyVarTemplate], [UniType])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 nullTVE :: UniqFM UniType
 nullTVE :: UniqFM UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ UniqFM EmptyUFM [UniType] [] _N_ #-}
 plusTVE :: UniqFM UniType -> UniqFM UniType -> UniqFM UniType
 plusTVE :: UniqFM UniType -> UniqFM UniType -> UniqFM UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ UniqFM plusUFM { UniType } _N_ #-}
-plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-singletonDirectlyUFM :: Unique -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 4 _/\_ u0 -> \ (u1 :: Unique) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u3, u2]; _NO_DEFLT_ } _N_ #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 unitTVE :: Unique -> a -> UniqFM a
 unitTVE :: Unique -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 4 _/\_ u0 -> \ (u1 :: Unique) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u3, u2]; _NO_DEFLT_ } _N_ #-}
 
 
index 1330078..5ceec06 100644 (file)
@@ -1,54 +1,20 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TyVarEnv where
 import Maybes(Labda(..))
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TyVarEnv where
 import Maybes(Labda(..))
-import NameTypes(ShortName)
-import Outputable(NamedThing)
 import TyVar(TyVar)
 import UniType(UniType)
 import TyVar(TyVar)
 import UniType(UniType)
-import UniqFM(UniqFM, addToUFM, delFromUFM, delListFromUFM, eltsUFM, emptyUFM, listToUFM, lookupUFM, mapUFM, minusUFM, plusUFM, plusUFM_C, singletonUFM)
-import Unique(Unique, u2i)
+import UniqFM(UniqFM)
+import Unique(Unique)
 data Labda a   = Hamna | Ni a
 data Labda a   = Hamna | Ni a
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
+data TyVar 
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniqFM a 
+data Unique 
 addOneToTyVarEnv :: UniqFM a -> TyVar -> a -> UniqFM a
 addOneToTyVarEnv :: UniqFM a -> TyVar -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _SPEC_ _ORIG_ UniqFM addToUFM [ (TyVar), _N_ ] _N_ #-}
-addToUFM :: NamedThing a => UniqFM b -> a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 4 _U_ 1222 _N_ _S_ "U(AAAAAASAAA)SLL" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 3 _U_ 222 _N_ _S_ "SSL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 3 _U_ 222 _N_ _S_ "SSL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "SU(U(P)AAA)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
-delFromUFM :: NamedThing a => UniqFM b -> a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
-delListFromUFM :: NamedThing a => UniqFM b -> [a] -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ } #-}
-eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
 growTyVarEnvList :: UniqFM a -> [(TyVar, a)] -> UniqFM a
 growTyVarEnvList :: UniqFM a -> [(TyVar, a)] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 isNullTyVarEnv :: UniqFM a -> Bool
 isNullTyVarEnv :: UniqFM a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-listToUFM :: NamedThing a => [(a, b)] -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ } #-}
 lookupTyVarEnv :: UniqFM a -> TyVar -> Labda a
 lookupTyVarEnv :: UniqFM a -> TyVar -> Labda a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _SPEC_ _ORIG_ UniqFM lookupUFM [ (TyVar), _N_ ] _N_ #-}
-lookupUFM :: NamedThing a => UniqFM b -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
-mapUFM :: (a -> b) -> UniqFM a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
-minusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 mkTyVarEnv :: [(TyVar, a)] -> UniqFM a
 mkTyVarEnv :: [(TyVar, a)] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _SPEC_ _ORIG_ UniqFM listToUFM [ (TyVar), _N_ ] _N_ #-}
 nullTyVarEnv :: UniqFM a
 nullTyVarEnv :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
-plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-plusUFM_C :: (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
-singletonUFM :: NamedThing a => a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)LL" {_A_ 3 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 2 3 XXX 6 _/\_ u0 u1 -> \ (u2 :: u0 -> Unique) (u3 :: u0) (u4 :: u1) -> case _APP_  u2 [ u3 ] of { _ALG_ _ORIG_ Unique MkUnique (u5 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [u5, u4]; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 2 3 CXX 7 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: u0) (u4 :: u1) -> case case u2 of { _ALG_ _TUP_10 (u5 :: u0 -> ExportFlag) (u6 :: u0 -> Bool) (u7 :: u0 -> (_PackedString, _PackedString)) (u8 :: u0 -> _PackedString) (u9 :: u0 -> [_PackedString]) (ua :: u0 -> SrcLoc) (ub :: u0 -> Unique) (uc :: u0 -> Bool) (ud :: u0 -> UniType) (ue :: u0 -> Bool) -> _APP_  ub [ u3 ]; _NO_DEFLT_ } of { _ALG_ _ORIG_ Unique MkUnique (uf :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [uf, u4]; _NO_DEFLT_ } _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "U(U(P)AAA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 5 _/\_ u0 -> \ (u1 :: Id) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Id Id (u3 :: Unique) (u4 :: UniType) (u5 :: IdInfo) (u6 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ Unique MkUnique (u7 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u7, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ } #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 
 
index 3b00fdc..7a9fcd1 100644 (file)
@@ -5,44 +5,18 @@ import Maybes(Labda)
 type CmdLineInfo = (GlobalSwitch -> SwitchResult, [CoreToDo], [StgToDo])
 data CoreToDo   = CoreDoSimplify (SimplifierSwitch -> SwitchResult) | CoreDoArityAnalysis | CoreDoCalcInlinings1 | CoreDoCalcInlinings2 | CoreDoFloatInwards | CoreDoFullLaziness | CoreLiberateCase | CoreDoPrintCore | CoreDoStaticArgs | CoreDoStrictness | CoreDoSpecialising | CoreDoDeforest | CoreDoAutoCostCentres | CoreDoFoldrBuildWorkerWrapper | CoreDoFoldrBuildWWAnal
 data GlobalSwitch
 type CmdLineInfo = (GlobalSwitch -> SwitchResult, [CoreToDo], [StgToDo])
 data CoreToDo   = CoreDoSimplify (SimplifierSwitch -> SwitchResult) | CoreDoArityAnalysis | CoreDoCalcInlinings1 | CoreDoCalcInlinings2 | CoreDoFloatInwards | CoreDoFullLaziness | CoreLiberateCase | CoreDoPrintCore | CoreDoStaticArgs | CoreDoStrictness | CoreDoSpecialising | CoreDoDeforest | CoreDoAutoCostCentres | CoreDoFoldrBuildWorkerWrapper | CoreDoFoldrBuildWWAnal
 data GlobalSwitch
-  = ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats
+  = ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | NumbersStrict | AllDemanded | ReturnInRegsThreshold Int | VectoredReturnThreshold Int | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats
 type MainIO a = _State _RealWorld -> (a, _State _RealWorld)
 type MainIO a = _State _RealWorld -> (a, _State _RealWorld)
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data SimplifierSwitch   = SimplOkToDupCode | SimplFloatLetsExposingWHNF | SimplOkToFloatPrimOps | SimplAlwaysFloatLetsFromLets | SimplDoCaseElim | SimplReuseCon | SimplCaseOfCase | SimplLetToCase | SimplMayDeleteConjurableIds | SimplPedanticBottoms | SimplDoArityExpand | SimplDoFoldrBuild | SimplDoNewOccurAnal | SimplDoInlineFoldrBuild | IgnoreINLINEPragma | SimplDoLambdaEtaExpansion | SimplDoEtaReduction | EssentialUnfoldingsOnly | ShowSimplifierProgress | MaxSimplifierIterations Int | SimplUnfoldingUseThreshold Int | SimplUnfoldingCreationThreshold Int | KeepSpecPragmaIds | KeepUnusedBindings
+data Labda a 
+data SimplifierSwitch   = SimplOkToDupCode | SimplFloatLetsExposingWHNF | SimplOkToFloatPrimOps | SimplAlwaysFloatLetsFromLets | SimplDoCaseElim | SimplReuseCon | SimplCaseOfCase | SimplLetToCase | SimplMayDeleteConjurableIds | SimplPedanticBottoms | SimplDoArityExpand | SimplDoFoldrBuild | SimplDoNewOccurAnal | SimplDoInlineFoldrBuild | IgnoreINLINEPragma | SimplDoLambdaEtaExpansion | SimplDoEtaReduction | EssentialUnfoldingsOnly | ShowSimplifierProgress | MaxSimplifierIterations Int | SimplUnfoldingUseThreshold Int | SimplUnfoldingCreationThreshold Int | KeepSpecPragmaIds | KeepUnusedBindings | SimplNoLetFromCase | SimplNoLetFromApp | SimplNoLetFromStrictLet
 data StgToDo   = StgDoStaticArgs | StgDoUpdateAnalysis | StgDoLambdaLift | StgDoMassageForProfiling | D_stg_stats
 data SwitchResult   = SwBool Bool | SwString [Char] | SwInt Int
 classifyOpts :: [[Char]] -> _State _RealWorld -> ((GlobalSwitch -> SwitchResult, [CoreToDo], [StgToDo]), _State _RealWorld)
 data StgToDo   = StgDoStaticArgs | StgDoUpdateAnalysis | StgDoLambdaLift | StgDoMassageForProfiling | D_stg_stats
 data SwitchResult   = SwBool Bool | SwString [Char] | SwInt Int
 classifyOpts :: [[Char]] -> _State _RealWorld -> ((GlobalSwitch -> SwitchResult, [CoreToDo], [StgToDo]), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 intSwitchSet :: (a -> SwitchResult) -> (Int -> a) -> Labda Int
 intSwitchSet :: (a -> SwitchResult) -> (Int -> a) -> Labda Int
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 stringSwitchSet :: (a -> SwitchResult) -> ([Char] -> a) -> Labda [Char]
 stringSwitchSet :: (a -> SwitchResult) -> ([Char] -> a) -> Labda [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 switchIsOn :: (a -> SwitchResult) -> a -> Bool
 switchIsOn :: (a -> SwitchResult) -> a -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instance Eq GlobalSwitch
 instance Eq GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool)] [_CONSTM_ Eq (==) (GlobalSwitch), _CONSTM_ Eq (/=) (GlobalSwitch)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq SimplifierSwitch
 instance Eq SimplifierSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool)] [_CONSTM_ Eq (==) (SimplifierSwitch), _CONSTM_ Eq (/=) (SimplifierSwitch)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord GlobalSwitch
 instance Ord GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq GlobalSwitch}}, (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> _CMP_TAG)] [_DFUN_ Eq (GlobalSwitch), _CONSTM_ Ord (<) (GlobalSwitch), _CONSTM_ Ord (<=) (GlobalSwitch), _CONSTM_ Ord (>=) (GlobalSwitch), _CONSTM_ Ord (>) (GlobalSwitch), _CONSTM_ Ord max (GlobalSwitch), _CONSTM_ Ord min (GlobalSwitch), _CONSTM_ Ord _tagCmp (GlobalSwitch)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord SimplifierSwitch
 instance Ord SimplifierSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq SimplifierSwitch}}, (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> Bool), (SimplifierSwitch -> SimplifierSwitch -> SimplifierSwitch), (SimplifierSwitch -> SimplifierSwitch -> SimplifierSwitch), (SimplifierSwitch -> SimplifierSwitch -> _CMP_TAG)] [_DFUN_ Eq (SimplifierSwitch), _CONSTM_ Ord (<) (SimplifierSwitch), _CONSTM_ Ord (<=) (SimplifierSwitch), _CONSTM_ Ord (>=) (SimplifierSwitch), _CONSTM_ Ord (>) (SimplifierSwitch), _CONSTM_ Ord max (SimplifierSwitch), _CONSTM_ Ord min (SimplifierSwitch), _CONSTM_ Ord _tagCmp (SimplifierSwitch)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 104a7e5..ba967f2 100644 (file)
@@ -198,8 +198,12 @@ data GlobalSwitch
   | IrrefutableEverything   -- (TcPat); doing it any earlier would mean that
                            -- deriving-generated code wouldn't be irrefutablified.
   | AllStrict
   | IrrefutableEverything   -- (TcPat); doing it any earlier would mean that
                            -- deriving-generated code wouldn't be irrefutablified.
   | AllStrict
+  | NumbersStrict
   | AllDemanded
 
   | AllDemanded
 
+  | ReturnInRegsThreshold   Int
+  | VectoredReturnThreshold Int -- very likely UNUSED
+
 -- NOT REALLY USED:  | D_dump_type_info        -- for Robin Popplestone stuff
 
   | D_dump_rif2hs      -- debugging: print out various things
 -- NOT REALLY USED:  | D_dump_type_info        -- for Robin Popplestone stuff
 
   | D_dump_rif2hs      -- debugging: print out various things
@@ -288,6 +292,9 @@ data SimplifierSwitch
   | KeepSpecPragmaIds      -- We normally *toss* Ids we can do without
   | KeepUnusedBindings
 
   | KeepSpecPragmaIds      -- We normally *toss* Ids we can do without
   | KeepUnusedBindings
 
+  | SimplNoLetFromCase     -- used when turning off floating entirely
+  | SimplNoLetFromApp      -- (for experimentation only) WDP 95/10
+  | SimplNoLetFromStrictLet
 {-
   | Extra__SimplFlag1
   | Extra__SimplFlag2
 {-
   | Extra__SimplFlag1
   | Extra__SimplFlag2
@@ -389,6 +396,7 @@ classifyOpts opts
            maybe_uut           = starts_with "-funfolding-use-threshold"      opt1
            maybe_uct           = starts_with "-funfolding-creation-threshold" opt1
            maybe_uot           = starts_with "-funfolding-override-threshold" opt1
            maybe_uut           = starts_with "-funfolding-use-threshold"      opt1
            maybe_uct           = starts_with "-funfolding-creation-threshold" opt1
            maybe_uot           = starts_with "-funfolding-override-threshold" opt1
+           maybe_rirt          = starts_with "-freturn-in-regs-threshold"     opt1
            maybe_gtn           = starts_with "-fglobalise-toplev-names"       opt1
            starts_with_fasm    = maybeToBool maybe_fasm
            starts_with_G       = maybeToBool maybe_G
            maybe_gtn           = starts_with "-fglobalise-toplev-names"       opt1
            starts_with_fasm    = maybeToBool maybe_fasm
            starts_with_G       = maybeToBool maybe_G
@@ -399,6 +407,7 @@ classifyOpts opts
            starts_with_uut     = maybeToBool maybe_uut
            starts_with_uct     = maybeToBool maybe_uct
            starts_with_uot     = maybeToBool maybe_uot
            starts_with_uut     = maybeToBool maybe_uut
            starts_with_uct     = maybeToBool maybe_uct
            starts_with_uot     = maybeToBool maybe_uot
+           starts_with_rirt    = maybeToBool maybe_rirt
            starts_with_gtn     = maybeToBool maybe_gtn
            (Just after_fasm)   = maybe_fasm
            (Just after_G)      = maybe_G
            starts_with_gtn     = maybeToBool maybe_gtn
            (Just after_fasm)   = maybe_fasm
            (Just after_G)      = maybe_G
@@ -409,6 +418,7 @@ classifyOpts opts
            (Just after_uut)    = maybe_uut
            (Just after_uct)    = maybe_uct
            (Just after_uot)    = maybe_uot
            (Just after_uut)    = maybe_uut
            (Just after_uct)    = maybe_uct
            (Just after_uot)    = maybe_uot
+           (Just after_rirt)   = maybe_rirt
            (Just after_gtn)    = maybe_gtn
        in
        case opt1 of -- the non-"just match a string" options are at the end...
            (Just after_gtn)    = maybe_gtn
        in
        case opt1 of -- the non-"just match a string" options are at the end...
@@ -452,6 +462,7 @@ classifyOpts opts
          "-firrefutable-tuples"        -> GLOBAL_SW(IrrefutableTuples)
          "-firrefutable-everything"    -> GLOBAL_SW(IrrefutableEverything)
          "-fall-strict"                -> GLOBAL_SW(AllStrict)
          "-firrefutable-tuples"        -> GLOBAL_SW(IrrefutableTuples)
          "-firrefutable-everything"    -> GLOBAL_SW(IrrefutableEverything)
          "-fall-strict"                -> GLOBAL_SW(AllStrict)
+         "-fnumbers-strict"            -> GLOBAL_SW(NumbersStrict)
          "-fall-demanded"              -> GLOBAL_SW(AllDemanded)
 
          "-fsemi-tagging"   -> GLOBAL_SW(DoSemiTagging)
          "-fall-demanded"              -> GLOBAL_SW(AllDemanded)
 
          "-fsemi-tagging"   -> GLOBAL_SW(DoSemiTagging)
@@ -520,7 +531,7 @@ classifyOpts opts
          "-fauto-sccs-on-individual-cafs"  -> GLOBAL_SW(AutoSccsOnIndividualCafs)
 --UNUSED: "-fauto-sccs-on-individual-dicts" -> GLOBAL_SW(AutoSccsOnIndividualDicts)
 
          "-fauto-sccs-on-individual-cafs"  -> GLOBAL_SW(AutoSccsOnIndividualCafs)
 --UNUSED: "-fauto-sccs-on-individual-dicts" -> GLOBAL_SW(AutoSccsOnIndividualDicts)
 
-         "-fstg-reduction-counts"  -> GLOBAL_SW(DoTickyProfiling)
+         "-fticky-ticky"  -> GLOBAL_SW(DoTickyProfiling)
 
          "-dppr-user"  ->          GLOBAL_SW(PprStyle_User)
          "-dppr-debug" ->          GLOBAL_SW(PprStyle_Debug)
 
          "-dppr-user"  ->          GLOBAL_SW(PprStyle_User)
          "-dppr-debug" ->          GLOBAL_SW(PprStyle_Debug)
@@ -551,8 +562,12 @@ classifyOpts opts
            | starts_with_uct  -> GLOBAL_SW(UnfoldingCreationThreshold (read after_uct))
            | starts_with_uot  -> GLOBAL_SW(UnfoldingOverrideThreshold (read after_uot))
 
            | starts_with_uct  -> GLOBAL_SW(UnfoldingCreationThreshold (read after_uct))
            | starts_with_uot  -> GLOBAL_SW(UnfoldingOverrideThreshold (read after_uot))
 
+           | starts_with_rirt -> -- trace ("rirt:"++after_rirt) $
+                                 GLOBAL_SW(ReturnInRegsThreshold (read after_rirt))
+
            | starts_with_gtn  -> GLOBAL_SW(EnsureSplittableC after_gtn)
 
            | starts_with_gtn  -> GLOBAL_SW(EnsureSplittableC after_gtn)
 
+
          _ -> writeMn stderr ("*** WARNING: bad option: "++opt1++"\n") `thenMn` ( \ _ ->
                -- NB: the driver is really supposed to handle bad options
               IGNORE_ARG() )
          _ -> writeMn stderr ("*** WARNING: bad option: "++opt1++"\n") `thenMn` ( \ _ ->
                -- NB: the driver is really supposed to handle bad options
               IGNORE_ARG() )
@@ -631,6 +646,9 @@ classifyOpts opts
          "-fmay-delete-conjurable-ids" -> GLOBAL_SIMPL_SW(SimplMayDeleteConjurableIds)
          "-fessential-unfoldings-only" -> GLOBAL_SIMPL_SW(EssentialUnfoldingsOnly) 
          "-fignore-inline-pragma"  -> GLOBAL_SIMPL_SW(IgnoreINLINEPragma)
          "-fmay-delete-conjurable-ids" -> GLOBAL_SIMPL_SW(SimplMayDeleteConjurableIds)
          "-fessential-unfoldings-only" -> GLOBAL_SIMPL_SW(EssentialUnfoldingsOnly) 
          "-fignore-inline-pragma"  -> GLOBAL_SIMPL_SW(IgnoreINLINEPragma)
+         "-fno-let-from-case"  -> GLOBAL_SIMPL_SW(SimplNoLetFromCase)
+         "-fno-let-from-app"  -> GLOBAL_SIMPL_SW(SimplNoLetFromApp)
+         "-fno-let-from-strict-let"  -> GLOBAL_SIMPL_SW(SimplNoLetFromStrictLet)
 
          _ | starts_with_msi  -> GLOBAL_SIMPL_SW(MaxSimplifierIterations (read after_msi))
            | starts_with_suut  -> GLOBAL_SIMPL_SW(SimplUnfoldingUseThreshold (read after_suut))
 
          _ | starts_with_msi  -> GLOBAL_SIMPL_SW(MaxSimplifierIterations (read after_msi))
            | starts_with_suut  -> GLOBAL_SIMPL_SW(SimplUnfoldingUseThreshold (read after_suut))
@@ -720,27 +738,30 @@ tagOf_Switch IgnoreStrictnessPragmas      = ILIT(51)
 tagOf_Switch IrrefutableTuples         = ILIT(52)
 tagOf_Switch IrrefutableEverything     = ILIT(53)
 tagOf_Switch AllStrict                 = ILIT(54)
 tagOf_Switch IrrefutableTuples         = ILIT(52)
 tagOf_Switch IrrefutableEverything     = ILIT(53)
 tagOf_Switch AllStrict                 = ILIT(54)
-tagOf_Switch AllDemanded               = ILIT(55)
+tagOf_Switch NumbersStrict             = ILIT(55)
+tagOf_Switch AllDemanded               = ILIT(56)
 -- NOT REALLY USED: tagOf_Switch D_dump_type_info              = ILIT(56)
 -- NOT REALLY USED: tagOf_Switch D_dump_type_info              = ILIT(56)
-tagOf_Switch D_dump_rif2hs             = ILIT(57)
-tagOf_Switch D_dump_rn4                        = ILIT(58)
-tagOf_Switch D_dump_tc                 = ILIT(59)
-tagOf_Switch D_dump_deriv              = ILIT(60)
-tagOf_Switch D_dump_ds                 = ILIT(61)
-tagOf_Switch D_dump_simpl              = ILIT(62)
-tagOf_Switch D_dump_spec               = ILIT(63)
-tagOf_Switch D_dump_occur_anal         = ILIT(64)
-tagOf_Switch D_dump_stranal            = ILIT(65)
-tagOf_Switch D_dump_stg                        = ILIT(66)
-tagOf_Switch D_dump_absC               = ILIT(67)
-tagOf_Switch D_dump_flatC              = ILIT(68)
-tagOf_Switch D_dump_realC              = ILIT(69)
-tagOf_Switch D_dump_asm                        = ILIT(70)
-tagOf_Switch D_dump_core_passes                = ILIT(71)
-tagOf_Switch D_dump_core_passes_info   = ILIT(72)
-tagOf_Switch D_verbose_core2core       = ILIT(73)
-tagOf_Switch D_verbose_stg2stg         = ILIT(74)
-tagOf_Switch D_simplifier_stats                = ILIT(75) {-note below-}
+tagOf_Switch (ReturnInRegsThreshold _) = ILIT(57)
+tagOf_Switch (VectoredReturnThreshold _)= ILIT(58)
+tagOf_Switch D_dump_rif2hs             = ILIT(59)
+tagOf_Switch D_dump_rn4                        = ILIT(60)
+tagOf_Switch D_dump_tc                 = ILIT(61)
+tagOf_Switch D_dump_deriv              = ILIT(62)
+tagOf_Switch D_dump_ds                 = ILIT(63)
+tagOf_Switch D_dump_simpl              = ILIT(64)
+tagOf_Switch D_dump_spec               = ILIT(65)
+tagOf_Switch D_dump_occur_anal         = ILIT(66)
+tagOf_Switch D_dump_stranal            = ILIT(67)
+tagOf_Switch D_dump_stg                        = ILIT(68)
+tagOf_Switch D_dump_absC               = ILIT(69)
+tagOf_Switch D_dump_flatC              = ILIT(70)
+tagOf_Switch D_dump_realC              = ILIT(71)
+tagOf_Switch D_dump_asm                        = ILIT(72)
+tagOf_Switch D_dump_core_passes                = ILIT(73)
+tagOf_Switch D_dump_core_passes_info   = ILIT(74)
+tagOf_Switch D_verbose_core2core       = ILIT(75)
+tagOf_Switch D_verbose_stg2stg         = ILIT(76)
+tagOf_Switch D_simplifier_stats                = ILIT(77) {-see note below!-}
 
 {-
 tagOf_Switch Extra__Flag1              = ILIT(76)
 
 {-
 tagOf_Switch Extra__Flag1              = ILIT(76)
@@ -808,6 +829,10 @@ tagOf_SimplSwitch (SimplUnfoldingUseThreshold _)      = ILIT(22)
 tagOf_SimplSwitch (SimplUnfoldingCreationThreshold _) = ILIT(23)
 tagOf_SimplSwitch KeepSpecPragmaIds            = ILIT(24)
 tagOf_SimplSwitch KeepUnusedBindings           = ILIT(25)
 tagOf_SimplSwitch (SimplUnfoldingCreationThreshold _) = ILIT(23)
 tagOf_SimplSwitch KeepSpecPragmaIds            = ILIT(24)
 tagOf_SimplSwitch KeepUnusedBindings           = ILIT(25)
+tagOf_SimplSwitch SimplNoLetFromCase           = ILIT(26)
+tagOf_SimplSwitch SimplNoLetFromApp            = ILIT(27)
+tagOf_SimplSwitch SimplNoLetFromStrictLet      = ILIT(28)
+-- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 
 {-
 tagOf_SimplSwitch Extra__SimplFlag1            = ILIT(26)
 
 {-
 tagOf_SimplSwitch Extra__SimplFlag1            = ILIT(26)
@@ -822,7 +847,7 @@ tagOf_SimplSwitch Extra__SimplFlag8         = ILIT(32)
 tagOf_SimplSwitch _ = case (panic "tagOf_SimplSwitch") of -- BUG avoidance
                        s -> tagOf_SimplSwitch s
 
 tagOf_SimplSwitch _ = case (panic "tagOf_SimplSwitch") of -- BUG avoidance
                        s -> tagOf_SimplSwitch s
 
-lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch KeepUnusedBindings)
+lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch SimplNoLetFromStrictLet)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -873,6 +898,8 @@ isAmong on_switches
     mk_assoc_elem k@(UnfoldingCreationThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
     mk_assoc_elem k@(UnfoldingOverrideThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
 
     mk_assoc_elem k@(UnfoldingCreationThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
     mk_assoc_elem k@(UnfoldingOverrideThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
 
+    mk_assoc_elem k@(ReturnInRegsThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
+
     mk_assoc_elem k = IBOX(tagOf_Switch k) := SwBool True -- I'm here, Mom!
 
     -- cannot have duplicates if we are going to use the array thing
     mk_assoc_elem k = IBOX(tagOf_Switch k) := SwBool True -- I'm here, Mom!
 
     -- cannot have duplicates if we are going to use the array thing
@@ -963,7 +990,8 @@ intSwitchSet :: (switch -> SwitchResult)
             -> Maybe Int
 
 intSwitchSet lookup_fn switch
             -> Maybe Int
 
 intSwitchSet lookup_fn switch
-  = case (lookup_fn (switch (panic "intSwitchSet"))) of
+  = -- pprTrace "intSwitchSet:" (ppInt (IBOX (tagOf_Switch (switch (panic "xxx"))))) $
+    case (lookup_fn (switch (panic "intSwitchSet"))) of
       SwInt int -> Just int
       _                -> Nothing
 \end{code}
       SwInt int -> Just int
       _                -> Nothing
 \end{code}
index 62a5f4d..2c8cccd 100644 (file)
@@ -5,11 +5,7 @@ import Pretty(PprStyle, PrettyRep)
 import SrcLoc(SrcLoc)
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 addErrLoc :: SrcLoc -> [Char] -> (PprStyle -> Int -> Bool -> PrettyRep) -> PprStyle -> Int -> Bool -> PrettyRep
 import SrcLoc(SrcLoc)
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 addErrLoc :: SrcLoc -> [Char] -> (PprStyle -> Int -> Bool -> PrettyRep) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 221222 _N_ _N_ _N_ _N_ #-}
 addShortErrLocLine :: SrcLoc -> (PprStyle -> Int -> Bool -> PrettyRep) -> PprStyle -> Int -> Bool -> PrettyRep
 addShortErrLocLine :: SrcLoc -> (PprStyle -> Int -> Bool -> PrettyRep) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "SLL" _N_ _N_ #-}
 dontAddErrLoc :: [Char] -> (PprStyle -> Int -> Bool -> PrettyRep) -> PprStyle -> Int -> Bool -> PrettyRep
 dontAddErrLoc :: [Char] -> (PprStyle -> Int -> Bool -> PrettyRep) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _N_ _N_ _N_ #-}
 pprBagOfErrors :: PprStyle -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 pprBagOfErrors :: PprStyle -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 76dfebe..3a58421 100644 (file)
@@ -6,7 +6,7 @@ import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..), pprBagOfErrors)
 import ErrsRn(badClassOpErr, badExportNameErr, badImportNameErr, derivingInIfaceErr, derivingNonStdClassErr, dupNamesErr, dupPreludeNameErr, dupSigDeclErr, duplicateImportsInInterfaceErr, inlineInRecursiveBindsErr, methodBindErr, missingSigErr, shadowedNameErr, unknownNameErr, unknownSigDeclErr, weirdImportExportConstraintErr)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..), pprBagOfErrors)
 import ErrsRn(badClassOpErr, badExportNameErr, badImportNameErr, derivingInIfaceErr, derivingNonStdClassErr, dupNamesErr, dupPreludeNameErr, dupSigDeclErr, duplicateImportsInInterfaceErr, inlineInRecursiveBindsErr, methodBindErr, missingSigErr, shadowedNameErr, unknownNameErr, unknownSigDeclErr, weirdImportExportConstraintErr)
-import ErrsTc(UnifyErrContext(..), UnifyErrInfo(..), ambigErr, badMatchErr, badSpecialisationErr, classCycleErr, confusedNameErr, dataConArityErr, defaultErr, derivingEnumErr, derivingIxErr, derivingWhenInstanceExistsErr, dupInstErr, genCantGenErr, instTypeErr, methodTypeLacksTyVarErr, naughtyCCallContextErr, noInstanceErr, nonBoxedPrimCCallErr, notAsPolyAsSigErr, preludeInstanceErr, reduceErr, sigContextsErr, specCtxtGroundnessErr, specDataNoSpecErr, specDataUnboxedErr, specGroundnessErr, specInstUnspecInstNotFoundErr, topLevelUnboxedDeclErr, tyConArityErr, typeCycleErr, unifyErr, varyingArgsErr)
+import ErrsTc(UnifyErrContext(..), UnifyErrInfo(..), ambigErr, badMatchErr, badSpecialisationErr, classCycleErr, confusedNameErr, dataConArityErr, defaultErr, derivingEnumErr, derivingIxErr, derivingWhenInstanceExistsErr, dupInstErr, genCantGenErr, instTypeErr, lurkingRank2Err, methodTypeLacksTyVarErr, naughtyCCallContextErr, noInstanceErr, nonBoxedPrimCCallErr, notAsPolyAsSigErr, preludeInstanceErr, reduceErr, sigContextsErr, specCtxtGroundnessErr, specDataNoSpecErr, specDataUnboxedErr, specGroundnessErr, specInstUnspecInstNotFoundErr, topLevelUnboxedDeclErr, tyConArityErr, typeCycleErr, underAppliedTyErr, unifyErr, varyingArgsErr)
 import GenSpecEtc(SignatureInfo)
 import HsBinds(Binds, MonoBinds, ProtoNameMonoBinds(..), RenamedSig(..), Sig)
 import HsExpr(ArithSeqInfo, Expr, Qual, RenamedExpr(..), TypecheckedExpr(..))
 import GenSpecEtc(SignatureInfo)
 import HsBinds(Binds, MonoBinds, ProtoNameMonoBinds(..), RenamedSig(..), Sig)
 import HsExpr(ArithSeqInfo, Expr, Qual, RenamedExpr(..), TypecheckedExpr(..))
@@ -14,18 +14,15 @@ import HsImpExp(IE)
 import HsLit(Literal)
 import HsMatches(GRHS, GRHSsAndBinds, Match, RenamedGRHS(..), RenamedGRHSsAndBinds(..), RenamedMatch(..))
 import HsPat(InPat, ProtoNamePat(..), RenamedPat(..), TypecheckedPat)
 import HsLit(Literal)
 import HsMatches(GRHS, GRHSsAndBinds, Match, RenamedGRHS(..), RenamedGRHSsAndBinds(..), RenamedMatch(..))
 import HsPat(InPat, ProtoNamePat(..), RenamedPat(..), TypecheckedPat)
-import HsPragmas(ClassOpPragmas, GenPragmas, ImpStrictness, ImpUnfolding)
-import HsTypes(MonoType, PolyType)
-import Id(Id, IdDetails)
-import IdInfo(DeforestInfo, IdInfo, UpdateInfo)
-import Inst(Inst, InstOrigin, OverloadedLit)
-import InstEnv(InstTemplate)
+import HsPragmas(ClassOpPragmas, GenPragmas)
+import HsTypes(PolyType)
+import Id(Id)
+import Inst(Inst)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
-import PrimKind(PrimKind)
 import ProtoName(ProtoName)
 import SimplEnv(UnfoldingGuidance)
 import SrcLoc(SrcLoc)
 import ProtoName(ProtoName)
 import SimplEnv(UnfoldingGuidance)
 import SrcLoc(SrcLoc)
@@ -33,141 +30,95 @@ import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(TauType(..), UniType)
 import Unique(Unique)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(TauType(..), UniType)
 import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
+data Bag a 
+data Class 
+data ClassOp 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 data UnifyErrContext
   = PredCtxt (Expr Name (InPat Name)) | AppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | TooManyArgsCtxt (Expr Name (InPat Name)) | FunAppCtxt (Expr Name (InPat Name)) (Labda Id) (Expr Name (InPat Name)) UniType UniType Int | OpAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionLAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionRAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | CaseCtxt (Expr Name (InPat Name)) [Match Name (InPat Name)] | BranchCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | ListCtxt [Expr Name (InPat Name)] | PatCtxt (InPat Name) | CaseBranchesCtxt [Match Name (InPat Name)] | FilterCtxt (Expr Name (InPat Name)) | GeneratorCtxt (InPat Name) (Expr Name (InPat Name)) | GRHSsBranchCtxt [GRHS Name (InPat Name)] | GRHSsGuardCtxt (Expr Name (InPat Name)) | PatMonoBindsCtxt (InPat Name) (GRHSsAndBinds Name (InPat Name)) | FunMonoBindsCtxt Name [Match Name (InPat Name)] | MatchCtxt UniType UniType | ArithSeqCtxt (Expr Name (InPat Name)) | CCallCtxt [Char] [Expr Name (InPat Name)] | AmbigDictCtxt [Inst] | SigCtxt Id UniType | MethodSigCtxt Name UniType | ExprSigCtxt (Expr Name (InPat Name)) UniType | ValSpecSigCtxt Name UniType SrcLoc | ValSpecSpecIdCtxt Name UniType Name SrcLoc | BindSigCtxt [Id] | SuperClassSigCtxt | CaseBranchCtxt (Match Name (InPat Name)) | Rank2ArgCtxt (Expr Id TypecheckedPat) UniType
 data UnifyErrInfo   = UnifyMisMatch UniType UniType | TypeRec TyVar UniType | UnifyListMisMatch [UniType] [UniType]
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 data UnifyErrContext
   = PredCtxt (Expr Name (InPat Name)) | AppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | TooManyArgsCtxt (Expr Name (InPat Name)) | FunAppCtxt (Expr Name (InPat Name)) (Labda Id) (Expr Name (InPat Name)) UniType UniType Int | OpAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionLAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionRAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | CaseCtxt (Expr Name (InPat Name)) [Match Name (InPat Name)] | BranchCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | ListCtxt [Expr Name (InPat Name)] | PatCtxt (InPat Name) | CaseBranchesCtxt [Match Name (InPat Name)] | FilterCtxt (Expr Name (InPat Name)) | GeneratorCtxt (InPat Name) (Expr Name (InPat Name)) | GRHSsBranchCtxt [GRHS Name (InPat Name)] | GRHSsGuardCtxt (Expr Name (InPat Name)) | PatMonoBindsCtxt (InPat Name) (GRHSsAndBinds Name (InPat Name)) | FunMonoBindsCtxt Name [Match Name (InPat Name)] | MatchCtxt UniType UniType | ArithSeqCtxt (Expr Name (InPat Name)) | CCallCtxt [Char] [Expr Name (InPat Name)] | AmbigDictCtxt [Inst] | SigCtxt Id UniType | MethodSigCtxt Name UniType | ExprSigCtxt (Expr Name (InPat Name)) UniType | ValSpecSigCtxt Name UniType SrcLoc | ValSpecSpecIdCtxt Name UniType Name SrcLoc | BindSigCtxt [Id] | SuperClassSigCtxt | CaseBranchCtxt (Match Name (InPat Name)) | Rank2ArgCtxt (Expr Id TypecheckedPat) UniType
 data UnifyErrInfo   = UnifyMisMatch UniType UniType | TypeRec TyVar UniType | UnifyListMisMatch [UniType] [UniType]
-data SignatureInfo     {-# GHC_PRAGMA TySigInfo Id [TyVar] [Inst] UniType SrcLoc | ValSpecInfo Name UniType (Labda Name) SrcLoc | ValInlineInfo Name UnfoldingGuidance SrcLoc | ValDeforestInfo Name SrcLoc | ValMagicUnfoldingInfo Name _PackedString SrcLoc #-}
-data MonoBinds a b     {-# GHC_PRAGMA EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc #-}
+data SignatureInfo 
+data MonoBinds a b 
 type ProtoNameMonoBinds = MonoBinds ProtoName (InPat ProtoName)
 type RenamedSig = Sig Name
 type ProtoNameMonoBinds = MonoBinds ProtoName (InPat ProtoName)
 type RenamedSig = Sig Name
-data Sig a     {-# GHC_PRAGMA Sig a (PolyType a) (GenPragmas a) SrcLoc | ClassOpSig a (PolyType a) (ClassOpPragmas a) SrcLoc | SpecSig a (PolyType a) (Labda a) SrcLoc | InlineSig a UnfoldingGuidance SrcLoc | DeforestSig a SrcLoc | MagicUnfoldingSig a _PackedString SrcLoc #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
+data Sig a 
+data Expr a b 
 type RenamedExpr = Expr Name (InPat Name)
 type TypecheckedExpr = Expr Id TypecheckedPat
 type RenamedExpr = Expr Name (InPat Name)
 type TypecheckedExpr = Expr Id TypecheckedPat
-data IE        {-# GHC_PRAGMA IEVar _PackedString | IEThingAbs _PackedString | IEThingAll _PackedString | IEConWithCons _PackedString [_PackedString] | IEClsWithOps _PackedString [_PackedString] | IEModuleContents _PackedString #-}
-data GRHS a b  {-# GHC_PRAGMA GRHS (Expr a b) (Expr a b) SrcLoc | OtherwiseGRHS (Expr a b) SrcLoc #-}
-data GRHSsAndBinds a b         {-# GHC_PRAGMA GRHSsAndBindsIn [GRHS a b] (Binds a b) | GRHSsAndBindsOut [GRHS a b] (Binds a b) UniType #-}
-data Match a b         {-# GHC_PRAGMA PatMatch b (Match a b) | GRHSMatch (GRHSsAndBinds a b) #-}
+data IE 
+data GRHS a b 
+data GRHSsAndBinds a b 
+data Match a b 
 type RenamedGRHS = GRHS Name (InPat Name)
 type RenamedGRHSsAndBinds = GRHSsAndBinds Name (InPat Name)
 type RenamedMatch = Match Name (InPat Name)
 type RenamedGRHS = GRHS Name (InPat Name)
 type RenamedGRHSsAndBinds = GRHSsAndBinds Name (InPat Name)
 type RenamedMatch = Match Name (InPat Name)
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data InPat a 
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data GenPragmas a      {-# GHC_PRAGMA NoGenPragmas | GenPragmas (Labda Int) (Labda UpdateInfo) DeforestInfo (ImpStrictness a) (ImpUnfolding a) [([Labda (MonoType a)], Int, GenPragmas a)] #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data TypecheckedPat 
+data GenPragmas a 
+data Id 
+data Inst 
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data PrettyRep 
+data ProtoName 
+data SrcLoc 
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type TauType = UniType
 type TauType = UniType
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data UniType 
 pprBagOfErrors :: PprStyle -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 pprBagOfErrors :: PprStyle -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 badClassOpErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badClassOpErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 badExportNameErr :: [Char] -> [Char] -> PprStyle -> Int -> Bool -> PrettyRep
 badExportNameErr :: [Char] -> [Char] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 badImportNameErr :: [Char] -> [Char] -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badImportNameErr :: [Char] -> [Char] -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 1222222 _N_ _N_ _N_ _N_ #-}
 derivingInIfaceErr :: ProtoName -> [ProtoName] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 derivingInIfaceErr :: ProtoName -> [ProtoName] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 derivingNonStdClassErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 derivingNonStdClassErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 dupNamesErr :: [Char] -> [(ProtoName, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
 dupNamesErr :: [Char] -> [(ProtoName, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "LSL" _N_ _N_ #-}
 dupPreludeNameErr :: [Char] -> (ProtoName, SrcLoc) -> PprStyle -> Int -> Bool -> PrettyRep
 dupPreludeNameErr :: [Char] -> (ProtoName, SrcLoc) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "LU(LS)L" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 dupSigDeclErr :: [Sig Name] -> PprStyle -> Int -> Bool -> PrettyRep
 dupSigDeclErr :: [Sig Name] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 duplicateImportsInInterfaceErr :: [Char] -> [ProtoName] -> PprStyle -> Int -> Bool -> PrettyRep
 duplicateImportsInInterfaceErr :: [Char] -> [ProtoName] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 00222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 5 XXXXX 5 \ (u0 :: [Char]) (u1 :: [ProtoName]) (u2 :: PprStyle) (u3 :: Int) (u4 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (PprStyle -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "duplicateImportsInInterfaceErr: NOT DONE YET?", u2, u3, u4 ] _N_ #-}
 inlineInRecursiveBindsErr :: [(Name, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
 inlineInRecursiveBindsErr :: [(Name, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _S_ "S" _N_ _N_ #-}
 methodBindErr :: MonoBinds ProtoName (InPat ProtoName) -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 methodBindErr :: MonoBinds ProtoName (InPat ProtoName) -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 missingSigErr :: SrcLoc -> ProtoName -> PprStyle -> Int -> Bool -> PrettyRep
 missingSigErr :: SrcLoc -> ProtoName -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "SLL" _N_ _N_ #-}
 shadowedNameErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 shadowedNameErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
 unknownNameErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unknownNameErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 unknownSigDeclErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unknownSigDeclErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 weirdImportExportConstraintErr :: ProtoName -> IE -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 weirdImportExportConstraintErr :: ProtoName -> IE -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 ambigErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
 ambigErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222 _N_ _S_ "S" _N_ _N_ #-}
 badMatchErr :: UniType -> UniType -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badMatchErr :: UniType -> UniType -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 badSpecialisationErr :: [Char] -> [Char] -> Int -> [Labda UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badSpecialisationErr :: [Char] -> [Char] -> Int -> [Labda UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 12002222 _N_ _S_ "LLAAL" {_A_ 3 _U_ 122222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 classCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
 classCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1022 _N_ _N_ _N_ _N_ #-}
 confusedNameErr :: [Char] -> Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 confusedNameErr :: [Char] -> Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 dataConArityErr :: Id -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 dataConArityErr :: Id -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 defaultErr :: [Inst] -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
 defaultErr :: [Inst] -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _N_ _N_ _N_ #-}
 derivingEnumErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
 derivingEnumErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 derivingIxErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
 derivingIxErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 derivingWhenInstanceExistsErr :: Class -> TyCon -> PprStyle -> Int -> Bool -> PrettyRep
 derivingWhenInstanceExistsErr :: Class -> TyCon -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 dupInstErr :: (Class, (UniType, SrcLoc), (UniType, SrcLoc)) -> PprStyle -> Int -> Bool -> PrettyRep
 dupInstErr :: (Class, (UniType, SrcLoc), (UniType, SrcLoc)) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1222 _N_ _S_ "U(LU(LL)U(AL))L" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 genCantGenErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
 genCantGenErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222 _N_ _S_ "S" _N_ _N_ #-}
 instTypeErr :: UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 instTypeErr :: UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
+lurkingRank2Err :: Name -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 methodTypeLacksTyVarErr :: TyVarTemplate -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 methodTypeLacksTyVarErr :: TyVarTemplate -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 naughtyCCallContextErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 naughtyCCallContextErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 noInstanceErr :: Inst -> PprStyle -> Int -> Bool -> PrettyRep
 noInstanceErr :: Inst -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 nonBoxedPrimCCallErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 nonBoxedPrimCCallErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 notAsPolyAsSigErr :: UniType -> [TyVar] -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 notAsPolyAsSigErr :: UniType -> [TyVar] -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 0222222 _N_ _S_ "ALLLL" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 preludeInstanceErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 preludeInstanceErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 reduceErr :: [Inst] -> UnifyErrContext -> PprStyle -> Int -> Bool -> PrettyRep
 reduceErr :: [Inst] -> UnifyErrContext -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 sigContextsErr :: [SignatureInfo] -> PprStyle -> Int -> Bool -> PrettyRep
 sigContextsErr :: [SignatureInfo] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 specCtxtGroundnessErr :: UnifyErrContext -> [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
 specCtxtGroundnessErr :: UnifyErrContext -> [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 11222 _N_ _S_ "SLL" _N_ _N_ #-}
 specDataNoSpecErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 specDataNoSpecErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 specDataUnboxedErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 specDataUnboxedErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 specGroundnessErr :: UnifyErrContext -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
 specGroundnessErr :: UnifyErrContext -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "SLL" _N_ _N_ #-}
 specInstUnspecInstNotFoundErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 specInstUnspecInstNotFoundErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 topLevelUnboxedDeclErr :: Id -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 topLevelUnboxedDeclErr :: Id -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
 tyConArityErr :: Name -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 tyConArityErr :: Name -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 typeCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
 typeCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1022 _N_ _N_ _N_ _N_ #-}
+underAppliedTyErr :: UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unifyErr :: UnifyErrInfo -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unifyErr :: UnifyErrInfo -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 varyingArgsErr :: Name -> [Match Name (InPat Name)] -> PprStyle -> Int -> Bool -> PrettyRep
 varyingArgsErr :: Name -> [Match Name (InPat Name)] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 20222 _N_ _S_ "LAL" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index ae2e631..3a8a376 100644 (file)
@@ -53,6 +53,7 @@ module Errors (
        instTypeErr,
 --     methodInstErr, UNUSED
        methodBindErr,
        instTypeErr,
 --     methodInstErr, UNUSED
        methodBindErr,
+       lurkingRank2Err,
        methodTypeLacksTyVarErr,
 --     missingClassOpErr, UNUSED
        naughtyCCallContextErr,
        methodTypeLacksTyVarErr,
 --     missingClassOpErr, UNUSED
        naughtyCCallContextErr,
@@ -70,6 +71,7 @@ module Errors (
        specInstUnspecInstNotFoundErr,
        topLevelUnboxedDeclErr,
        tyConArityErr,
        specInstUnspecInstNotFoundErr,
        topLevelUnboxedDeclErr,
        tyConArityErr,
+       underAppliedTyErr,
        unifyErr,
        varyingArgsErr,
 #ifdef DPH
        unifyErr,
        varyingArgsErr,
 #ifdef DPH
index 558890e..1a4de4c 100644 (file)
@@ -8,35 +8,19 @@ import Pretty(PprStyle, PrettyRep)
 import ProtoName(ProtoName)
 import SrcLoc(SrcLoc)
 badClassOpErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 import ProtoName(ProtoName)
 import SrcLoc(SrcLoc)
 badClassOpErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 badExportNameErr :: [Char] -> [Char] -> PprStyle -> Int -> Bool -> PrettyRep
 badExportNameErr :: [Char] -> [Char] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 badImportNameErr :: [Char] -> [Char] -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badImportNameErr :: [Char] -> [Char] -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 1222222 _N_ _N_ _N_ _N_ #-}
 derivingInIfaceErr :: ProtoName -> [ProtoName] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 derivingInIfaceErr :: ProtoName -> [ProtoName] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 derivingNonStdClassErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 derivingNonStdClassErr :: Name -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 dupNamesErr :: [Char] -> [(ProtoName, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
 dupNamesErr :: [Char] -> [(ProtoName, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "LSL" _N_ _N_ #-}
 dupPreludeNameErr :: [Char] -> (ProtoName, SrcLoc) -> PprStyle -> Int -> Bool -> PrettyRep
 dupPreludeNameErr :: [Char] -> (ProtoName, SrcLoc) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "LU(LS)L" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 dupSigDeclErr :: [Sig Name] -> PprStyle -> Int -> Bool -> PrettyRep
 dupSigDeclErr :: [Sig Name] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 duplicateImportsInInterfaceErr :: [Char] -> [ProtoName] -> PprStyle -> Int -> Bool -> PrettyRep
 duplicateImportsInInterfaceErr :: [Char] -> [ProtoName] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 00222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 5 XXXXX 5 \ (u0 :: [Char]) (u1 :: [ProtoName]) (u2 :: PprStyle) (u3 :: Int) (u4 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (PprStyle -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "duplicateImportsInInterfaceErr: NOT DONE YET?", u2, u3, u4 ] _N_ #-}
 inlineInRecursiveBindsErr :: [(Name, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
 inlineInRecursiveBindsErr :: [(Name, SrcLoc)] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _S_ "S" _N_ _N_ #-}
 methodBindErr :: MonoBinds ProtoName (InPat ProtoName) -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 methodBindErr :: MonoBinds ProtoName (InPat ProtoName) -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 missingSigErr :: SrcLoc -> ProtoName -> PprStyle -> Int -> Bool -> PrettyRep
 missingSigErr :: SrcLoc -> ProtoName -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "SLL" _N_ _N_ #-}
 shadowedNameErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 shadowedNameErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
 unknownNameErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unknownNameErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 unknownSigDeclErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unknownSigDeclErr :: [Char] -> ProtoName -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 weirdImportExportConstraintErr :: ProtoName -> IE -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 weirdImportExportConstraintErr :: ProtoName -> IE -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 
 
index f087597..65799e1 100644 (file)
@@ -18,65 +18,36 @@ data UnifyErrContext
   = PredCtxt (Expr Name (InPat Name)) | AppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | TooManyArgsCtxt (Expr Name (InPat Name)) | FunAppCtxt (Expr Name (InPat Name)) (Labda Id) (Expr Name (InPat Name)) UniType UniType Int | OpAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionLAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionRAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | CaseCtxt (Expr Name (InPat Name)) [Match Name (InPat Name)] | BranchCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | ListCtxt [Expr Name (InPat Name)] | PatCtxt (InPat Name) | CaseBranchesCtxt [Match Name (InPat Name)] | FilterCtxt (Expr Name (InPat Name)) | GeneratorCtxt (InPat Name) (Expr Name (InPat Name)) | GRHSsBranchCtxt [GRHS Name (InPat Name)] | GRHSsGuardCtxt (Expr Name (InPat Name)) | PatMonoBindsCtxt (InPat Name) (GRHSsAndBinds Name (InPat Name)) | FunMonoBindsCtxt Name [Match Name (InPat Name)] | MatchCtxt UniType UniType | ArithSeqCtxt (Expr Name (InPat Name)) | CCallCtxt [Char] [Expr Name (InPat Name)] | AmbigDictCtxt [Inst] | SigCtxt Id UniType | MethodSigCtxt Name UniType | ExprSigCtxt (Expr Name (InPat Name)) UniType | ValSpecSigCtxt Name UniType SrcLoc | ValSpecSpecIdCtxt Name UniType Name SrcLoc | BindSigCtxt [Id] | SuperClassSigCtxt | CaseBranchCtxt (Match Name (InPat Name)) | Rank2ArgCtxt (Expr Id TypecheckedPat) UniType
 data UnifyErrInfo   = UnifyMisMatch UniType UniType | TypeRec TyVar UniType | UnifyListMisMatch [UniType] [UniType]
 ambigErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
   = PredCtxt (Expr Name (InPat Name)) | AppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | TooManyArgsCtxt (Expr Name (InPat Name)) | FunAppCtxt (Expr Name (InPat Name)) (Labda Id) (Expr Name (InPat Name)) UniType UniType Int | OpAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionLAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionRAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | CaseCtxt (Expr Name (InPat Name)) [Match Name (InPat Name)] | BranchCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | ListCtxt [Expr Name (InPat Name)] | PatCtxt (InPat Name) | CaseBranchesCtxt [Match Name (InPat Name)] | FilterCtxt (Expr Name (InPat Name)) | GeneratorCtxt (InPat Name) (Expr Name (InPat Name)) | GRHSsBranchCtxt [GRHS Name (InPat Name)] | GRHSsGuardCtxt (Expr Name (InPat Name)) | PatMonoBindsCtxt (InPat Name) (GRHSsAndBinds Name (InPat Name)) | FunMonoBindsCtxt Name [Match Name (InPat Name)] | MatchCtxt UniType UniType | ArithSeqCtxt (Expr Name (InPat Name)) | CCallCtxt [Char] [Expr Name (InPat Name)] | AmbigDictCtxt [Inst] | SigCtxt Id UniType | MethodSigCtxt Name UniType | ExprSigCtxt (Expr Name (InPat Name)) UniType | ValSpecSigCtxt Name UniType SrcLoc | ValSpecSpecIdCtxt Name UniType Name SrcLoc | BindSigCtxt [Id] | SuperClassSigCtxt | CaseBranchCtxt (Match Name (InPat Name)) | Rank2ArgCtxt (Expr Id TypecheckedPat) UniType
 data UnifyErrInfo   = UnifyMisMatch UniType UniType | TypeRec TyVar UniType | UnifyListMisMatch [UniType] [UniType]
 ambigErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222 _N_ _S_ "S" _N_ _N_ #-}
 badMatchErr :: UniType -> UniType -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badMatchErr :: UniType -> UniType -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 badSpecialisationErr :: [Char] -> [Char] -> Int -> [Labda UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 badSpecialisationErr :: [Char] -> [Char] -> Int -> [Labda UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 12002222 _N_ _S_ "LLAAL" {_A_ 3 _U_ 122222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 classCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
 classCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1022 _N_ _N_ _N_ _N_ #-}
 confusedNameErr :: [Char] -> Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 confusedNameErr :: [Char] -> Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 dataConArityErr :: Id -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 dataConArityErr :: Id -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 defaultErr :: [Inst] -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
 defaultErr :: [Inst] -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _N_ _N_ _N_ #-}
 derivingEnumErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
 derivingEnumErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 derivingIxErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
 derivingIxErr :: TyCon -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 derivingWhenInstanceExistsErr :: Class -> TyCon -> PprStyle -> Int -> Bool -> PrettyRep
 derivingWhenInstanceExistsErr :: Class -> TyCon -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 dupInstErr :: (Class, (UniType, SrcLoc), (UniType, SrcLoc)) -> PprStyle -> Int -> Bool -> PrettyRep
 dupInstErr :: (Class, (UniType, SrcLoc), (UniType, SrcLoc)) -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1222 _N_ _S_ "U(LU(LL)U(AL))L" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 genCantGenErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
 genCantGenErr :: [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222 _N_ _S_ "S" _N_ _N_ #-}
 instTypeErr :: UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 instTypeErr :: UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
+lurkingRank2Err :: Name -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 methodTypeLacksTyVarErr :: TyVarTemplate -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 methodTypeLacksTyVarErr :: TyVarTemplate -> [Char] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 naughtyCCallContextErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 naughtyCCallContextErr :: Name -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 noInstanceErr :: Inst -> PprStyle -> Int -> Bool -> PrettyRep
 noInstanceErr :: Inst -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 nonBoxedPrimCCallErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 nonBoxedPrimCCallErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 notAsPolyAsSigErr :: UniType -> [TyVar] -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 notAsPolyAsSigErr :: UniType -> [TyVar] -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 0222222 _N_ _S_ "ALLLL" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 preludeInstanceErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 preludeInstanceErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 reduceErr :: [Inst] -> UnifyErrContext -> PprStyle -> Int -> Bool -> PrettyRep
 reduceErr :: [Inst] -> UnifyErrContext -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 sigContextsErr :: [SignatureInfo] -> PprStyle -> Int -> Bool -> PrettyRep
 sigContextsErr :: [SignatureInfo] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 specCtxtGroundnessErr :: UnifyErrContext -> [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
 specCtxtGroundnessErr :: UnifyErrContext -> [Inst] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 11222 _N_ _S_ "SLL" _N_ _N_ #-}
 specDataNoSpecErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 specDataNoSpecErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 specDataUnboxedErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 specDataUnboxedErr :: Name -> [UniType] -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 specGroundnessErr :: UnifyErrContext -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
 specGroundnessErr :: UnifyErrContext -> [UniType] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "SLL" _N_ _N_ #-}
 specInstUnspecInstNotFoundErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 specInstUnspecInstNotFoundErr :: Class -> UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 topLevelUnboxedDeclErr :: Id -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 topLevelUnboxedDeclErr :: Id -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
 tyConArityErr :: Name -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 tyConArityErr :: Name -> Int -> Int -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222222 _N_ _N_ _N_ _N_ #-}
 typeCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
 typeCycleErr :: [[(Int -> Bool -> PrettyRep, SrcLoc)]] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1022 _N_ _N_ _N_ _N_ #-}
+underAppliedTyErr :: UniType -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unifyErr :: UnifyErrInfo -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
 unifyErr :: UnifyErrInfo -> UnifyErrContext -> SrcLoc -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 varyingArgsErr :: Name -> [Match Name (InPat Name)] -> PprStyle -> Int -> Bool -> PrettyRep
 varyingArgsErr :: Name -> [Match Name (InPat Name)] -> PprStyle -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 20222 _N_ _S_ "LAL" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 9d946e7..33296ff 100644 (file)
@@ -27,6 +27,7 @@ module ErrsTc (
        dupInstErr,
        genCantGenErr,
        instTypeErr,
        dupInstErr,
        genCantGenErr,
        instTypeErr,
+       lurkingRank2Err,
        methodTypeLacksTyVarErr,
        naughtyCCallContextErr,
        noInstanceErr,
        methodTypeLacksTyVarErr,
        naughtyCCallContextErr,
        noInstanceErr,
@@ -43,6 +44,7 @@ module ErrsTc (
        topLevelUnboxedDeclErr,
        tyConArityErr,
        typeCycleErr,
        topLevelUnboxedDeclErr,
        tyConArityErr,
        typeCycleErr,
+       underAppliedTyErr,
        unifyErr,
        varyingArgsErr
     ) where
        unifyErr,
        varyingArgsErr
     ) where
@@ -265,6 +267,17 @@ instTypeErr ty locn
     )
 
 ----------------------------------------------------------------
     )
 
 ----------------------------------------------------------------
+lurkingRank2Err :: Name -> UniType -> SrcLoc -> Error
+lurkingRank2Err name ty locn
+  = addErrLoc locn "Illegal use of a non-Hindley-Milner variable" ( \ sty ->
+    ppAboves [
+      ppBesides [ppStr "The variable is `", ppr sty name, ppStr "'."],
+      ppStr "Its type does not have all its for-alls at the top",
+      ppBesides [ppStr "(the type is `", ppr sty ty, ppStr "'),"],
+      ppStr "nor is it a full application of a rank-2-typed variable.",
+      ppStr "(Most common cause: `_runST' or `_build' not applied to an argument.)"])
+
+----------------------------------------------------------------
 {- UNUSED:
 methodInstErr :: (ClassOp, (UniType, SrcLoc), (UniType, SrcLoc)) -> Error
 methodInstErr (class_op, info1, info2) sty
 {- UNUSED:
 methodInstErr :: (ClassOp, (UniType, SrcLoc), (UniType, SrcLoc)) -> Error
 methodInstErr (class_op, info1, info2) sty
@@ -377,6 +390,15 @@ unexpectedPreludeThingErr category thing locn
 ----------------------------------------------------------------
 specGroundnessErr :: UnifyErrContext -> [UniType] -> Error
 
 ----------------------------------------------------------------
 specGroundnessErr :: UnifyErrContext -> [UniType] -> Error
 
+specGroundnessErr (ValSpecSigCtxt name spec_ty locn) arg_tys
+  = addShortErrLocLine locn ( \ sty ->
+    ppHang (
+       ppSep [ppStr "In the SPECIALIZE pragma for `", ppr sty name,
+              ppStr "'... not all type variables were specialised",
+              ppStr "to type variables or ground types (nothing in between, please!):"])
+      4 (ppAboves (map (ppr sty) arg_tys))
+    )
+
 specGroundnessErr (ValSpecSpecIdCtxt name spec_ty spec locn) arg_tys
   = addShortErrLocLine locn ( \ sty ->
     ppHang (
 specGroundnessErr (ValSpecSpecIdCtxt name spec_ty spec locn) arg_tys
   = addShortErrLocLine locn ( \ sty ->
     ppHang (
@@ -496,6 +518,15 @@ arityError kind name n m locn =
                    | True   = ppCat [ppInt n, ppStr "arguments"]
 
 ----------------------------------------------------------------
                    | True   = ppCat [ppInt n, ppStr "arguments"]
 
 ----------------------------------------------------------------
+underAppliedTyErr :: UniType -> SrcLoc -> Error
+underAppliedTyErr ty locn
+  = addErrLoc locn "A for-all type has been applied to too few arguments" ( \ sty ->
+    ppAboves [
+      ppBesides [ppStr "The type is `", ppr sty ty, ppStr "';"],
+      ppStr "This might be because of a GHC bug; feel free to report",
+      ppStr "it to glasgow-haskell-bugs@dcs.glasgow.ac.uk."])
+
+----------------------------------------------------------------
 unifyErr :: UnifyErrInfo -> UnifyErrContext -> SrcLoc -> Error
 
 unifyErr unify_err_info unify_err_context locn
 unifyErr :: UnifyErrInfo -> UnifyErrContext -> SrcLoc -> Error
 
 unifyErr unify_err_info unify_err_context locn
@@ -930,6 +961,12 @@ speakNth 3 = ppStr "third"
 speakNth 4 = ppStr "fourth"
 speakNth 5 = ppStr "fifth"
 speakNth 6 = ppStr "sixth"
 speakNth 4 = ppStr "fourth"
 speakNth 5 = ppStr "fifth"
 speakNth 6 = ppStr "sixth"
-speakNth n = ppBesides [ ppInt n, ppStr "th" ]         -- Wrong for eg "31th"
-                                                       -- but who cares?
+speakNth n = ppBesides [ ppInt n, ppStr st_nd_rd_th ]
+  where
+    st_nd_rd_th | n_rem_10 == 1 = "st"
+               | n_rem_10 == 2 = "nd"
+               | n_rem_10 == 3 = "rd"
+               | otherwise     = "th"
+
+    n_rem_10 = n `rem` 10
 \end{code}
 \end{code}
index 612391d..1b8b0a4 100644 (file)
@@ -1,5 +1,4 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Main where
 mainPrimIO :: _State _RealWorld -> ((), _State _RealWorld)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Main where
 mainPrimIO :: _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index e1af1c6..705b54d 100644 (file)
@@ -183,9 +183,9 @@ doIt (switch_lookup_fn, core_cmds, podize_cmds, pcore_cmds, stg_cmds) input_pgm
     -- of the Glorious Glasgow Haskell compiler!
     -- **********************************************
 #ifndef DPH
     -- of the Glorious Glasgow Haskell compiler!
     -- **********************************************
 #ifndef DPH
-    doDump Verbose "Glasgow Haskell Compiler, version 0.26" "" `thenMn_`
+    doDump Verbose "Glasgow Haskell Compiler, version 0.27" "" `thenMn_`
 #else
 #else
-    doDump Verbose "Data Parallel Haskell Compiler, version 0.06 (Glasgow 0.26)" ""
+    doDump Verbose "Data Parallel Haskell Compiler, version 0.06 (Glasgow 0.27)" ""
        `thenMn_`
 #endif {- Data Parallel Haskell -}
 
        `thenMn_`
 #endif {- Data Parallel Haskell -}
 
index aeae1fa..230a6e1 100644 (file)
@@ -1,52 +1,25 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface MainMonad where
 import PreludeArray(_ByteArray)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface MainMonad where
 import PreludeArray(_ByteArray)
-import PreludePrimIO(appendChanPrimIO, appendFilePrimIO, getArgsPrimIO, readChanPrimIO)
-import SplitUniq(SplitUniqSupply, mkSplitUniqSupply)
+import SplitUniq(SplitUniqSupply)
 import Stdio(_FILE(..), fclose, fopen, fwrite)
 infixr 9 `thenMn`
 infixr 9 `thenMn_`
 type MainIO a = _State _RealWorld -> (a, _State _RealWorld)
 import Stdio(_FILE(..), fclose, fopen, fwrite)
 infixr 9 `thenMn`
 infixr 9 `thenMn_`
 type MainIO a = _State _RealWorld -> (a, _State _RealWorld)
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data SplitUniqSupply 
 data _FILE   = _FILE Addr#
 data _FILE   = _FILE Addr#
-appendChanPrimIO :: [Char] -> [Char] -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
-appendFilePrimIO :: [Char] -> [Char] -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 exitMn :: Int -> _State _RealWorld -> ((), _State _RealWorld)
 exitMn :: Int -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fclose :: _FILE -> _State _RealWorld -> (Int, _State _RealWorld)
 fclose :: _FILE -> _State _RealWorld -> (Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fopen :: [Char] -> [Char] -> _State _RealWorld -> (_FILE, _State _RealWorld)
 fopen :: [Char] -> [Char] -> _State _RealWorld -> (_FILE, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fwrite :: _ByteArray Int -> Int -> Int -> _FILE -> _State _RealWorld -> (Int, _State _RealWorld)
 fwrite :: _ByteArray Int -> Int -> Int -> _FILE -> _State _RealWorld -> (Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 5 _U_ 11111 _N_ _S_ "U(AP)U(P)U(P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getArgsMn :: _State _RealWorld -> ([[Char]], _State _RealWorld)
 getArgsMn :: _State _RealWorld -> ([[Char]], _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePrimIO getArgsPrimIO _N_ #-}
-getArgsPrimIO :: _State _RealWorld -> ([[Char]], _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 getSplitUniqSupplyMn :: Char -> _State _RealWorld -> (SplitUniqSupply, _State _RealWorld)
 getSplitUniqSupplyMn :: Char -> _State _RealWorld -> (SplitUniqSupply, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-readChanPrimIO :: [Char] -> _State _RealWorld -> ([Char], _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
-mkSplitUniqSupply :: Char -> _State _RealWorld -> (SplitUniqSupply, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 readMn :: [Char] -> _State _RealWorld -> ([Char], _State _RealWorld)
 readMn :: [Char] -> _State _RealWorld -> ([Char], _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: [Char]) (u1 :: _State _RealWorld) -> _APP_  _ORIG_ PreludePrimIO readChanPrimIO [ u0, u1 ] _N_ #-}
 returnMn :: a -> _State _RealWorld -> (a, _State _RealWorld)
 returnMn :: a -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 thenMn :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
 thenMn :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: u0 -> _State _RealWorld -> (u1, _State _RealWorld)) (u4 :: _State _RealWorld) -> case _APP_  u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: u0) (u6 :: _State _RealWorld) -> _APP_  u3 [ u5, u6 ]; _NO_DEFLT_ } _N_ #-}
 thenMn_ :: (_State _RealWorld -> (a, _State _RealWorld)) -> (_State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
 thenMn_ :: (_State _RealWorld -> (a, _State _RealWorld)) -> (_State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld -> (u1, _State _RealWorld)) (u4 :: _State _RealWorld) -> case _APP_  u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: u0) (u6 :: _State _RealWorld) -> _APP_  u3 [ u6 ]; _NO_DEFLT_ } _N_ #-}
 writeMn :: [Char] -> [Char] -> _State _RealWorld -> ((), _State _RealWorld)
 writeMn :: [Char] -> [Char] -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: [Char]) (u1 :: [Char]) (u2 :: _State _RealWorld) -> _APP_  _ORIG_ PreludePrimIO appendChanPrimIO [ u0, u1, u2 ] _N_ #-}
 instance Eq _FILE
 instance Eq _FILE
-       {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Addr#) (u1 :: Addr#) -> case _#_ eqAddr# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> case _#_ eqAddr# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance _CCallable _FILE
 instance _CCallable _FILE
-       {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _TUP_0 [] [] _N_ #-}
 instance _CReturnable _FILE
 instance _CReturnable _FILE
-       {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _TUP_0 [] [] _N_ #-}
 
 
index df08cd6..411c838 100644 (file)
@@ -9,8 +9,7 @@ import FiniteMap(FiniteMap)
 import HsBinds(MonoBinds, Sig)
 import HsDecls(FixityDecl)
 import HsPat(InPat)
 import HsBinds(MonoBinds, Sig)
 import HsDecls(FixityDecl)
 import HsPat(InPat)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
@@ -26,18 +25,16 @@ import TyVar(TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Bag a 
 type CE = UniqFM Class
 type CE = UniqFM Class
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data FixityDecl a      {-# GHC_PRAGMA InfixL a Int | InfixR a Int | InfixN a Int #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data StgBinding a b    {-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
+data GlobalSwitch 
+data FixityDecl a 
+data Id 
+data Name 
+data PrettyRep 
+data StgBinding a b 
 type TCE = UniqFM TyCon
 type TCE = UniqFM TyCon
-data InstInfo  {-# GHC_PRAGMA InstInfo Class [TyVarTemplate] UniType [(Class, UniType)] [(Class, UniType)] Id [Id] (MonoBinds Name (InPat Name)) Bool _PackedString SrcLoc [Sig Name] #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data InstInfo 
+data UniqFM a 
 mkInterface :: (GlobalSwitch -> Bool) -> _PackedString -> (_PackedString -> Bool, _PackedString -> Bool) -> UniqFM UnfoldingDetails -> FiniteMap TyCon [[Labda UniType]] -> ([FixityDecl Name], [Id], UniqFM Class, UniqFM TyCon, Bag InstInfo) -> [StgBinding Id Id] -> Int -> Bool -> PrettyRep
 mkInterface :: (GlobalSwitch -> Bool) -> _PackedString -> (_PackedString -> Bool, _PackedString -> Bool) -> UniqFM UnfoldingDetails -> FiniteMap TyCon [[Labda UniType]] -> ([FixityDecl Name], [Id], UniqFM Class, UniqFM TyCon, Bag InstInfo) -> [StgBinding Id Id] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 7 _U_ 222221122 _N_ _S_ "LLLLLU(LSSSL)L" _N_ _N_ #-}
 
 
index 96ac402..867abb4 100644 (file)
@@ -5,24 +5,21 @@ import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
 import ClosureInfo(ClosureInfo)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
 import ClosureInfo(ClosureInfo)
-import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import MachDesc(RegLoc, Target)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import MachDesc(RegLoc, Target)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
-import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data Target    {-# GHC_PRAGMA Target (GlobalSwitch -> SwitchResult) Int (SMRep -> Int) (MagicId -> RegLoc) (StixTree -> StixTree) (PrimKind -> Int) ([MagicId] -> [StixTree]) ([MagicId] -> [StixTree]) (HeapOffset -> Int) (CAddrMode -> StixTree) (CAddrMode -> StixTree) Int Int StixTree StixTree ([CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) Bool ([Char] -> [Char]) #-}
+data AbstractC 
+data Target 
 type SUniqSM a = SplitUniqSupply -> a
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+data SplitUniqSupply 
+data StixTree 
 genCodeAbstractC :: Target -> AbstractC -> SplitUniqSupply -> [[StixTree]]
 genCodeAbstractC :: Target -> AbstractC -> SplitUniqSupply -> [[StixTree]]
-       {-# GHC_PRAGMA _A_ 2 _U_ 221 _N_ _N_ _N_ _N_ #-}
 
 
index 67d4e15..718775a 100644 (file)
@@ -38,62 +38,74 @@ where each tree corresponds to a single Stix instruction.  We leave the chunks
 separated so that register allocation can be performed locally within the chunk.
 
 \begin{code}
 separated so that register allocation can be performed locally within the chunk.
 
 \begin{code}
+-- hacking with Uncle Will:
+#define target_STRICT target@(Target _ _ _ _ _ _ _ _)
 
 genCodeAbstractC 
     :: Target 
     -> AbstractC
     -> SUniqSM [[StixTree]]
 
 
 genCodeAbstractC 
     :: Target 
     -> AbstractC
     -> SUniqSM [[StixTree]]
 
-genCodeAbstractC target absC = 
-    mapSUs (genCodeTopAbsC target) (mkAbsCStmtList absC)       `thenSUs` \ trees ->
+genCodeAbstractC target_STRICT absC = 
+    mapSUs gentopcode (mkAbsCStmtList absC) `thenSUs` \ trees ->
     returnSUs ([StComment SLIT("Native Code")] : trees)
     returnSUs ([StComment SLIT("Native Code")] : trees)
-
+ where
+ -- "target" munging things... ---
+ a2stix  = amodeToStix  target
+ a2stix' = amodeToStix' target
+ volsaves    = volatileSaves target
+ volrestores = volatileRestores target
+ p2stix      = primToStix target
+ macro_code  = macroCode target
+ hp_rel             = hpRel target
+ -- real code follows... ---------
 \end{code}
 
 Here we handle top-level things, like @CCodeBlock@s and
 @CClosureInfoTable@s.
 
 \begin{code}
 \end{code}
 
 Here we handle top-level things, like @CCodeBlock@s and
 @CClosureInfoTable@s.
 
 \begin{code}
-
-genCodeTopAbsC 
+ {-
+ genCodeTopAbsC 
     :: Target 
     -> AbstractC
     -> SUniqSM [StixTree]
     :: Target 
     -> AbstractC
     -> SUniqSM [StixTree]
+ -}
 
 
-genCodeTopAbsC target (CCodeBlock label absC) =
-    genCodeAbsC target absC                            `thenSUs` \ code ->
+ gentopcode (CCodeBlock label absC) =
+    gencode absC                               `thenSUs` \ code ->
     returnSUs (StSegment TextSegment : StFunBegin label : code [StFunEnd label])
 
     returnSUs (StSegment TextSegment : StFunBegin label : code [StFunEnd label])
 
-genCodeTopAbsC target stmt@(CStaticClosure label _ _ _) = 
-    genCodeStaticClosure target stmt                   `thenSUs` \ code ->
+ gentopcode stmt@(CStaticClosure label _ _ _) = 
+    genCodeStaticClosure stmt                  `thenSUs` \ code ->
     returnSUs (StSegment DataSegment : StLabel label : code [])
 
     returnSUs (StSegment DataSegment : StLabel label : code [])
 
-genCodeTopAbsC target stmt@(CRetUnVector _ _) = returnSUs []
+ gentopcode stmt@(CRetUnVector _ _) = returnSUs []
 
 
-genCodeTopAbsC target stmt@(CFlatRetVector label _) =
-    genCodeVecTbl target stmt                          `thenSUs` \ code ->
+ gentopcode stmt@(CFlatRetVector label _) =
+    genCodeVecTbl stmt                         `thenSUs` \ code ->
     returnSUs (StSegment TextSegment : code [StLabel label])
 
     returnSUs (StSegment TextSegment : code [StLabel label])
 
-genCodeTopAbsC target stmt@(CClosureInfoAndCode cl_info slow Nothing _ _)
+ gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _ _ _)
 
   | slow_is_empty
 
   | slow_is_empty
-  = genCodeInfoTable target stmt                       `thenSUs` \ itbl ->
+  = genCodeInfoTable hp_rel a2stix stmt                `thenSUs` \ itbl ->
     returnSUs (StSegment TextSegment : itbl [])
 
   | otherwise
     returnSUs (StSegment TextSegment : itbl [])
 
   | otherwise
-  = genCodeInfoTable target stmt                       `thenSUs` \ itbl ->
-    genCodeAbsC target slow                            `thenSUs` \ slow_code ->
+  = genCodeInfoTable hp_rel a2stix stmt                `thenSUs` \ itbl ->
+    gencode slow                               `thenSUs` \ slow_code ->
     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl : 
               slow_code [StFunEnd slow_lbl]))
   where
     slow_is_empty = not (maybeToBool (nonemptyAbsC slow))
     slow_lbl = entryLabelFromCI cl_info
 
     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl : 
               slow_code [StFunEnd slow_lbl]))
   where
     slow_is_empty = not (maybeToBool (nonemptyAbsC slow))
     slow_lbl = entryLabelFromCI cl_info
 
-genCodeTopAbsC target stmt@(CClosureInfoAndCode cl_info slow (Just fast) _ _) =
--- ToDo: what if this is empty? ------------------------^^^^
-    genCodeInfoTable target stmt                       `thenSUs` \ itbl ->
-    genCodeAbsC target slow                            `thenSUs` \ slow_code ->
-    genCodeAbsC target fast                            `thenSUs` \ fast_code ->
+ gentopcode stmt@(CClosureInfoAndCode cl_info slow (Just fast) _ _ _) =
+ -- ToDo: what if this is empty? ------------------------^^^^
+    genCodeInfoTable hp_rel a2stix stmt                `thenSUs` \ itbl ->
+    gencode slow                               `thenSUs` \ slow_code ->
+    gencode fast                               `thenSUs` \ fast_code ->
     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl : 
               slow_code (StFunEnd slow_lbl : StFunBegin fast_lbl :
               fast_code [StFunEnd fast_lbl])))
     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl : 
               slow_code (StFunEnd slow_lbl : StFunBegin fast_lbl :
               fast_code [StFunEnd fast_lbl])))
@@ -101,28 +113,75 @@ genCodeTopAbsC target stmt@(CClosureInfoAndCode cl_info slow (Just fast) _ _) =
     slow_lbl = entryLabelFromCI cl_info
     fast_lbl = fastLabelFromCI cl_info
 
     slow_lbl = entryLabelFromCI cl_info
     fast_lbl = fastLabelFromCI cl_info
 
-genCodeTopAbsC target absC =
-    genCodeAbsC target absC                            `thenSUs` \ code ->
+ gentopcode absC =
+    gencode absC                               `thenSUs` \ code ->
     returnSUs (StSegment TextSegment : code [])
 
 \end{code}
 
     returnSUs (StSegment TextSegment : code [])
 
 \end{code}
 
-Now the individual AbstractC statements.
+Vector tables are trivial!
 
 \begin{code}
 
 \begin{code}
+ {-
+ genCodeVecTbl 
+    :: Target 
+    -> AbstractC
+    -> SUniqSM StixTreeList
+ -}
+ genCodeVecTbl (CFlatRetVector label amodes) =
+    returnSUs (\xs -> vectbl : xs)
+  where
+    vectbl = StData PtrKind (reverse (map a2stix amodes))
+
+\end{code}
+
+Static closures are not so hard either.
 
 
-genCodeAbsC 
+\begin{code}
+ {-
+ genCodeStaticClosure 
     :: Target 
     -> AbstractC
     -> SUniqSM StixTreeList
     :: Target 
     -> AbstractC
     -> SUniqSM StixTreeList
+ -}
+ genCodeStaticClosure (CStaticClosure _ cl_info cost_centre amodes) =
+    returnSUs (\xs -> table : xs)
+  where
+    table = StData PtrKind (StCLbl info_lbl : body)
+    info_lbl = infoTableLabelFromCI cl_info
+
+    body = if closureUpdReqd cl_info then 
+               take (max mIN_UPD_SIZE (length amodes')) (amodes' ++ zeros)
+          else
+               amodes'
+
+    zeros = StInt 0 : zeros
+
+    amodes' = map amodeZeroVoid amodes
+
+       -- Watch out for VoidKinds...cf. PprAbsC
+    amodeZeroVoid item 
+      | getAmodeKind item == VoidKind = StInt 0
+      | otherwise = a2stix item
+
+\end{code}
+
+Now the individual AbstractC statements.
 
 
+\begin{code}
+ {-
+ gencode
+    :: Target 
+    -> AbstractC
+    -> SUniqSM StixTreeList
+ -}
 \end{code}
 
 @AbsCNop@s just disappear.
 
 \begin{code}
 
 \end{code}
 
 @AbsCNop@s just disappear.
 
 \begin{code}
 
-genCodeAbsC target AbsCNop = returnSUs id
+ gencode AbsCNop = returnSUs id
 
 \end{code}
 
 
 \end{code}
 
@@ -130,7 +189,7 @@ OLD:@CComment@s are passed through as the corresponding @StComment@s.
 
 \begin{code}
 
 
 \begin{code}
 
---UNUSED:genCodeAbsC target (CComment s) = returnSUs (\xs -> StComment s : xs)
+ --UNUSED:gencode (CComment s) = returnSUs (\xs -> StComment s : xs)
 
 \end{code}
 
 
 \end{code}
 
@@ -138,7 +197,7 @@ Split markers are a NOP in this land.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target CSplitMarker = returnSUs id
+ gencode CSplitMarker = returnSUs id
 
 \end{code}
 
 
 \end{code}
 
@@ -147,9 +206,9 @@ resulting StixTreeLists are joined together.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (AbsCStmts c1 c2) =
-    genCodeAbsC target c1                              `thenSUs` \ b1 ->
-    genCodeAbsC target c2                              `thenSUs` \ b2 ->
+ gencode (AbsCStmts c1 c2) =
+    gencode c1                         `thenSUs` \ b1 ->
+    gencode c2                         `thenSUs` \ b2 ->
     returnSUs (b1 . b2)
 
 \end{code}
     returnSUs (b1 . b2)
 
 \end{code}
@@ -162,9 +221,9 @@ addresses, etc.)
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (CInitHdr cl_info reg_rel _ _) =
+ gencode (CInitHdr cl_info reg_rel _ _) =
     let
     let
-       lhs = amodeToStix target (CVal reg_rel PtrKind)
+       lhs = a2stix (CVal reg_rel PtrKind)
        lbl = infoTableLabelFromCI cl_info
     in
        returnSUs (\xs -> StAssign PtrKind lhs (StCLbl lbl) : xs)
        lbl = infoTableLabelFromCI cl_info
     in
        returnSUs (\xs -> StAssign PtrKind lhs (StCLbl lbl) : xs)
@@ -180,13 +239,13 @@ of the source?  Be careful about floats/doubles.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (CAssign lhs rhs)
+ gencode (CAssign lhs rhs)
   | getAmodeKind lhs == VoidKind = returnSUs id
   | otherwise =
     let pk = getAmodeKind lhs
        pk' = if mixedTypeLocn lhs && not (isFloatingKind pk) then IntKind else pk
   | getAmodeKind lhs == VoidKind = returnSUs id
   | otherwise =
     let pk = getAmodeKind lhs
        pk' = if mixedTypeLocn lhs && not (isFloatingKind pk) then IntKind else pk
-       lhs' = amodeToStix target lhs
-       rhs' = amodeToStix' target rhs
+       lhs' = a2stix lhs
+       rhs' = a2stix' rhs
     in
         returnSUs (\xs -> StAssign pk' lhs' rhs' : xs)
 
     in
         returnSUs (\xs -> StAssign pk' lhs' rhs' : xs)
 
@@ -198,26 +257,26 @@ with the address of the info table before jumping to the entry code for Node.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (CJump dest) =
-    returnSUs (\xs -> StJump (amodeToStix target dest) : xs)
+ gencode (CJump dest) =
+    returnSUs (\xs -> StJump (a2stix dest) : xs)
 
 
-genCodeAbsC target (CFallThrough (CLbl lbl _)) =
+ gencode (CFallThrough (CLbl lbl _)) =
     returnSUs (\xs -> StFallThrough lbl : xs)
 
     returnSUs (\xs -> StFallThrough lbl : xs)
 
-genCodeAbsC target (CReturn dest DirectReturn) =
-    returnSUs (\xs -> StJump (amodeToStix target dest) : xs)
+ gencode (CReturn dest DirectReturn) =
+    returnSUs (\xs -> StJump (a2stix dest) : xs)
 
 
-genCodeAbsC target (CReturn table (StaticVectoredReturn n)) =
+ gencode (CReturn table (StaticVectoredReturn n)) =
     returnSUs (\xs -> StJump dest : xs)
   where 
     returnSUs (\xs -> StJump dest : xs)
   where 
-    dest = StInd PtrKind (StIndex PtrKind (amodeToStix target table)
+    dest = StInd PtrKind (StIndex PtrKind (a2stix table)
                                          (StInt (toInteger (-n-1))))
 
                                          (StInt (toInteger (-n-1))))
 
-genCodeAbsC target (CReturn table (DynamicVectoredReturn am)) =
+ gencode (CReturn table (DynamicVectoredReturn am)) =
     returnSUs (\xs -> StJump dest : xs)
   where 
     returnSUs (\xs -> StJump dest : xs)
   where 
-    dest = StInd PtrKind (StIndex PtrKind (amodeToStix target table) dyn_off)
-    dyn_off = StPrim IntSubOp [StPrim IntNegOp [amodeToStix target am], StInt 1]
+    dest = StInd PtrKind (StIndex PtrKind (a2stix table) dyn_off)
+    dyn_off = StPrim IntSubOp [StPrim IntNegOp [a2stix am], StInt 1]
 
 \end{code}
 
 
 \end{code}
 
@@ -225,18 +284,18 @@ Now the PrimOps, some of which may need caller-saves register wrappers.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (COpStmt results op args liveness_mask vols)
+ gencode (COpStmt results op args liveness_mask vols)
   -- ToDo (ADR?): use that liveness mask
   | primOpNeedsWrapper op =
     let
   -- ToDo (ADR?): use that liveness mask
   | primOpNeedsWrapper op =
     let
-        saves = volatileSaves target vols
-       restores = volatileRestores target vols
+        saves = volsaves vols
+       restores = volrestores vols
     in
     in
-       primToStix target (nonVoid results) op (nonVoid args)
+       p2stix (nonVoid results) op (nonVoid args)
                                                        `thenSUs` \ code ->
        returnSUs (\xs -> saves ++ code (restores ++ xs))
 
                                                        `thenSUs` \ code ->
        returnSUs (\xs -> saves ++ code (restores ++ xs))
 
-  | otherwise = primToStix target (nonVoid results) op (nonVoid args)
+  | otherwise = p2stix (nonVoid results) op (nonVoid args)
     where
         nonVoid = filter ((/= VoidKind) . getAmodeKind)
 
     where
         nonVoid = filter ((/= VoidKind) . getAmodeKind)
 
@@ -260,27 +319,27 @@ Now the if statement.  Almost *all* flow of control are of this form.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (CSwitch discrim alts deflt) 
+ gencode (CSwitch discrim alts deflt) 
   = case alts of
   = case alts of
-      [] -> genCodeAbsC target deflt
+      [] -> gencode deflt
 
       [(tag,alt_code)] -> case maybe_empty_deflt of
 
       [(tag,alt_code)] -> case maybe_empty_deflt of
-                               Nothing -> genCodeAbsC target alt_code
-                               Just dc -> mkIfThenElse target discrim tag alt_code dc
+                               Nothing -> gencode alt_code
+                               Just dc -> mkIfThenElse discrim tag alt_code dc
 
       [(tag1@(MachInt i1 _), alt_code1),
        (tag2@(MachInt i2 _), alt_code2)] 
        | deflt_is_empty && i1 == 0 && i2 == 1
 
       [(tag1@(MachInt i1 _), alt_code1),
        (tag2@(MachInt i2 _), alt_code2)] 
        | deflt_is_empty && i1 == 0 && i2 == 1
-       -> mkIfThenElse target discrim tag1 alt_code1 alt_code2
+       -> mkIfThenElse discrim tag1 alt_code1 alt_code2
        | deflt_is_empty && i1 == 1 && i2 == 0
        | deflt_is_empty && i1 == 1 && i2 == 0
-       -> mkIfThenElse target discrim tag2 alt_code2 alt_code1
+       -> mkIfThenElse discrim tag2 alt_code2 alt_code1
  
        -- If the @discrim@ is simple, then this unfolding is safe.
  
        -- If the @discrim@ is simple, then this unfolding is safe.
-      other | simple_discrim -> mkSimpleSwitches target discrim alts deflt
+      other | simple_discrim -> mkSimpleSwitches discrim alts deflt
 
        -- Otherwise, we need to do a bit of work.
       other ->  getSUnique                       `thenSUs` \ u ->
 
        -- Otherwise, we need to do a bit of work.
       other ->  getSUnique                       `thenSUs` \ u ->
-               genCodeAbsC target (AbsCStmts
+               gencode (AbsCStmts
                (CAssign (CTemp u pk) discrim)
                (CSwitch (CTemp u pk) alts deflt))
 
                (CAssign (CTemp u pk) discrim)
                (CSwitch (CTemp u pk) alts deflt))
 
@@ -304,12 +363,12 @@ Finally, all of the disgusting AbstractC macros.
 
 \begin{code}
 
 
 \begin{code}
 
-genCodeAbsC target (CMacroStmt macro args) = macroCode target macro args
+ gencode (CMacroStmt macro args) = macro_code macro args
 
 
-genCodeAbsC target (CCallProfCtrMacro macro _) =
+ gencode (CCallProfCtrMacro macro _) =
     returnSUs (\xs -> StComment macro : xs)
 
     returnSUs (\xs -> StComment macro : xs)
 
-genCodeAbsC target (CCallProfCCMacro macro _) =
+ gencode (CCallProfCCMacro macro _) =
     returnSUs (\xs -> StComment macro : xs)
 
 \end{code}
     returnSUs (\xs -> StComment macro : xs)
 
 \end{code}
@@ -320,26 +379,27 @@ comparison tree.  (Perhaps this could be tuned.)
 
 \begin{code}
 
 
 \begin{code}
 
-intTag :: BasicLit -> Integer
-intTag (MachChar c) = toInteger (ord c)
-intTag (MachInt i _) = i
-intTag _ = panic "intTag"
+ intTag :: BasicLit -> Integer
+ intTag (MachChar c) = toInteger (ord c)
+ intTag (MachInt i _) = i
+ intTag _ = panic "intTag"
 
 
-fltTag :: BasicLit -> Rational
+ fltTag :: BasicLit -> Rational
 
 
-fltTag (MachFloat f) = f
-fltTag (MachDouble d) = d
-fltTag _ = panic "fltTag"
+ fltTag (MachFloat f) = f
+ fltTag (MachDouble d) = d
+ fltTag _ = panic "fltTag"
 
 
-mkSimpleSwitches 
+ {-
+ mkSimpleSwitches 
     :: Target 
     -> CAddrMode -> [(BasicLit,AbstractC)] -> AbstractC
     -> SUniqSM StixTreeList
     :: Target 
     -> CAddrMode -> [(BasicLit,AbstractC)] -> AbstractC
     -> SUniqSM StixTreeList
-
-mkSimpleSwitches target am alts absC =
+ -}
+ mkSimpleSwitches am alts absC =
     getUniqLabelNCG                                    `thenSUs` \ udlbl ->
     getUniqLabelNCG                                    `thenSUs` \ ujlbl ->
     getUniqLabelNCG                                    `thenSUs` \ udlbl ->
     getUniqLabelNCG                                    `thenSUs` \ ujlbl ->
-    let am' = amodeToStix target am
+    let am' = a2stix am
        joinedAlts = map (\ (tag,code) -> (tag, mkJoin code ujlbl)) alts
        sortedAlts = naturalMergeSortLe leAlt joinedAlts
                     -- naturalMergeSortLe, because we often get sorted alts to begin with
        joinedAlts = map (\ (tag,code) -> (tag, mkJoin code ujlbl)) alts
        sortedAlts = naturalMergeSortLe leAlt joinedAlts
                     -- naturalMergeSortLe, because we often get sorted alts to begin with
@@ -361,12 +421,12 @@ mkSimpleSwitches target am alts absC =
     in
        (
        if not floating && choices > 4 && highTag - lowTag < toInteger (2 * choices) then
     in
        (
        if not floating && choices > 4 && highTag - lowTag < toInteger (2 * choices) then
-           mkJumpTable target am' sortedAlts lowTag highTag udlbl
+           mkJumpTable am' sortedAlts lowTag highTag udlbl
        else
        else
-           mkBinaryTree target am' floating sortedAlts choices lowest highest udlbl
+           mkBinaryTree am' floating sortedAlts choices lowest highest udlbl
        )
                                                        `thenSUs` \ alt_code ->
        )
                                                        `thenSUs` \ alt_code ->
-        genCodeAbsC target absC                                `thenSUs` \ dflt_code ->
+        gencode absC                           `thenSUs` \ dflt_code ->
 
        returnSUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs)))
 
 
        returnSUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs)))
 
@@ -390,8 +450,8 @@ If a join is necessary after the switch, the alternatives should already finish
 with a jump to the join point.
 
 \begin{code}
 with a jump to the join point.
 
 \begin{code}
-
-mkJumpTable
+ {-
+ mkJumpTable
     :: Target 
     -> StixTree                -- discriminant
     -> [(BasicLit, AbstractC)]         -- alternatives
     :: Target 
     -> StixTree                -- discriminant
     -> [(BasicLit, AbstractC)]         -- alternatives
@@ -399,8 +459,9 @@ mkJumpTable
     -> Integer                         -- high tag
     -> CLabel                  -- default label
     -> SUniqSM StixTreeList
     -> Integer                         -- high tag
     -> CLabel                  -- default label
     -> SUniqSM StixTreeList
+ -}
 
 
-mkJumpTable target am alts lowTag highTag dflt =
+ mkJumpTable am alts lowTag highTag dflt =
     getUniqLabelNCG                                    `thenSUs` \ utlbl ->
     mapSUs genLabel alts                               `thenSUs` \ branches ->
     let        cjmpLo = StCondJump dflt (StPrim IntLtOp [am, StInt lowTag])
     getUniqLabelNCG                                    `thenSUs` \ utlbl ->
     mapSUs genLabel alts                               `thenSUs` \ branches ->
     let        cjmpLo = StCondJump dflt (StPrim IntLtOp [am, StInt lowTag])
@@ -422,7 +483,7 @@ mkJumpTable target am alts lowTag highTag dflt =
        genLabel x = getUniqLabelNCG `thenSUs` \ lbl -> returnSUs (lbl, x)
 
        mkBranch (lbl,(_,alt)) =
        genLabel x = getUniqLabelNCG `thenSUs` \ lbl -> returnSUs (lbl, x)
 
        mkBranch (lbl,(_,alt)) =
-            genCodeAbsC target alt                     `thenSUs` \ alt_code ->
+            gencode alt                        `thenSUs` \ alt_code ->
            returnSUs (\xs -> StLabel lbl : alt_code xs)
 
        mkTable _  []     tbl = reverse tbl
            returnSUs (\xs -> StLabel lbl : alt_code xs)
 
        mkTable _  []     tbl = reverse tbl
@@ -446,8 +507,8 @@ As with the jump table approach, if a join is necessary after the switch, the
 alternatives should already finish with a jump to the join point.
 
 \begin{code}
 alternatives should already finish with a jump to the join point.
 
 \begin{code}
-
-mkBinaryTree 
+ {-
+ mkBinaryTree 
     :: Target 
     -> StixTree                -- discriminant
     -> Bool                    -- floating point?
     :: Target 
     -> StixTree                -- discriminant
     -> Bool                    -- floating point?
@@ -457,32 +518,33 @@ mkBinaryTree
     -> BasicLit                -- high tag
     -> CLabel                  -- default code label
     -> SUniqSM StixTreeList
     -> BasicLit                -- high tag
     -> CLabel                  -- default code label
     -> SUniqSM StixTreeList
+ -}
 
 
-mkBinaryTree target am floating [(tag,alt)] _ lowTag highTag udlbl 
-  | rangeOfOne = genCodeAbsC target alt
+ mkBinaryTree am floating [(tag,alt)] _ lowTag highTag udlbl 
+  | rangeOfOne = gencode alt
   | otherwise = 
   | otherwise = 
-    let        tag' = amodeToStix target (CLit tag)
+    let        tag' = a2stix (CLit tag)
        cmpOp = if floating then DoubleNeOp else IntNeOp
        test = StPrim cmpOp [am, tag']
        cjmp = StCondJump udlbl test
     in
        cmpOp = if floating then DoubleNeOp else IntNeOp
        test = StPrim cmpOp [am, tag']
        cjmp = StCondJump udlbl test
     in
-       genCodeAbsC target alt                          `thenSUs` \ alt_code ->
+       gencode alt                             `thenSUs` \ alt_code ->
         returnSUs (\xs -> cjmp : alt_code xs)
 
     where 
        rangeOfOne = not floating && intTag lowTag + 1 >= intTag highTag
        -- When there is only one possible tag left in range, we skip the comparison
 
         returnSUs (\xs -> cjmp : alt_code xs)
 
     where 
        rangeOfOne = not floating && intTag lowTag + 1 >= intTag highTag
        -- When there is only one possible tag left in range, we skip the comparison
 
-mkBinaryTree target am floating alts choices lowTag highTag udlbl =
+ mkBinaryTree am floating alts choices lowTag highTag udlbl =
     getUniqLabelNCG                                    `thenSUs` \ uhlbl ->
     getUniqLabelNCG                                    `thenSUs` \ uhlbl ->
-    let tag' = amodeToStix target (CLit splitTag)
+    let tag' = a2stix (CLit splitTag)
        cmpOp = if floating then DoubleGeOp else IntGeOp
        test = StPrim cmpOp [am, tag']
        cjmp = StCondJump uhlbl test
     in
        cmpOp = if floating then DoubleGeOp else IntGeOp
        test = StPrim cmpOp [am, tag']
        cjmp = StCondJump uhlbl test
     in
-       mkBinaryTree target am floating alts_lo half lowTag splitTag udlbl
+       mkBinaryTree am floating alts_lo half lowTag splitTag udlbl
                                                        `thenSUs` \ lo_code ->
                                                        `thenSUs` \ lo_code ->
-       mkBinaryTree target am floating alts_hi (choices - half) splitTag highTag udlbl
+       mkBinaryTree am floating alts_hi (choices - half) splitTag highTag udlbl
                                                        `thenSUs` \ hi_code ->
 
         returnSUs (\xs -> cjmp : lo_code (StLabel uhlbl : hi_code xs))
                                                        `thenSUs` \ hi_code ->
 
         returnSUs (\xs -> cjmp : lo_code (StLabel uhlbl : hi_code xs))
@@ -495,28 +557,29 @@ mkBinaryTree target am floating alts choices lowTag highTag udlbl =
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-
-mkIfThenElse 
+ {-
+ mkIfThenElse 
     :: Target 
     -> CAddrMode           -- discriminant
     -> BasicLit            -- tag
     -> AbstractC           -- if-part
     -> AbstractC           -- else-part
     -> SUniqSM StixTreeList
     :: Target 
     -> CAddrMode           -- discriminant
     -> BasicLit            -- tag
     -> AbstractC           -- if-part
     -> AbstractC           -- else-part
     -> SUniqSM StixTreeList
+ -}
 
 
-mkIfThenElse target discrim tag alt deflt =
+ mkIfThenElse discrim tag alt deflt =
     getUniqLabelNCG                                    `thenSUs` \ ujlbl ->
     getUniqLabelNCG                                    `thenSUs` \ utlbl ->
     getUniqLabelNCG                                    `thenSUs` \ ujlbl ->
     getUniqLabelNCG                                    `thenSUs` \ utlbl ->
-    let discrim' = amodeToStix target discrim
-       tag' = amodeToStix target (CLit tag)
+    let discrim' = a2stix discrim
+       tag' = a2stix (CLit tag)
        cmpOp = if (isFloatingKind (getAmodeKind discrim)) then DoubleNeOp else IntNeOp
        test = StPrim cmpOp [discrim', tag']
        cjmp = StCondJump utlbl test
        dest = StLabel utlbl
        join = StLabel ujlbl
     in
        cmpOp = if (isFloatingKind (getAmodeKind discrim)) then DoubleNeOp else IntNeOp
        test = StPrim cmpOp [discrim', tag']
        cjmp = StCondJump utlbl test
        dest = StLabel utlbl
        join = StLabel ujlbl
     in
-        genCodeAbsC target (mkJoin alt ujlbl)          `thenSUs` \ alt_code ->
-        genCodeAbsC target deflt                       `thenSUs` \ dflt_code ->
+        gencode (mkJoin alt ujlbl)             `thenSUs` \ alt_code ->
+        gencode deflt                          `thenSUs` \ dflt_code ->
         returnSUs (\xs -> cjmp : alt_code (dest : dflt_code (join : xs)))
 
 mkJoin :: AbstractC -> CLabel -> AbstractC
         returnSUs (\xs -> cjmp : alt_code (dest : dflt_code (join : xs)))
 
 mkJoin :: AbstractC -> CLabel -> AbstractC
@@ -524,7 +587,6 @@ mkJoin :: AbstractC -> CLabel -> AbstractC
 mkJoin code lbl 
   | mightFallThrough code = mkAbsCStmts code (CJump (CLbl lbl PtrKind))
   | otherwise = code
 mkJoin code lbl 
   | mightFallThrough code = mkAbsCStmts code (CJump (CLbl lbl PtrKind))
   | otherwise = code
-
 \end{code}
 
 %---------------------------------------------------------------------------
 \end{code}
 
 %---------------------------------------------------------------------------
@@ -566,51 +628,3 @@ isEmptyAbsC :: AbstractC -> Bool
 isEmptyAbsC = not . maybeToBool . nonemptyAbsC
 ================= End of old, quadratic, algorithm -}
 \end{code}
 isEmptyAbsC = not . maybeToBool . nonemptyAbsC
 ================= End of old, quadratic, algorithm -}
 \end{code}
-
-Vector tables are trivial!
-
-\begin{code}
-
-genCodeVecTbl 
-    :: Target 
-    -> AbstractC
-    -> SUniqSM StixTreeList
-
-genCodeVecTbl target (CFlatRetVector label amodes) =
-    returnSUs (\xs -> vectbl : xs)
-  where
-    vectbl = StData PtrKind (reverse (map (amodeToStix target) amodes))
-
-\end{code}
-
-Static closures are not so hard either.
-
-\begin{code}
-
-genCodeStaticClosure 
-    :: Target 
-    -> AbstractC
-    -> SUniqSM StixTreeList
-
-genCodeStaticClosure target (CStaticClosure _ cl_info cost_centre amodes) =
-    returnSUs (\xs -> table : xs)
-  where
-    table = StData PtrKind (StCLbl info_lbl : body)
-    info_lbl = infoTableLabelFromCI cl_info
-
-    body = if closureUpdReqd cl_info then 
-               take (max mIN_UPD_SIZE (length amodes')) (amodes' ++ zeros)
-          else
-               amodes'
-
-    zeros = StInt 0 : zeros
-
-    amodes' = map amodeZeroVoid amodes
-
-       -- Watch out for VoidKinds...cf. PprAbsC
-    amodeZeroVoid item 
-      | getAmodeKind item == VoidKind = StInt 0
-      | otherwise = amodeToStix target item
-
-\end{code}
-
index 540276d..1b9966c 100644 (file)
@@ -19,68 +19,39 @@ data Addr   = AddrImm Imm | AddrReg Reg | AddrRegImm Reg Imm
 type AlphaCode = OrdList AlphaInstr
 data AlphaInstr
   = LD Size Reg Addr | LDA Reg Addr | LDAH Reg Addr | LDGP Reg Addr | LDI Size Reg Imm | ST Size Reg Addr | CLR Reg | ABS Size RI Reg | NEG Size Bool RI Reg | ADD Size Bool Reg RI Reg | SADD Size Size Reg RI Reg | SUB Size Bool Reg RI Reg | SSUB Size Size Reg RI Reg | MUL Size Bool Reg RI Reg | DIV Size Bool Reg RI Reg | REM Size Bool Reg RI Reg | NOT RI Reg | AND Reg RI Reg | ANDNOT Reg RI Reg | OR Reg RI Reg | ORNOT Reg RI Reg | XOR Reg RI Reg | XORNOT Reg RI Reg | SLL Reg RI Reg | SRL Reg RI Reg | SRA Reg RI Reg | ZAP Reg RI Reg | ZAPNOT Reg RI Reg | NOP | CMP Cond Reg RI Reg | FCLR Reg | FABS Reg Reg | FNEG Size Reg Reg | FADD Size Reg Reg Reg | FDIV Size Reg Reg Reg | FMUL Size Reg Reg Reg | FSUB Size Reg Reg Reg | CVTxy Size Size Reg Reg | FCMP Size Cond Reg Reg Reg | FMOV Reg Reg | BI Cond Reg Imm | BF Cond Reg Imm | BR Imm | JMP Reg Addr Int | BSR Imm Int | JSR Reg Addr Int | LABEL CLabel | FUNBEGIN CLabel | FUNEND CLabel | COMMENT _PackedString | SEGMENT CodeSegment | ASCII Bool [Char] | DATA Size [Imm]
 type AlphaCode = OrdList AlphaInstr
 data AlphaInstr
   = LD Size Reg Addr | LDA Reg Addr | LDAH Reg Addr | LDGP Reg Addr | LDI Size Reg Imm | ST Size Reg Addr | CLR Reg | ABS Size RI Reg | NEG Size Bool RI Reg | ADD Size Bool Reg RI Reg | SADD Size Size Reg RI Reg | SUB Size Bool Reg RI Reg | SSUB Size Size Reg RI Reg | MUL Size Bool Reg RI Reg | DIV Size Bool Reg RI Reg | REM Size Bool Reg RI Reg | NOT RI Reg | AND Reg RI Reg | ANDNOT Reg RI Reg | OR Reg RI Reg | ORNOT Reg RI Reg | XOR Reg RI Reg | XORNOT Reg RI Reg | SLL Reg RI Reg | SRL Reg RI Reg | SRA Reg RI Reg | ZAP Reg RI Reg | ZAPNOT Reg RI Reg | NOP | CMP Cond Reg RI Reg | FCLR Reg | FABS Reg Reg | FNEG Size Reg Reg | FADD Size Reg Reg Reg | FDIV Size Reg Reg Reg | FMUL Size Reg Reg Reg | FSUB Size Reg Reg Reg | CVTxy Size Size Reg Reg | FCMP Size Cond Reg Reg Reg | FMOV Reg Reg | BI Cond Reg Imm | BF Cond Reg Imm | BR Imm | JMP Reg Addr Int | BSR Imm Int | JSR Reg Addr Int | LABEL CLabel | FUNBEGIN CLabel | FUNEND CLabel | COMMENT _PackedString | SEGMENT CodeSegment | ASCII Bool [Char] | DATA Size [Imm]
-data AlphaRegs         {-# GHC_PRAGMA SRegs BitSet BitSet #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data Reg       {-# GHC_PRAGMA FixedReg Int# | MappedReg Int# | MemoryReg Int PrimKind | UnmappedReg Unique PrimKind #-}
-data BitSet    {-# GHC_PRAGMA MkBS Word# #-}
+data AlphaRegs 
+data MagicId 
+data Reg 
+data BitSet 
 data CLabel 
 data CLabel 
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
+data CSeq 
 data Cond   = EQ | LT | LE | ULT | ULE | NE | GT | GE | ALWAYS | NEVER
 data Cond   = EQ | LT | LE | ULT | ULE | NE | GT | GE | ALWAYS | NEVER
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
+data FiniteMap a b 
 data Imm   = ImmInt Int | ImmInteger Integer | ImmCLbl CLabel | ImmLab CSeq
 data Imm   = ImmInt Int | ImmInteger Integer | ImmCLbl CLabel | ImmLab CSeq
-data OrdList a         {-# GHC_PRAGMA SeqList (OrdList a) (OrdList a) | ParList (OrdList a) (OrdList a) | OrdObj a | NoObj #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data CodeSegment       {-# GHC_PRAGMA DataSegment | TextSegment #-}
+data OrdList a 
+data PrimKind 
+data CodeSegment 
 data RI   = RIReg Reg | RIImm Imm
 data Size   = B | BU | W | WU | L | Q | FF | DF | GF | SF | TF
 data RI   = RIReg Reg | RIImm Imm
 data Size   = B | BU | W | WU | L | Q | FF | DF | GF | SF | TF
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 argRegs :: [(Reg, Reg)]
 argRegs :: [(Reg, Reg)]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 baseRegOffset :: MagicId -> Int
 baseRegOffset :: MagicId -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 callerSaves :: MagicId -> Bool
 callerSaves :: MagicId -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 f0 :: Reg
 f0 :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 freeRegs :: [Reg]
 freeRegs :: [Reg]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gp :: Reg
 gp :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [29#] _N_ #-}
 kindToSize :: PrimKind -> Size
 kindToSize :: PrimKind -> Size
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
 printLabeledCodes :: PprStyle -> [AlphaInstr] -> CSeq
 printLabeledCodes :: PprStyle -> [AlphaInstr] -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 pv :: Reg
 pv :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ra :: Reg
 ra :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [26#] _N_ #-}
 reservedRegs :: [Int]
 reservedRegs :: [Int]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 sp :: Reg
 sp :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [30#] _N_ #-}
 stgRegMap :: MagicId -> Labda Reg
 stgRegMap :: MagicId -> Labda Reg
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 strImmLab :: [Char] -> Imm
 strImmLab :: [Char] -> Imm
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 v0 :: Reg
 v0 :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 zero :: Reg
 zero :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [31#] _N_ #-}
 instance MachineCode AlphaInstr
 instance MachineCode AlphaInstr
-       {-# GHC_PRAGMA _M_ AlphaCode {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 6 _!_ _TUP_5 [(AlphaInstr -> RegUsage), (AlphaInstr -> RegLiveness -> RegLiveness), (AlphaInstr -> (Reg -> Reg) -> AlphaInstr), (Reg -> Reg -> OrdList AlphaInstr), (Reg -> Reg -> OrdList AlphaInstr)] [_CONSTM_ MachineCode regUsage (AlphaInstr), _CONSTM_ MachineCode regLiveness (AlphaInstr), _CONSTM_ MachineCode patchRegs (AlphaInstr), _CONSTM_ MachineCode spillReg (AlphaInstr), _CONSTM_ MachineCode loadReg (AlphaInstr)] _N_
-        regUsage = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        regLiveness = _A_ 2 _U_ 11 _N_ _S_ "SU(LU(LL))" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _N_,
-        patchRegs = _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_,
-        spillReg = _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_,
-        loadReg = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instance MachineRegisters AlphaRegs
 instance MachineRegisters AlphaRegs
-       {-# GHC_PRAGMA _M_ AlphaCode {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 7 _!_ _TUP_6 [([Int] -> AlphaRegs), (PrimKind -> AlphaRegs -> [Int]), (AlphaRegs -> Int# -> AlphaRegs), (AlphaRegs -> [Int] -> AlphaRegs), (AlphaRegs -> Int# -> AlphaRegs), (AlphaRegs -> [Int] -> AlphaRegs)] [_CONSTM_ MachineRegisters mkMRegs (AlphaRegs), _CONSTM_ MachineRegisters possibleMRegs (AlphaRegs), _CONSTM_ MachineRegisters useMReg (AlphaRegs), _CONSTM_ MachineRegisters useMRegs (AlphaRegs), _CONSTM_ MachineRegisters freeMReg (AlphaRegs), _CONSTM_ MachineRegisters freeMRegs (AlphaRegs)] _N_
-        mkMRegs = _A_ 1 _U_ 1 _N_ _N_ _N_ _N_,
-        possibleMRegs = _A_ 2 _U_ 11 _N_ _S_ "EU(LL)" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_,
-        useMReg = _A_ 2 _U_ 12 _N_ _S_ "U(LL)P" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_,
-        useMRegs = _A_ 2 _U_ 11 _N_ _S_ "U(LL)L" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_,
-        freeMReg = _A_ 2 _U_ 12 _N_ _S_ "U(LL)P" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_,
-        freeMRegs = _A_ 2 _U_ 11 _N_ _S_ "U(LL)L" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 91d3aca..5d7f4b2 100644 (file)
@@ -212,7 +212,7 @@ data AlphaInstr =
              | FUNEND CLabel
              | COMMENT FAST_STRING
              | SEGMENT CodeSegment
              | FUNEND CLabel
              | COMMENT FAST_STRING
              | SEGMENT CodeSegment
-             | ASCII Bool String
+             | ASCII Bool String   -- needs backslash conversion?
              | DATA Size [Imm]
 
 type AlphaCode = OrdList AlphaInstr
              | DATA Size [Imm]
 
 type AlphaCode = OrdList AlphaInstr
@@ -1120,7 +1120,7 @@ baseRegOffset SuB              = OFFSET_SuB
 baseRegOffset Hp                    = OFFSET_Hp
 baseRegOffset HpLim                 = OFFSET_HpLim
 baseRegOffset LivenessReg           = OFFSET_Liveness
 baseRegOffset Hp                    = OFFSET_Hp
 baseRegOffset HpLim                 = OFFSET_HpLim
 baseRegOffset LivenessReg           = OFFSET_Liveness
-baseRegOffset ActivityReg           = OFFSET_Activity
+--baseRegOffset ActivityReg         = OFFSET_Activity
 #ifdef DEBUG
 baseRegOffset BaseReg               = panic "baseRegOffset:BaseReg"
 baseRegOffset StdUpdRetVecReg       = panic "baseRegOffset:StgUpdRetVecReg"
 #ifdef DEBUG
 baseRegOffset BaseReg               = panic "baseRegOffset:BaseReg"
 baseRegOffset StdUpdRetVecReg       = panic "baseRegOffset:StgUpdRetVecReg"
@@ -1206,7 +1206,7 @@ callerSaves HpLim         = True
 callerSaves LivenessReg                = True
 #endif
 #ifdef CALLER_SAVES_Activity
 callerSaves LivenessReg                = True
 #endif
 #ifdef CALLER_SAVES_Activity
-callerSaves ActivityReg                = True
+--callerSaves ActivityReg              = True
 #endif
 #ifdef CALLER_SAVES_StdUpdRetVec
 callerSaves StdUpdRetVecReg    = True
 #endif
 #ifdef CALLER_SAVES_StdUpdRetVec
 callerSaves StdUpdRetVecReg    = True
@@ -1293,7 +1293,7 @@ stgRegMap HpLim              = Just (FixedReg ILIT(REG_HpLim))
 stgRegMap LivenessReg     = Just (FixedReg ILIT(REG_Liveness))
 #endif
 #ifdef REG_Activity
 stgRegMap LivenessReg     = Just (FixedReg ILIT(REG_Liveness))
 #endif
 #ifdef REG_Activity
-stgRegMap ActivityReg     = Just (FixedReg ILIT(REG_Activity))
+--stgRegMap ActivityReg           = Just (FixedReg ILIT(REG_Activity))
 #endif
 #ifdef REG_StdUpdRetVec
 stgRegMap StdUpdRetVecReg  = Just (FixedReg ILIT(REG_StdUpdRetVec))
 #endif
 #ifdef REG_StdUpdRetVec
 stgRegMap StdUpdRetVecReg  = Just (FixedReg ILIT(REG_StdUpdRetVec))
@@ -1397,7 +1397,7 @@ freeReg ILIT(REG_HpLim) = _FALSE_
 freeReg ILIT(REG_Liveness) = _FALSE_
 #endif
 #ifdef REG_Activity
 freeReg ILIT(REG_Liveness) = _FALSE_
 #endif
 #ifdef REG_Activity
-freeReg ILIT(REG_Activity) = _FALSE_
+--freeReg ILIT(REG_Activity) = _FALSE_
 #endif
 #ifdef REG_StdUpdRetVec
 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
 #endif
 #ifdef REG_StdUpdRetVec
 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
index 9245388..750e28e 100644 (file)
@@ -11,14 +11,14 @@ import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
+import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import Stix(CodeSegment, StixReg, StixTree)
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
-data RegLoc    {-# GHC_PRAGMA Save StixTree | Always StixTree #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
-mkAlpha :: (GlobalSwitch -> SwitchResult) -> Target
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
+data MagicId 
+data SwitchResult 
+data RegLoc 
+data PprStyle 
+data PrimKind 
+data SMRep 
+data StixTree 
+mkAlpha :: (GlobalSwitch -> SwitchResult) -> (Target, PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq, Bool, [Char] -> [Char])
 
 
index e9ea4d0..2c0eeb5 100644 (file)
@@ -122,7 +122,7 @@ because some are reloaded from constants.
 \begin{code}
 
 vsaves switches vols = 
 \begin{code}
 
 vsaves switches vols = 
-    map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,ActivityReg] ++ vols))
+    map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-}] ++ vols))
     where
         save x = StAssign (kindFromMagicId x) loc reg
                    where reg = StReg (StixMagicId x)
     where
         save x = StAssign (kindFromMagicId x) loc reg
                    where reg = StReg (StixMagicId x)
@@ -132,7 +132,7 @@ vsaves switches vols =
 
 vrests switches vols = 
     map restore ((filter callerSaves) 
 
 vrests switches vols = 
     map restore ((filter callerSaves) 
-       ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,ActivityReg,StkStubReg,StdUpdRetVecReg] ++ vols))
+       ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,{-ActivityReg,-}StkStubReg,StdUpdRetVecReg] ++ vols))
     where
         restore x = StAssign (kindFromMagicId x) reg loc
                    where reg = StReg (StixMagicId x)
     where
         restore x = StAssign (kindFromMagicId x) reg loc
                    where reg = StReg (StixMagicId x)
@@ -172,10 +172,15 @@ Setting up a alpha target.
 
 \begin{code}
 
 
 \begin{code}
 
-mkAlpha :: (GlobalSwitch -> SwitchResult) -> Target
+mkAlpha :: (GlobalSwitch -> SwitchResult)
+       -> (Target,
+           (PprStyle -> [[StixTree]] -> SUniqSM Unpretty), -- codeGen
+           Bool,                                           -- underscore
+           (String -> String))                             -- fmtAsmLbl
 
 mkAlpha switches = 
 
 mkAlpha switches = 
-    let fhs' = fhs switches
+    let
+       fhs' = fhs switches
        vhs' = vhs switches
        alphaReg' = alphaReg switches
        vsaves' = vsaves switches
        vhs' = vhs switches
        alphaReg' = alphaReg switches
        vsaves' = vsaves switches
@@ -189,12 +194,13 @@ mkAlpha switches =
        dhs' = dhs switches
        ps = genPrimCode target
        mc = genMacroCode target
        dhs' = dhs switches
        ps = genPrimCode target
        mc = genMacroCode target
-       hc = doHeapCheck target
-       target = mkTarget switches fhs' vhs' alphaReg' id size vsaves' vrests' 
-                         hprel as as' csz isz mhs' dhs' ps mc hc
-                         alphaCodeGen False mungeLabel
-    in target
-
+       hc = doHeapCheck --UNUSED NOW: target
+       target = mkTarget {-switches-} fhs' vhs' alphaReg' {-id-} size
+                         hprel as as'
+                         (vsaves', vrests', csz, isz, mhs', dhs', ps, mc, hc)
+                         {-alphaCodeGen False mungeLabel-}
+    in
+    (target, alphaCodeGen, False, mungeLabel)
 \end{code}
 
 The alpha assembler likes temporary labels to look like \tr{$L123}
 \end{code}
 
 The alpha assembler likes temporary labels to look like \tr{$L123}
index fb46055..9d24768 100644 (file)
@@ -10,9 +10,8 @@ import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+data CSeq 
+data PprStyle 
+data StixTree 
 alphaCodeGen :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq
 alphaCodeGen :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 211 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 3eb5a04..533a518 100644 (file)
@@ -294,7 +294,6 @@ getReg (StPrim primop args) =
        IntSubOp -> trivialCode (SUB Q False) args
        IntMulOp -> trivialCode (MUL Q False) args
        IntQuotOp -> trivialCode (DIV Q False) args
        IntSubOp -> trivialCode (SUB Q False) args
        IntMulOp -> trivialCode (MUL Q False) args
        IntQuotOp -> trivialCode (DIV Q False) args
-       IntDivOp -> call SLIT("stg_div") IntKind
        IntRemOp -> trivialCode (REM Q False) args
        IntNegOp -> trivialUCode (NEG Q False) args
        IntAbsOp -> trivialUCode (ABS Q) args
        IntRemOp -> trivialCode (REM Q False) args
        IntNegOp -> trivialUCode (NEG Q False) args
        IntAbsOp -> trivialUCode (ABS Q) args
index 9aedf3a..4119e7e 100644 (file)
@@ -1,24 +1,14 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AsmCodeGen where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AsmCodeGen where
-import AbsCSyn(AbstractC, CAddrMode, CStmtMacro, MagicId, RegRelative, ReturnInfo)
-import BasicLit(BasicLit)
-import CLabelInfo(CLabel)
-import ClosureInfo(ClosureInfo)
+import AbsCSyn(AbstractC)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
-import CostCentre(CostCentre)
-import Maybes(Labda)
-import PreludePS(_PackedString)
-import PrimOps(PrimOp)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import Stdio(_FILE)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import Stdio(_FILE)
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
+data AbstractC 
+data GlobalSwitch 
+data SwitchResult 
 type SUniqSM a = SplitUniqSupply -> a
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data SplitUniqSupply 
 dumpRealAsm :: (GlobalSwitch -> SwitchResult) -> AbstractC -> SplitUniqSupply -> [Char]
 dumpRealAsm :: (GlobalSwitch -> SwitchResult) -> AbstractC -> SplitUniqSupply -> [Char]
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "SLU(ALL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 writeRealAsm :: (GlobalSwitch -> SwitchResult) -> _FILE -> AbstractC -> SplitUniqSupply -> _State _RealWorld -> ((), _State _RealWorld)
 writeRealAsm :: (GlobalSwitch -> SwitchResult) -> _FILE -> AbstractC -> SplitUniqSupply -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 5 _U_ 21212 _N_ _S_ "SU(P)LU(ALL)L" {_A_ 5 _U_ 22212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index bbb4cc9..47bc965 100644 (file)
@@ -28,13 +28,15 @@ import CmdLineOpts  ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResul
 import MachDesc
 import Maybes      ( Maybe(..) )
 import Outputable
 import MachDesc
 import Maybes      ( Maybe(..) )
 import Outputable
-#if alpha_dec_osf1_TARGET
+#if alpha_TARGET_ARCH
 import AlphaDesc    ( mkAlpha )
 import AlphaDesc    ( mkAlpha )
-#else
+#endif
+#if i386_TARGET_ARCH
+import I386Desc            ( mkI386 )
+#endif
 #if sparc_TARGET_ARCH
 import SparcDesc    ( mkSparc )
 #endif
 #if sparc_TARGET_ARCH
 import SparcDesc    ( mkSparc )
 #endif
-#endif
 import Stix
 import SplitUniq
 import Unique
 import Stix
 import SplitUniq
 import Unique
@@ -141,21 +143,25 @@ code flags absC =
     let 
        stix = map (map (genericOpt target)) treelists
     in
     let 
        stix = map (map (genericOpt target)) treelists
     in
-       codeGen target sty stix
+    codeGen {-target-} sty stix
   where
   where
-    sty = PprForAsm (switchIsOn flags) (underscore target) (fmtAsmLbl target)
+    sty = PprForAsm (switchIsOn flags) (underscore {-target-}) (fmtAsmLbl {-target-})
 
 
-    target = case stringSwitchSet flags AsmTarget of
+    (target, codeGen, underscore, fmtAsmLbl)
+      = case stringSwitchSet flags AsmTarget of
 #if ! OMIT_NATIVE_CODEGEN
 #if ! OMIT_NATIVE_CODEGEN
-#if sparc_sun_sunos4_TARGET
+# if alpha_TARGET_ARCH
+       Just _ {-???"alpha-dec-osf1"-} -> mkAlpha flags
+# endif
+# if i386_TARGET_ARCH
+       Just _ {-???"i386_unknown_linuxaout"-} -> mkI386 True flags
+# endif
+# if sparc_sun_sunos4_TARGET
        Just _ {-???"sparc-sun-sunos4"-} -> mkSparc True flags
        Just _ {-???"sparc-sun-sunos4"-} -> mkSparc True flags
-#endif
-#if sparc_sun_solaris2_TARGET
+# endif
+# if sparc_sun_solaris2_TARGET
        Just _ {-???"sparc-sun-solaris2"-} -> mkSparc False flags
        Just _ {-???"sparc-sun-solaris2"-} -> mkSparc False flags
-#endif
-#if alpha_TARGET_ARCH
-       Just _ {-???"alpha-dec-osf1"-} -> mkAlpha flags
-#endif
+# endif
 #endif
         _ -> error
             ("ERROR:Trying to generate assembly language for an unsupported architecture\n"++
 #endif
         _ -> error
             ("ERROR:Trying to generate assembly language for an unsupported architecture\n"++
@@ -190,8 +196,10 @@ genericOpt
 For most nodes, just optimize the children.
 
 \begin{code}
 For most nodes, just optimize the children.
 
 \begin{code}
+-- hacking with Uncle Will:
+#define target_STRICT target@(Target _ _ _ _ _ _ _ _)
 
 
-genericOpt target (StInd pk addr) =
+genericOpt target_STRICT (StInd pk addr) =
     StInd pk (genericOpt target addr)
 
 genericOpt target (StAssign pk dst src) =
     StInd pk (genericOpt target addr)
 
 genericOpt target (StAssign pk dst src) =
@@ -275,7 +283,6 @@ primOpt op args@[StInt x, StInt y] =
        IntSubOp -> StInt (x - y)
        IntMulOp -> StInt (x * y)
        IntQuotOp -> StInt (x `quot` y)
        IntSubOp -> StInt (x - y)
        IntMulOp -> StInt (x * y)
        IntQuotOp -> StInt (x `quot` y)
-       IntDivOp -> StInt (x `div` y)
        IntRemOp -> StInt (x `rem` y)
        IntGtOp -> StInt (if x > y then 1 else 0)
        IntGeOp -> StInt (if x >= y then 1 else 0)
        IntRemOp -> StInt (x `rem` y)
        IntGtOp -> StInt (if x > y then 1 else 0)
        IntGeOp -> StInt (if x >= y then 1 else 0)
@@ -321,7 +328,6 @@ primOpt op args@[x, y@(StInt 0)] =
 primOpt op args@[x, y@(StInt 1)] = 
     case op of
        IntMulOp -> x
 primOpt op args@[x, y@(StInt 1)] = 
     case op of
        IntMulOp -> x
-       IntDivOp -> x
        IntQuotOp -> x
        IntRemOp -> StInt 0
        _ -> StPrim op args
        IntQuotOp -> x
        IntRemOp -> StInt 0
        _ -> StPrim op args
index 2c1bed2..4959627 100644 (file)
@@ -3,92 +3,42 @@ interface AsmRegAlloc where
 import CLabelInfo(CLabel)
 import FiniteMap(FiniteMap)
 import OrdList(OrdList)
 import CLabelInfo(CLabel)
 import FiniteMap(FiniteMap)
 import OrdList(OrdList)
-import Outputable(NamedThing)
+import Outputable(NamedThing, Outputable)
 import PrimKind(PrimKind)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 class MachineCode a where
        regUsage :: a -> RegUsage
 import PrimKind(PrimKind)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 class MachineCode a where
        regUsage :: a -> RegUsage
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(SAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> RegUsage) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> RegUsage, u0 -> RegLiveness -> RegLiveness, u0 -> (Reg -> Reg) -> u0, Reg -> Reg -> OrdList u0, Reg -> Reg -> OrdList u0)) -> case u1 of { _ALG_ _TUP_5 (u2 :: u0 -> RegUsage) (u3 :: u0 -> RegLiveness -> RegLiveness) (u4 :: u0 -> (Reg -> Reg) -> u0) (u5 :: Reg -> Reg -> OrdList u0) (u6 :: Reg -> Reg -> OrdList u0) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{MachineCode u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> RegUsage) } [ _NOREP_S_ "%DAsmRegAlloc.MachineCode.regUsage\"", u2 ] _N_ #-}
        regLiveness :: a -> RegLiveness -> RegLiveness
        regLiveness :: a -> RegLiveness -> RegLiveness
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(ASAAA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> RegLiveness -> RegLiveness) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> RegUsage, u0 -> RegLiveness -> RegLiveness, u0 -> (Reg -> Reg) -> u0, Reg -> Reg -> OrdList u0, Reg -> Reg -> OrdList u0)) -> case u1 of { _ALG_ _TUP_5 (u2 :: u0 -> RegUsage) (u3 :: u0 -> RegLiveness -> RegLiveness) (u4 :: u0 -> (Reg -> Reg) -> u0) (u5 :: Reg -> Reg -> OrdList u0) (u6 :: Reg -> Reg -> OrdList u0) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineCode u0}}) (u2 :: u0) (u3 :: RegLiveness) -> _APP_  _TYAPP_  patError# { (u0 -> RegLiveness -> RegLiveness) } [ _NOREP_S_ "%DAsmRegAlloc.MachineCode.regLiveness\"", u2, u3 ] _N_ #-}
        patchRegs :: a -> (Reg -> Reg) -> a
        patchRegs :: a -> (Reg -> Reg) -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AASAA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> (Reg -> Reg) -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> RegUsage, u0 -> RegLiveness -> RegLiveness, u0 -> (Reg -> Reg) -> u0, Reg -> Reg -> OrdList u0, Reg -> Reg -> OrdList u0)) -> case u1 of { _ALG_ _TUP_5 (u2 :: u0 -> RegUsage) (u3 :: u0 -> RegLiveness -> RegLiveness) (u4 :: u0 -> (Reg -> Reg) -> u0) (u5 :: Reg -> Reg -> OrdList u0) (u6 :: Reg -> Reg -> OrdList u0) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineCode u0}}) (u2 :: u0) (u3 :: Reg -> Reg) -> _APP_  _TYAPP_  patError# { (u0 -> (Reg -> Reg) -> u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineCode.patchRegs\"", u2, u3 ] _N_ #-}
        spillReg :: Reg -> Reg -> OrdList a
        spillReg :: Reg -> Reg -> OrdList a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AAASA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: Reg -> Reg -> OrdList u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> RegUsage, u0 -> RegLiveness -> RegLiveness, u0 -> (Reg -> Reg) -> u0, Reg -> Reg -> OrdList u0, Reg -> Reg -> OrdList u0)) -> case u1 of { _ALG_ _TUP_5 (u2 :: u0 -> RegUsage) (u3 :: u0 -> RegLiveness -> RegLiveness) (u4 :: u0 -> (Reg -> Reg) -> u0) (u5 :: Reg -> Reg -> OrdList u0) (u6 :: Reg -> Reg -> OrdList u0) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineCode u0}}) (u2 :: Reg) (u3 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> Reg -> OrdList u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineCode.spillReg\"", u2, u3 ] _N_ #-}
        loadReg :: Reg -> Reg -> OrdList a
        loadReg :: Reg -> Reg -> OrdList a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AAAAS)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: Reg -> Reg -> OrdList u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> RegUsage, u0 -> RegLiveness -> RegLiveness, u0 -> (Reg -> Reg) -> u0, Reg -> Reg -> OrdList u0, Reg -> Reg -> OrdList u0)) -> case u1 of { _ALG_ _TUP_5 (u2 :: u0 -> RegUsage) (u3 :: u0 -> RegLiveness -> RegLiveness) (u4 :: u0 -> (Reg -> Reg) -> u0) (u5 :: Reg -> Reg -> OrdList u0) (u6 :: Reg -> Reg -> OrdList u0) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineCode u0}}) (u2 :: Reg) (u3 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> Reg -> OrdList u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineCode.loadReg\"", u2, u3 ] _N_ #-}
 class MachineRegisters a where
        mkMRegs :: [Int] -> a
 class MachineRegisters a where
        mkMRegs :: [Int] -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(SAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: [Int] -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: ([Int] -> u0, PrimKind -> u0 -> [Int], u0 -> Int# -> u0, u0 -> [Int] -> u0, u0 -> Int# -> u0, u0 -> [Int] -> u0)) -> case u1 of { _ALG_ _TUP_6 (u2 :: [Int] -> u0) (u3 :: PrimKind -> u0 -> [Int]) (u4 :: u0 -> Int# -> u0) (u5 :: u0 -> [Int] -> u0) (u6 :: u0 -> Int# -> u0) (u7 :: u0 -> [Int] -> u0) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{MachineRegisters u0}}) (u2 :: [Int]) -> _APP_  _TYAPP_  patError# { ([Int] -> u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineRegisters.mkMRegs\"", u2 ] _N_ #-}
        possibleMRegs :: PrimKind -> a -> [Int]
        possibleMRegs :: PrimKind -> a -> [Int]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(ASAAAA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PrimKind -> u0 -> [Int]) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: ([Int] -> u0, PrimKind -> u0 -> [Int], u0 -> Int# -> u0, u0 -> [Int] -> u0, u0 -> Int# -> u0, u0 -> [Int] -> u0)) -> case u1 of { _ALG_ _TUP_6 (u2 :: [Int] -> u0) (u3 :: PrimKind -> u0 -> [Int]) (u4 :: u0 -> Int# -> u0) (u5 :: u0 -> [Int] -> u0) (u6 :: u0 -> Int# -> u0) (u7 :: u0 -> [Int] -> u0) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineRegisters u0}}) (u2 :: PrimKind) (u3 :: u0) -> _APP_  _TYAPP_  patError# { (PrimKind -> u0 -> [Int]) } [ _NOREP_S_ "%DAsmRegAlloc.MachineRegisters.possibleMRegs\"", u2, u3 ] _N_ #-}
        useMReg :: a -> Int# -> a
        useMReg :: a -> Int# -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> Int# -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: ([Int] -> u0, PrimKind -> u0 -> [Int], u0 -> Int# -> u0, u0 -> [Int] -> u0, u0 -> Int# -> u0, u0 -> [Int] -> u0)) -> case u1 of { _ALG_ _TUP_6 (u2 :: [Int] -> u0) (u3 :: PrimKind -> u0 -> [Int]) (u4 :: u0 -> Int# -> u0) (u5 :: u0 -> [Int] -> u0) (u6 :: u0 -> Int# -> u0) (u7 :: u0 -> [Int] -> u0) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineRegisters u0}}) (u2 :: u0) (u3 :: Int#) -> _APP_  _TYAPP_  patError# { (u0 -> Int# -> u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineRegisters.useMReg\"", u2, u3 ] _N_ #-}
        useMRegs :: a -> [Int] -> a
        useMRegs :: a -> [Int] -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AAASAA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> [Int] -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: ([Int] -> u0, PrimKind -> u0 -> [Int], u0 -> Int# -> u0, u0 -> [Int] -> u0, u0 -> Int# -> u0, u0 -> [Int] -> u0)) -> case u1 of { _ALG_ _TUP_6 (u2 :: [Int] -> u0) (u3 :: PrimKind -> u0 -> [Int]) (u4 :: u0 -> Int# -> u0) (u5 :: u0 -> [Int] -> u0) (u6 :: u0 -> Int# -> u0) (u7 :: u0 -> [Int] -> u0) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineRegisters u0}}) (u2 :: u0) (u3 :: [Int]) -> _APP_  _TYAPP_  patError# { (u0 -> [Int] -> u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineRegisters.useMRegs\"", u2, u3 ] _N_ #-}
        freeMReg :: a -> Int# -> a
        freeMReg :: a -> Int# -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AAAASA)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> Int# -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: ([Int] -> u0, PrimKind -> u0 -> [Int], u0 -> Int# -> u0, u0 -> [Int] -> u0, u0 -> Int# -> u0, u0 -> [Int] -> u0)) -> case u1 of { _ALG_ _TUP_6 (u2 :: [Int] -> u0) (u3 :: PrimKind -> u0 -> [Int]) (u4 :: u0 -> Int# -> u0) (u5 :: u0 -> [Int] -> u0) (u6 :: u0 -> Int# -> u0) (u7 :: u0 -> [Int] -> u0) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineRegisters u0}}) (u2 :: u0) (u3 :: Int#) -> _APP_  _TYAPP_  patError# { (u0 -> Int# -> u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineRegisters.freeMReg\"", u2, u3 ] _N_ #-}
        freeMRegs :: a -> [Int] -> a
        freeMRegs :: a -> [Int] -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> [Int] -> u0) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: ([Int] -> u0, PrimKind -> u0 -> [Int], u0 -> Int# -> u0, u0 -> [Int] -> u0, u0 -> Int# -> u0, u0 -> [Int] -> u0)) -> case u1 of { _ALG_ _TUP_6 (u2 :: [Int] -> u0) (u3 :: PrimKind -> u0 -> [Int]) (u4 :: u0 -> Int# -> u0) (u5 :: u0 -> [Int] -> u0) (u6 :: u0 -> Int# -> u0) (u7 :: u0 -> [Int] -> u0) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{MachineRegisters u0}}) (u2 :: u0) (u3 :: [Int]) -> _APP_  _TYAPP_  patError# { (u0 -> [Int] -> u0) } [ _NOREP_S_ "%DAsmRegAlloc.MachineRegisters.freeMRegs\"", u2, u3 ] _N_ #-}
 data CLabel 
 data CLabel 
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
+data FiniteMap a b 
 data FutureLive   = FL (UniqFM Reg) (FiniteMap CLabel (UniqFM Reg))
 data FutureLive   = FL (UniqFM Reg) (FiniteMap CLabel (UniqFM Reg))
-data OrdList a         {-# GHC_PRAGMA SeqList (OrdList a) (OrdList a) | ParList (OrdList a) (OrdList a) | OrdObj a | NoObj #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data OrdList a 
+data PrimKind 
 data Reg   = FixedReg Int# | MappedReg Int# | MemoryReg Int PrimKind | UnmappedReg Unique PrimKind
 data RegLiveness   = RL (UniqFM Reg) FutureLive
 data RegUsage   = RU (UniqFM Reg) (UniqFM Reg)
 data Reg   = FixedReg Int# | MappedReg Int# | MemoryReg Int PrimKind | UnmappedReg Unique PrimKind
 data RegLiveness   = RL (UniqFM Reg) FutureLive
 data RegUsage   = RU (UniqFM Reg) (UniqFM Reg)
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 extractMappedRegNos :: [Reg] -> [Int]
 extractMappedRegNos :: [Reg] -> [Int]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkReg :: Unique -> PrimKind -> Reg
 mkReg :: Unique -> PrimKind -> Reg
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: PrimKind) -> _!_ _ORIG_ AsmRegAlloc UnmappedReg [] [u0, u1] _N_ #-}
+runHairyRegAllocate :: (MachineRegisters a, MachineCode b) => a -> [Int] -> OrdList b -> [b]
 runRegAllocate :: (MachineRegisters a, MachineCode b) => a -> [Int] -> OrdList b -> [b]
 runRegAllocate :: (MachineRegisters a, MachineCode b) => a -> [Int] -> OrdList b -> [b]
-       {-# GHC_PRAGMA _A_ 5 _U_ 22221 _N_ _S_ "LLLLS" _N_ _SPECIALISE_ [ AlphaRegs, AlphaInstr ] 2 { _A_ 0 _U_ 221 _N_ _N_ _N_ _N_ } #-}
 instance Eq Reg
 instance Eq Reg
-       {-# GHC_PRAGMA _M_ AsmRegAlloc {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Reg -> Reg -> Bool), (Reg -> Reg -> Bool)] [_CONSTM_ Eq (==) (Reg), _CONSTM_ Eq (/=) (Reg)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Reg
 instance Ord Reg
-       {-# GHC_PRAGMA _M_ AsmRegAlloc {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Reg}}, (Reg -> Reg -> Bool), (Reg -> Reg -> Bool), (Reg -> Reg -> Bool), (Reg -> Reg -> Bool), (Reg -> Reg -> Reg), (Reg -> Reg -> Reg), (Reg -> Reg -> _CMP_TAG)] [_DFUN_ Eq (Reg), _CONSTM_ Ord (<) (Reg), _CONSTM_ Ord (<=) (Reg), _CONSTM_ Ord (>=) (Reg), _CONSTM_ Ord (>) (Reg), _CONSTM_ Ord max (Reg), _CONSTM_ Ord min (Reg), _CONSTM_ Ord _tagCmp (Reg)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance NamedThing Reg
 instance NamedThing Reg
-       {-# GHC_PRAGMA _M_ AsmRegAlloc {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Reg -> ExportFlag), (Reg -> Bool), (Reg -> (_PackedString, _PackedString)), (Reg -> _PackedString), (Reg -> [_PackedString]), (Reg -> SrcLoc), (Reg -> Unique), (Reg -> Bool), (Reg -> UniType), (Reg -> Bool)] [_CONSTM_ NamedThing getExportFlag (Reg), _CONSTM_ NamedThing isLocallyDefined (Reg), _CONSTM_ NamedThing getOrigName (Reg), _CONSTM_ NamedThing getOccurrenceName (Reg), _CONSTM_ NamedThing getInformingModules (Reg), _CONSTM_ NamedThing getSrcLoc (Reg), _CONSTM_ NamedThing getTheUnique (Reg), _CONSTM_ NamedThing hasType (Reg), _CONSTM_ NamedThing getType (Reg), _CONSTM_ NamedThing fromPreludeCore (Reg)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u0 ] _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u0 ] _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Reg) -> _APP_  _TYAPP_  patError# { (Reg -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-}
+instance Outputable Reg
 instance Text Reg
 instance Text Reg
-       {-# GHC_PRAGMA _M_ AsmRegAlloc {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Reg, [Char])]), (Int -> Reg -> [Char] -> [Char]), ([Char] -> [([Reg], [Char])]), ([Reg] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Reg), _CONSTM_ Text showsPrec (Reg), _CONSTM_ Text readList (Reg), _CONSTM_ Text showList (Reg)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(Reg, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 012 _N_ _S_ "AS" {_A_ 1 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 9d11e22..d71b00e 100644 (file)
@@ -11,7 +11,7 @@ module AsmRegAlloc (
        FutureLive(..), RegLiveness(..), RegUsage(..), Reg(..),
        MachineRegisters(..), MachineCode(..),
 
        FutureLive(..), RegLiveness(..), RegUsage(..), Reg(..),
        MachineRegisters(..), MachineCode(..),
 
-       mkReg, runRegAllocate,
+       mkReg, runRegAllocate, runHairyRegAllocate,
        extractMappedRegNos,
 
        -- And, for self-sufficiency
        extractMappedRegNos,
 
        -- And, for self-sufficiency
@@ -35,20 +35,29 @@ import Util
 
 #if ! OMIT_NATIVE_CODEGEN
 
 
 #if ! OMIT_NATIVE_CODEGEN
 
-#if sparc_TARGET_ARCH
-import SparcCode       -- ( SparcInstr, SparcRegs ) -- for specializing
+# if alpha_TARGET_ARCH
+import AlphaCode       -- ( AlphaInstr, AlphaRegs ) -- for specializing
 
 {-# SPECIALIZE
 
 {-# SPECIALIZE
-    runRegAllocate :: SparcRegs -> [Int] -> (OrdList SparcInstr) -> [SparcInstr]
+    runRegAllocate :: AlphaRegs -> [Int] -> (OrdList AlphaInstr) -> [AlphaInstr]
   #-}
   #-}
-#endif
-#if alpha_TARGET_ARCH
-import AlphaCode       -- ( AlphaInstr, AlphaRegs ) -- for specializing
+# endif
+
+# if i386_TARGET_ARCH
+import I386Code                -- ( I386Instr, I386Regs ) -- for specializing
 
 {-# SPECIALIZE
 
 {-# SPECIALIZE
-    runRegAllocate :: AlphaRegs -> [Int] -> (OrdList AlphaInstr) -> [AlphaInstr]
+    runRegAllocate :: I386Regs -> [Int] -> (OrdList I386Instr) -> [I386Instr]
   #-}
   #-}
-#endif
+# endif
+
+# if sparc_TARGET_ARCH
+import SparcCode       -- ( SparcInstr, SparcRegs ) -- for specializing
+
+{-# SPECIALIZE
+    runRegAllocate :: SparcRegs -> [Int] -> (OrdList SparcInstr) -> [SparcInstr]
+  #-}
+# endif
 
 #endif
 
 
 #endif
 
@@ -229,6 +238,17 @@ runRegAllocate regs reserve_regs instrs =
     simpleAlloc = simpleRegAlloc regs [] emptyFM flatInstrs
     hairyAlloc = hairyRegAlloc regs reserve_regs flatInstrs
 
     simpleAlloc = simpleRegAlloc regs [] emptyFM flatInstrs
     hairyAlloc = hairyRegAlloc regs reserve_regs flatInstrs
 
+runHairyRegAllocate            -- use only hairy for i386!
+    :: (MachineRegisters a, MachineCode b)
+    => a
+    -> [Int]
+    -> (OrdList b)
+    -> [b]
+
+runHairyRegAllocate regs reserve_regs instrs
+  = hairyRegAlloc regs reserve_regs flatInstrs
+  where
+    flatInstrs = flattenOrdList instrs
 \end{code}
 
 Here is the simple register allocator. Just dole out registers until
 \end{code}
 
 Here is the simple register allocator. Just dole out registers until
diff --git a/ghc/compiler/nativeGen/I386Code.hi b/ghc/compiler/nativeGen/I386Code.hi
new file mode 100644 (file)
index 0000000..e5fdf14
--- /dev/null
@@ -0,0 +1,99 @@
+{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+interface I386Code where
+import AbsCSyn(MagicId)
+import AsmRegAlloc(MachineCode, MachineRegisters, Reg)
+import BitSet(BitSet)
+import CLabelInfo(CLabel)
+import CharSeq(CSeq)
+import FiniteMap(FiniteMap)
+import Maybes(Labda)
+import OrdList(OrdList)
+import PreludePS(_PackedString)
+import Pretty(PprStyle)
+import PrimKind(PrimKind)
+import Stix(CodeSegment)
+import UniqFM(UniqFM)
+import UniqSet(UniqSet(..))
+import Unique(Unique)
+data Addr   = Addr (Labda Reg) (Labda (Reg, Int)) Imm | ImmAddr Imm Int
+type Base = Labda Reg
+data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data Reg       {-# GHC_PRAGMA FixedReg Int# | MappedReg Int# | MemoryReg Int PrimKind | UnmappedReg Unique PrimKind #-}
+data BitSet    {-# GHC_PRAGMA MkBS Word# #-}
+data CLabel 
+data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
+data CodeSegment       {-# GHC_PRAGMA DataSegment | TextSegment #-}
+data Cond   = ALWAYS | GEU | LU | EQ | GT | GE | GU | LT | LE | LEU | NE | NEG | POS
+type Displacement = Imm
+data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
+type I386Code = OrdList I386Instr
+data I386Instr
+  = MOV Size Operand Operand | MOVZX Size Operand Operand | MOVSX Size Operand Operand | LEA Size Operand Operand | ADD Size Operand Operand | SUB Size Operand Operand | IMUL Size Operand Operand | IDIV Size Operand | AND Size Operand Operand | OR Size Operand Operand | XOR Size Operand Operand | NOT Size Operand | NEGI Size Operand | SHL Size Operand Operand | SAR Size Operand Operand | SHR Size Operand Operand | NOP | SAHF | FABS | FADD Size Operand | FADDP | FIADD Size Addr | FCHS | FCOM Size Operand | FCOS | FDIV Size Operand | FDIVP | FIDIV Size Addr | FDIVR Size Operand | FDIVRP | FIDIVR Size Addr | FICOM Size Addr | FILD Size Addr Reg | FIST Size Addr | FLD Size Operand | FLD1 | FLDZ | FMUL Size Operand | FMULP | FIMUL Size Addr | FRNDINT | FSIN | FSQRT | FST Size Operand | FSTP Size Operand | FSUB Size Operand | FSUBP | FISUB Size Addr | FSUBR Size Operand | FSUBRP | FISUBR Size Addr | FTST | FCOMP Size Operand | FUCOMPP | FXCH | FNSTSW | FNOP | TEST Size Operand Operand | CMP Size Operand Operand | SETCC Cond Operand | PUSH Size Operand | POP Size Operand | JMP Operand | JXX Cond CLabel | CALL Imm | CLTD | LABEL CLabel | COMMENT _PackedString | SEGMENT CodeSegment | ASCII Bool [Char] | DATA Size [Imm]
+data I386Regs  {-# GHC_PRAGMA SRegs BitSet BitSet #-}
+data Imm   = ImmInt Int | ImmInteger Integer | ImmCLbl CLabel | ImmLab CSeq | ImmLit CSeq
+type Index = Labda (Reg, Int)
+data Operand   = OpReg Reg | OpImm Imm | OpAddr Addr
+data OrdList a         {-# GHC_PRAGMA SeqList (OrdList a) (OrdList a) | ParList (OrdList a) (OrdList a) | OrdObj a | NoObj #-}
+data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data Size   = B | HB | S | L | F | D
+data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+type UniqSet a = UniqFM a
+data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+baseRegOffset :: MagicId -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+callerSaves :: MagicId -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 21 \ (u0 :: MagicId) -> case u0 of { _ALG_ _ORIG_ AbsCSyn Hp  -> _!_ True [] []; (u1 :: MagicId) -> _!_ False [] [] } _N_ #-}
+eax :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [0#] _N_ #-}
+ebp :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [6#] _N_ #-}
+ebx :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [1#] _N_ #-}
+ecx :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [2#] _N_ #-}
+edi :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [5#] _N_ #-}
+edx :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [3#] _N_ #-}
+esi :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [4#] _N_ #-}
+esp :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [7#] _N_ #-}
+freeRegs :: [Reg]
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+is13Bits :: Integral a => a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(LU(U(ALASAAAA)AAA)AAAAAAAAAA)" {_A_ 3 _U_ 1112 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Integer ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(PPP)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
+kindToSize :: PrimKind -> Size
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
+offset :: Addr -> Int -> Labda Addr
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
+printLabeledCodes :: PprStyle -> [I386Instr] -> CSeq
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
+reservedRegs :: [Int]
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _NIL_ [Int] [] _N_ #-}
+spRel :: Int -> Addr
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
+st0 :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+st1 :: Reg
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+stgRegMap :: MagicId -> Labda Reg
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+strImmLit :: [Char] -> Imm
+       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
+instance MachineCode I386Instr
+       {-# GHC_PRAGMA _M_ I386Code {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 6 _!_ _TUP_5 [(I386Instr -> RegUsage), (I386Instr -> RegLiveness -> RegLiveness), (I386Instr -> (Reg -> Reg) -> I386Instr), (Reg -> Reg -> OrdList I386Instr), (Reg -> Reg -> OrdList I386Instr)] [_CONSTM_ MachineCode regUsage (I386Instr), _CONSTM_ MachineCode regLiveness (I386Instr), _CONSTM_ MachineCode patchRegs (I386Instr), _CONSTM_ MachineCode spillReg (I386Instr), _CONSTM_ MachineCode loadReg (I386Instr)] _N_
+        regUsage = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
+        regLiveness = _A_ 2 _U_ 11 _N_ _S_ "SU(LU(LL))" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _N_,
+        patchRegs = _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_,
+        spillReg = _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_,
+        loadReg = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
+instance MachineRegisters I386Regs
+       {-# GHC_PRAGMA _M_ I386Code {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 7 _!_ _TUP_6 [([Int] -> I386Regs), (PrimKind -> I386Regs -> [Int]), (I386Regs -> Int# -> I386Regs), (I386Regs -> [Int] -> I386Regs), (I386Regs -> Int# -> I386Regs), (I386Regs -> [Int] -> I386Regs)] [_CONSTM_ MachineRegisters mkMRegs (I386Regs), _CONSTM_ MachineRegisters possibleMRegs (I386Regs), _CONSTM_ MachineRegisters useMReg (I386Regs), _CONSTM_ MachineRegisters useMRegs (I386Regs), _CONSTM_ MachineRegisters freeMReg (I386Regs), _CONSTM_ MachineRegisters freeMRegs (I386Regs)] _N_
+        mkMRegs = _A_ 1 _U_ 1 _N_ _N_ _N_ _N_,
+        possibleMRegs = _A_ 2 _U_ 11 _N_ _S_ "EU(LL)" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_,
+        useMReg = _A_ 2 _U_ 12 _N_ _S_ "U(LL)P" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_,
+        useMRegs = _A_ 2 _U_ 11 _N_ _S_ "U(LL)L" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_,
+        freeMReg = _A_ 2 _U_ 12 _N_ _S_ "U(LL)P" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_,
+        freeMRegs = _A_ 2 _U_ 11 _N_ _S_ "U(LL)L" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+
diff --git a/ghc/compiler/nativeGen/I386Code.lhs b/ghc/compiler/nativeGen/I386Code.lhs
new file mode 100644 (file)
index 0000000..8730e86
--- /dev/null
@@ -0,0 +1,1382 @@
+%
+% (c) The AQUA Project, Glasgow University, 1993-1995
+%
+
+\section[I386Code]{The Native (I386) Machine Code}
+
+\begin{code}
+#define ILIT2(x) ILIT(x)
+#include "HsVersions.h"
+
+module I386Code (
+       Addr(..), 
+        Cond(..), Imm(..), Operand(..), Size(..),
+        Base(..), Index(..), Displacement(..),
+       I386Code(..),I386Instr(..),I386Regs,
+       strImmLit, --UNUSED: strImmLab,
+        spRel,
+
+       printLabeledCodes,
+
+       baseRegOffset, stgRegMap, callerSaves,
+
+       is13Bits, offset,
+
+       kindToSize,
+
+       st0, st1, eax, ebx, ecx, edx, esi, edi, ebp, esp,
+
+       freeRegs, reservedRegs,
+
+       -- and, for self-sufficiency ...
+       CLabel, CodeSegment, OrdList, PrimKind, Reg, UniqSet(..),
+       UniqFM, FiniteMap, Unique, MagicId, CSeq, BitSet
+    ) where
+
+IMPORT_Trace
+
+import AbsCSyn         ( MagicId(..) )
+import AsmRegAlloc     ( MachineCode(..), MachineRegisters(..), FutureLive(..),
+                         Reg(..), RegUsage(..), RegLiveness(..)
+                       )
+import BitSet   
+import CgCompInfo      ( mAX_Double_REG, mAX_Float_REG, mAX_Vanilla_REG )
+import CLabelInfo      ( CLabel, pprCLabel, externallyVisibleCLabel, charToC )
+import FiniteMap    
+import Maybes          ( Maybe(..), maybeToBool )
+import OrdList         ( OrdList, mkUnitList, flattenOrdList )
+import Outputable    
+import PrimKind                ( PrimKind(..) )
+import UniqSet
+import Stix
+import Unpretty
+import Util
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[I386Reg]{The Native (I386) Machine Register Table}
+%*                                                                     *
+%************************************************************************
+
+- All registers except 7 (esp) are available for use.
+- Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
+- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
+- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
+- Registers 8-15 hold extended floating point values.
+
+ToDo: Deal with stg registers that live as offsets from BaseReg!(JSM)
+
+\begin{code}
+
+gReg,fReg :: Int -> Int
+gReg x = x
+fReg x = (8 + x)
+
+st0, st1, st2, st3, st4, st5, st6, st7, eax, ebx, ecx, edx, esp :: Reg
+eax = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
+ebx = case (gReg 1) of { IBOX(g1) -> FixedReg g1 }
+ecx = case (gReg 2) of { IBOX(g2) -> FixedReg g2 }
+edx = case (gReg 3) of { IBOX(g3) -> FixedReg g3 }
+esi = case (gReg 4) of { IBOX(g4) -> FixedReg g4 }
+edi = case (gReg 5) of { IBOX(g5) -> FixedReg g5 }
+ebp = case (gReg 6) of { IBOX(g6) -> FixedReg g6 }
+esp = case (gReg 7) of { IBOX(g7) -> FixedReg g7 }
+st0 = realReg  (fReg 0)
+st1 = realReg  (fReg 1)
+st2 = realReg  (fReg 2)
+st3 = realReg  (fReg 3)
+st4 = realReg  (fReg 4)
+st5 = realReg  (fReg 5)
+st6 = realReg  (fReg 6)
+st7 = realReg  (fReg 7)
+
+realReg n@IBOX(i) = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
+
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[TheI386Code]{The datatype for i386 assembly language}
+%*                                                                     *
+%************************************************************************
+
+Here is a definition of the I386 assembly language.
+
+\begin{code}
+
+data Imm = ImmInt Int
+        | ImmInteger Integer         -- Sigh.
+        | ImmCLbl CLabel             -- AbstractC Label (with baggage)
+        | ImmLab  Unpretty           -- Simple string label (underscored)
+        | ImmLit Unpretty            -- Simple string
+        deriving ()
+
+--UNUSED:strImmLab s = ImmLab (uppStr s)
+strImmLit s = ImmLit (uppStr s)
+
+data Cond = ALWAYS
+         | GEU
+         | LU
+         | EQ
+         | GT
+         | GE
+         | GU
+         | LT
+         | LE
+         | LEU
+         | NE
+         | NEG
+         | POS
+         deriving ()
+
+
+data Size = B
+         | HB
+         | S -- unused ?
+         | L
+         | F
+         | D
+         deriving ()
+
+data Operand = OpReg  Reg      -- register
+             | OpImm  Imm      -- immediate value
+             | OpAddr Addr     -- memory reference
+            deriving ()
+
+data Addr = Addr Base Index Displacement
+          | ImmAddr Imm Int
+          -- deriving Eq
+
+type Base         = Maybe Reg
+type Index        = Maybe (Reg, Int)   -- Int is 2, 4 or 8
+type Displacement = Imm
+
+data I386Instr =
+
+-- Moves.
+
+               MOV           Size Operand Operand 
+             | MOVZX         Size Operand Operand -- size is the size of operand 2
+             | MOVSX         Size Operand Operand -- size is the size of operand 2
+
+-- Load effective address (also a very useful three-operand add instruction :-)
+
+              | LEA           Size Operand Operand
+
+-- Int Arithmetic.
+
+             | ADD           Size Operand Operand 
+             | SUB           Size Operand Operand 
+
+-- Multiplication (signed and unsigned), Division (signed and unsigned),
+-- result in %eax, %edx.
+
+             | IMUL          Size Operand Operand
+             | IDIV          Size Operand
+
+-- Simple bit-twiddling.
+
+             | AND           Size Operand Operand 
+             | OR            Size Operand Operand 
+             | XOR           Size Operand Operand 
+             | NOT           Size Operand 
+             | NEGI          Size Operand -- NEG instruction (name clash with Cond)
+             | SHL           Size Operand Operand -- 1st operand must be an Imm
+             | SAR           Size Operand Operand -- 1st operand must be an Imm
+             | SHR           Size Operand Operand -- 1st operand must be an Imm
+             | NOP           
+
+-- Float Arithmetic. -- ToDo for 386
+
+-- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
+-- right up until we spit them out.
+
+             | SAHF          -- stores ah into flags
+             | FABS          
+             | FADD          Size Operand -- src
+             | FADDP         
+             | FIADD         Size Addr -- src
+             | FCHS          
+             | FCOM          Size Operand -- src
+             | FCOS          
+             | FDIV          Size Operand -- src
+             | FDIVP         
+             | FIDIV         Size Addr -- src
+             | FDIVR         Size Operand -- src
+             | FDIVRP        
+             | FIDIVR        Size Addr -- src
+             | FICOM         Size Addr -- src
+             | FILD          Size Addr Reg -- src, dst
+             | FIST          Size Addr -- dst
+             | FLD           Size Operand -- src
+             | FLD1          
+             | FLDZ          
+             | FMUL          Size Operand -- src
+             | FMULP         
+             | FIMUL         Size Addr -- src
+             | FRNDINT       
+             | FSIN          
+             | FSQRT         
+             | FST           Size Operand -- dst
+             | FSTP          Size Operand -- dst
+             | FSUB          Size Operand -- src
+             | FSUBP         
+             | FISUB         Size Addr -- src
+             | FSUBR         Size Operand -- src
+             | FSUBRP        
+             | FISUBR        Size Addr -- src
+             | FTST          
+             | FCOMP         Size Operand -- src
+             | FUCOMPP       
+             | FXCH
+             | FNSTSW
+             | FNOP
+
+-- Comparison
+        
+              | TEST          Size Operand Operand
+              | CMP           Size Operand Operand
+              | SETCC         Cond Operand
+
+-- Stack Operations.
+
+              | PUSH          Size Operand
+              | POP           Size Operand
+
+-- Jumping around.
+
+             | JMP           Operand -- target
+             | JXX           Cond CLabel -- target
+             | CALL          Imm 
+
+-- Other things.
+
+              | CLTD -- sign extend %eax into %edx:%eax
+
+-- Pseudo-ops.
+
+             | LABEL CLabel
+             | COMMENT FAST_STRING
+             | SEGMENT CodeSegment
+             | ASCII Bool String   -- needs backslash conversion?
+             | DATA Size [Imm]
+
+type I386Code  = OrdList I386Instr
+
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[TheI386Pretty]{Pretty-printing the I386 Assembly Language}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+
+printLabeledCodes :: PprStyle -> [I386Instr] -> Unpretty
+printLabeledCodes sty codes = uppAboves (map (pprI386Instr sty) codes)
+
+\end{code}
+
+Printing the pieces...
+
+\begin{code}
+
+pprReg :: Size -> Reg -> Unpretty
+
+pprReg s (FixedReg i)  = pprI386Reg s i
+pprReg s (MappedReg i) = pprI386Reg s i
+pprReg s other         = uppStr (show other) -- should only happen when debugging
+
+pprI386Reg :: Size -> FAST_INT -> Unpretty
+pprI386Reg B i = uppPStr
+    (case i of {
+        ILIT( 0) -> SLIT("%al");  ILIT( 1) -> SLIT("%bl");
+       ILIT( 2) -> SLIT("%cl");  ILIT( 3) -> SLIT("%dl");
+       _ -> SLIT("very naughty I386 byte register")
+    })
+
+pprI386Reg HB i = uppPStr
+    (case i of {
+        ILIT( 0) -> SLIT("%ah");  ILIT( 1) -> SLIT("%bh");
+       ILIT( 2) -> SLIT("%ch");  ILIT( 3) -> SLIT("%dh");
+       _ -> SLIT("very naughty I386 high byte register")
+    })
+
+pprI386Reg S i = uppPStr
+    (case i of {
+        ILIT( 0) -> SLIT("%ax");  ILIT( 1) -> SLIT("%bx");
+       ILIT( 2) -> SLIT("%cx");  ILIT( 3) -> SLIT("%dx");
+        ILIT( 4) -> SLIT("%si");  ILIT( 5) -> SLIT("%di");
+       ILIT( 6) -> SLIT("%bp");  ILIT( 7) -> SLIT("%sp");
+       _ -> SLIT("very naughty I386 word register")
+    })
+
+pprI386Reg L i = uppPStr
+    (case i of {
+        ILIT( 0) -> SLIT("%eax");  ILIT( 1) -> SLIT("%ebx");
+       ILIT( 2) -> SLIT("%ecx");  ILIT( 3) -> SLIT("%edx");
+        ILIT( 4) -> SLIT("%esi");  ILIT( 5) -> SLIT("%edi");
+       ILIT( 6) -> SLIT("%ebp");  ILIT( 7) -> SLIT("%esp");
+       _ -> SLIT("very naughty I386 double word register")
+    })
+
+pprI386Reg F i = uppPStr
+    (case i of {
+--ToDo: rm these
+        ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
+       ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
+        ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
+       ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
+       _ -> SLIT("very naughty I386 float register")
+    })
+
+pprI386Reg D i = uppPStr
+    (case i of {
+--ToDo: rm these
+        ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
+       ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
+        ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
+       ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
+       _ -> SLIT("very naughty I386 float register")
+    })
+
+pprCond :: Cond -> Unpretty -- ToDo
+pprCond x = uppPStr
+    (case x of {
+       GEU     -> SLIT("ae");  LU    -> SLIT("b");
+       EQ      -> SLIT("e");   GT    -> SLIT("g");
+       GE      -> SLIT("ge");  GU    -> SLIT("a");
+       LT      -> SLIT("l");   LE    -> SLIT("le");
+       LEU     -> SLIT("be");  NE    -> SLIT("ne");
+       NEG     -> SLIT("s");   POS   -> SLIT("ns");
+       ALWAYS  -> SLIT("mp");  -- hack
+        _       -> error "Spix: iI386Code: unknown conditional!"
+    })
+
+pprDollImm :: PprStyle -> Imm -> Unpretty
+
+pprDollImm sty i     = uppBesides [ uppPStr SLIT("$"), pprImm sty i]
+
+pprImm :: PprStyle -> Imm -> Unpretty
+
+pprImm sty (ImmInt i)     = uppInt i
+pprImm sty (ImmInteger i) = uppInteger i
+pprImm sty (ImmCLbl l)    = pprCLabel sty l
+pprImm sty (ImmLab l)     = l
+
+--pprImm (PprForAsm _ False _) (ImmLab s) = s
+--pprImm _                     (ImmLab s) = uppBeside (uppChar '_') s
+
+pprImm sty (ImmLit s) = s
+
+pprAddr :: PprStyle -> Addr -> Unpretty
+pprAddr sty (ImmAddr imm off)
+  =  uppBesides [pprImm sty imm,
+                 if off > 0 then uppChar '+' else uppPStr SLIT(""),
+                 if off == 0 then uppPStr SLIT("") else uppInt off
+                ]
+pprAddr sty (Addr Nothing Nothing displacement)
+  =  uppBesides [pprDisp sty displacement]
+pprAddr sty (Addr base index displacement)
+  =  uppBesides [pprDisp sty displacement,
+                 uppChar '(',
+                 pprBase base,
+                 pprIndex index,
+                 uppChar ')'
+                ]
+  where
+    pprBase (Just r) = uppBesides [pprReg L r,
+                                   case index of 
+                                     Nothing -> uppPStr SLIT("")
+                                     _       -> uppChar ','
+                                  ]
+    pprBase _        = uppPStr SLIT("")
+    pprIndex (Just (r,i)) = uppBesides [pprReg L r, uppChar ',', uppInt i]
+    pprIndex _       = uppPStr SLIT("")
+
+pprDisp sty (ImmInt 0) = uppPStr SLIT("")
+--pprDisp sty (ImmInteger 0) = uppPStr SLIT("")
+pprDisp sty d = pprImm sty d
+
+pprOperand :: PprStyle -> Size -> Operand -> Unpretty
+pprOperand sty s (OpReg r) = pprReg s r
+pprOperand sty s (OpImm i) = pprDollImm sty i
+pprOperand sty s (OpAddr ea) = pprAddr sty ea
+
+pprSize :: Size -> Unpretty
+pprSize x = uppPStr
+    (case x of
+       B  -> SLIT("b")
+       HB -> SLIT("b")
+        S  -> SLIT("w")
+       L  -> SLIT("l")
+       F  -> SLIT("s")
+       D  -> SLIT("l")
+    )
+
+pprSizeOp :: PprStyle -> FAST_STRING -> Size -> Operand -> Unpretty
+pprSizeOp sty name size op1 =
+    uppBesides [
+       uppChar '\t',
+       uppPStr name,
+       pprSize size,
+       uppChar ' ',
+       pprOperand sty size op1
+    ]
+
+pprSizeOpOp :: PprStyle -> FAST_STRING -> Size -> Operand -> Operand -> Unpretty
+pprSizeOpOp sty name size op1 op2 =
+    uppBesides [
+       uppChar '\t',
+       uppPStr name,
+       pprSize size,
+       uppChar ' ',
+       pprOperand sty size op1,
+       uppComma,
+       pprOperand sty size op2
+    ]
+
+pprSizeOpReg :: PprStyle -> FAST_STRING -> Size -> Operand -> Reg -> Unpretty
+pprSizeOpReg sty name size op1 reg =
+    uppBesides [
+       uppChar '\t',
+       uppPStr name,
+       pprSize size,
+       uppChar ' ',
+       pprOperand sty size op1,
+       uppComma,
+       pprReg size reg
+    ]
+
+pprSizeAddr :: PprStyle -> FAST_STRING -> Size -> Addr -> Unpretty
+pprSizeAddr sty name size op =
+    uppBesides [
+       uppChar '\t',
+       uppPStr name,
+       pprSize size,
+       uppChar ' ',
+       pprAddr sty op
+    ]
+
+pprSizeAddrReg :: PprStyle -> FAST_STRING -> Size -> Addr -> Reg -> Unpretty
+pprSizeAddrReg sty name size op dst =
+    uppBesides [
+       uppChar '\t',
+       uppPStr name,
+       pprSize size,
+       uppChar ' ',
+       pprAddr sty op,
+       uppComma,
+        pprReg size dst
+    ]
+
+pprOpOp :: PprStyle -> FAST_STRING -> Size -> Operand -> Operand -> Unpretty
+pprOpOp sty name size op1 op2 =
+    uppBesides [
+       uppChar '\t',
+       uppPStr name,
+       uppChar ' ',
+       pprOperand sty size op1,
+       uppComma,
+       pprOperand sty size op2
+    ]
+
+pprSizeOpOpCoerce :: PprStyle -> FAST_STRING -> Size -> Size -> Operand -> Operand -> Unpretty
+pprSizeOpOpCoerce sty name size1 size2 op1 op2 =
+    uppBesides [ uppChar '\t', uppPStr name, uppChar ' ',
+       pprOperand sty size1 op1,
+       uppComma,
+       pprOperand sty size2 op2
+    ]
+
+pprCondInstr :: PprStyle -> FAST_STRING -> Cond -> Unpretty -> Unpretty
+pprCondInstr sty name cond arg =
+    uppBesides [ uppChar '\t', uppPStr name, pprCond cond, uppChar ' ', arg]
+
+pprI386Instr :: PprStyle -> I386Instr -> Unpretty
+pprI386Instr sty (MOV size (OpReg src) (OpReg dst)) -- hack
+  | src == dst
+  = uppPStr SLIT("")
+pprI386Instr sty (MOV size src dst) 
+  = pprSizeOpOp sty SLIT("mov") size src dst
+pprI386Instr sty (MOVZX size src dst) = pprSizeOpOpCoerce sty SLIT("movzx") L size src dst
+pprI386Instr sty (MOVSX size src dst) = pprSizeOpOpCoerce sty SLIT("movxs") L size src dst
+
+-- here we do some patching, since the physical registers are only set late
+-- in the code generation.
+pprI386Instr sty (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) 
+  | reg1 == reg3
+  = pprSizeOpOp sty SLIT("add") size (OpReg reg2) dst
+pprI386Instr sty (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) 
+  | reg2 == reg3
+  = pprSizeOpOp sty SLIT("add") size (OpReg reg1) dst
+pprI386Instr sty (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3)) 
+  | reg1 == reg3
+  = pprI386Instr sty (ADD size (OpImm displ) dst)
+pprI386Instr sty (LEA size src dst) = pprSizeOpOp sty SLIT("lea") size src dst
+
+pprI386Instr sty (ADD size (OpImm (ImmInt (-1))) dst) 
+  = pprSizeOp sty SLIT("dec") size dst
+pprI386Instr sty (ADD size (OpImm (ImmInt 1)) dst) 
+  = pprSizeOp sty SLIT("inc") size dst
+pprI386Instr sty (ADD size src dst) 
+  = pprSizeOpOp sty SLIT("add") size src dst
+pprI386Instr sty (SUB size src dst) = pprSizeOpOp sty SLIT("sub") size src dst
+pprI386Instr sty (IMUL size op1 op2) = pprSizeOpOp sty SLIT("imul") size op1 op2
+pprI386Instr sty (IDIV size op) = pprSizeOp sty SLIT("idiv") size op
+
+pprI386Instr sty (AND size src dst) = pprSizeOpOp sty SLIT("and") size src dst
+pprI386Instr sty (OR  size src dst) = pprSizeOpOp sty SLIT("or")  size src dst
+pprI386Instr sty (XOR size src dst) = pprSizeOpOp sty SLIT("xor")  size src dst
+pprI386Instr sty (NOT size op) = pprSizeOp sty SLIT("not") size op
+pprI386Instr sty (NEGI size op) = pprSizeOp sty SLIT("neg") size op
+pprI386Instr sty (SHL size imm dst) = pprSizeOpOp sty SLIT("shl")  size imm dst
+pprI386Instr sty (SAR size imm dst) = pprSizeOpOp sty SLIT("sar")  size imm dst
+pprI386Instr sty (SHR size imm dst) = pprSizeOpOp sty SLIT("shr")  size imm dst
+
+pprI386Instr sty (CMP size src dst) = pprSizeOpOp sty SLIT("cmp")  size src dst
+pprI386Instr sty (TEST size src dst) = pprSizeOpOp sty SLIT("test")  size src dst
+pprI386Instr sty (PUSH size op) = pprSizeOp sty SLIT("push") size op
+pprI386Instr sty (POP size op) = pprSizeOp sty SLIT("pop") size op
+
+pprI386Instr sty (NOP) = uppPStr SLIT("\tnop")
+pprI386Instr sty (CLTD) = uppPStr SLIT("\tcltd")
+
+pprI386Instr sty (SETCC cond op) = pprCondInstr sty SLIT("set") cond (pprOperand sty B op)
+
+pprI386Instr sty (JXX cond lab) = pprCondInstr sty SLIT("j") cond (pprCLabel sty lab)
+
+pprI386Instr sty (JMP (OpImm imm)) = uppBeside (uppPStr SLIT("\tjmp ")) (pprImm sty imm)
+pprI386Instr sty (JMP op) = uppBeside (uppPStr SLIT("\tjmp *")) (pprOperand sty L op)
+
+pprI386Instr sty (CALL imm) =
+    uppBesides [ uppPStr SLIT("\tcall "), pprImm sty imm ]
+
+pprI386Instr sty SAHF = uppPStr SLIT("\tsahf")
+pprI386Instr sty FABS = uppPStr SLIT("\tfabs")
+
+pprI386Instr sty (FADD sz src@(OpAddr _)) 
+  = uppBesides [uppPStr SLIT("\tfadd"), pprSize sz, uppChar ' ', pprOperand sty sz src]
+pprI386Instr sty (FADD sz src) 
+  = uppPStr SLIT("\tfadd")
+pprI386Instr sty FADDP 
+  = uppPStr SLIT("\tfaddp")
+pprI386Instr sty (FMUL sz src) 
+  = uppBesides [uppPStr SLIT("\tfmul"), pprSize sz, uppChar ' ', pprOperand sty sz src]
+pprI386Instr sty FMULP 
+  = uppPStr SLIT("\tfmulp")
+pprI386Instr sty (FIADD size op) = pprSizeAddr sty SLIT("fiadd") size op
+pprI386Instr sty FCHS = uppPStr SLIT("\tfchs")
+pprI386Instr sty (FCOM size op) = pprSizeOp sty SLIT("fcom") size op
+pprI386Instr sty FCOS = uppPStr SLIT("\tfcos")
+pprI386Instr sty (FIDIV size op) = pprSizeAddr sty SLIT("fidiv") size op
+pprI386Instr sty (FDIV sz src) 
+  = uppBesides [uppPStr SLIT("\tfdiv"), pprSize sz, uppChar ' ', pprOperand sty sz src]
+pprI386Instr sty FDIVP
+  = uppPStr SLIT("\tfdivp")
+pprI386Instr sty (FDIVR sz src)
+  = uppBesides [uppPStr SLIT("\tfdivr"), pprSize sz, uppChar ' ', pprOperand sty sz src]
+pprI386Instr sty FDIVRP
+  = uppPStr SLIT("\tfdivpr")
+pprI386Instr sty (FIDIVR size op) = pprSizeAddr sty SLIT("fidivr") size op
+pprI386Instr sty (FICOM size op) = pprSizeAddr sty SLIT("ficom") size op
+pprI386Instr sty (FILD sz op reg) = pprSizeAddrReg sty SLIT("fild") sz op reg
+pprI386Instr sty (FIST size op) = pprSizeAddr sty SLIT("fist") size op
+pprI386Instr sty (FLD sz (OpImm (ImmCLbl src))) 
+  = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppChar ' ',pprCLabel sty src]
+pprI386Instr sty (FLD sz src) 
+  = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppChar ' ',pprOperand sty sz src]
+pprI386Instr sty FLD1 = uppPStr SLIT("\tfld1")
+pprI386Instr sty FLDZ = uppPStr SLIT("\tfldz")
+pprI386Instr sty (FIMUL size op) = pprSizeAddr sty SLIT("fimul") size op
+pprI386Instr sty FRNDINT = uppPStr SLIT("\tfrndint")
+pprI386Instr sty FSIN = uppPStr SLIT("\tfsin")
+pprI386Instr sty FSQRT = uppPStr SLIT("\tfsqrt")
+pprI386Instr sty (FST sz dst) 
+  = uppBesides [uppPStr SLIT("\tfst"), pprSize sz, uppChar ' ', pprOperand sty sz dst]
+pprI386Instr sty (FSTP sz dst) 
+  = uppBesides [uppPStr SLIT("\tfstp"), pprSize sz, uppChar ' ', pprOperand sty sz dst]
+pprI386Instr sty (FISUB size op) = pprSizeAddr sty SLIT("fisub") size op
+pprI386Instr sty (FSUB sz src) 
+  = uppBesides [uppPStr SLIT("\tfsub"), pprSize sz, uppChar ' ', pprOperand sty sz src]
+pprI386Instr sty FSUBP
+  = uppPStr SLIT("\tfsubp")
+pprI386Instr sty (FSUBR size src)
+  = pprSizeOp sty SLIT("fsubr") size src
+pprI386Instr sty FSUBRP
+  = uppPStr SLIT("\tfsubpr")
+pprI386Instr sty (FISUBR size op) 
+  = pprSizeAddr sty SLIT("fisubr") size op
+pprI386Instr sty FTST = uppPStr SLIT("\tftst")
+pprI386Instr sty (FCOMP sz op) 
+  = uppBesides [uppPStr SLIT("\tfcomp"), pprSize sz, uppChar ' ', pprOperand sty sz op]
+pprI386Instr sty FUCOMPP = uppPStr SLIT("\tfucompp")
+pprI386Instr sty FXCH = uppPStr SLIT("\tfxch")
+pprI386Instr sty FNSTSW = uppPStr SLIT("\tfnstsw %ax")
+pprI386Instr sty FNOP = uppPStr SLIT("")
+
+pprI386Instr sty (LABEL clab) =
+    uppBesides [
+       if (externallyVisibleCLabel clab) then
+           uppBesides [uppPStr SLIT(".globl "), pprLab, uppChar '\n']
+       else
+           uppNil,
+       pprLab,
+       uppChar ':'
+    ]
+    where pprLab = pprCLabel sty clab
+
+pprI386Instr sty (COMMENT s) = uppBeside (uppPStr SLIT("# ")) (uppPStr s)
+
+pprI386Instr sty (SEGMENT TextSegment)
+    = uppPStr SLIT(".text\n\t.align 4")
+
+pprI386Instr sty (SEGMENT DataSegment)
+    = uppPStr SLIT(".data\n\t.align 2")
+
+pprI386Instr sty (ASCII False str) =
+    uppBesides [
+       uppStr "\t.asciz \"",
+       uppStr str,
+       uppChar '"'
+    ]
+
+pprI386Instr sty (ASCII True str) = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
+    where
+       asciify :: String -> Int -> Unpretty
+       asciify [] _ = uppStr ("\\0\"")
+       asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
+        asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
+        asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
+        asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
+       asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
+       asciify (c:(cs@(d:_))) n | isDigit d =
+                                       uppBeside (uppStr (charToC c)) (asciify cs 0)
+                                | otherwise =
+                                       uppBeside (uppStr (charToC c)) (asciify cs (n-1))
+
+pprI386Instr sty (DATA s xs) = uppInterleave (uppChar '\n') (map pp_item xs)
+    where pp_item x = case s of
+           B -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
+           HB-> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
+           S -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
+           L -> uppBeside (uppPStr SLIT("\t.long\t")) (pprImm sty x)
+           F -> uppBeside (uppPStr SLIT("\t.long\t")) (pprImm sty x)
+           D -> uppBeside (uppPStr SLIT("\t.double\t")) (pprImm sty x)
+
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[Schedule]{Register allocation information}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+
+data I386Regs = SRegs BitSet BitSet
+
+instance MachineRegisters I386Regs where
+    mkMRegs xs = SRegs (mkBS ints) (mkBS floats')
+      where
+       (ints, floats) = partition (< 8) xs
+       floats' = map (subtract 8) floats
+
+    possibleMRegs FloatKind (SRegs _ floats) = [ x + 8 | x <- listBS floats]
+    possibleMRegs DoubleKind (SRegs _ floats) = [ x + 8 | x <- listBS floats]
+    possibleMRegs _ (SRegs ints _) = listBS ints
+
+    useMReg (SRegs ints floats) n =
+       if n _LT_ ILIT(8) then SRegs (ints `minusBS` singletonBS IBOX(n)) floats
+       else SRegs ints (floats `minusBS` singletonBS (IBOX(n _SUB_ ILIT(8))))
+
+    useMRegs (SRegs ints floats) xs =
+       SRegs (ints `minusBS` ints')
+             (floats `minusBS` floats')
+      where
+        SRegs ints' floats' = mkMRegs xs
+
+    freeMReg (SRegs ints floats) n =
+       if n _LT_ ILIT(8) then SRegs (ints `unionBS` singletonBS IBOX(n)) floats
+       else SRegs ints (floats `unionBS` singletonBS (IBOX(n _SUB_ ILIT(8))))
+
+    freeMRegs (SRegs ints floats) xs =
+        SRegs (ints `unionBS` ints')
+             (floats `unionBS` floats')
+      where
+        SRegs ints' floats' = mkMRegs xs
+
+instance MachineCode I386Instr where
+    -- Alas, we don't do anything clever with our OrdLists
+--OLD:
+--  flatten = flattenOrdList
+
+    regUsage = i386RegUsage
+    regLiveness = i386RegLiveness
+    patchRegs = i386PatchRegs
+
+    -- We spill just below the stack pointer, leaving two words per spill location.
+    spillReg dyn (MemoryReg i pk) 
+      = trace "spillsave"
+        (mkUnitList (MOV (kindToSize pk) (OpReg dyn) (OpAddr (spRel (-2 * i)))))
+    loadReg (MemoryReg i pk) dyn 
+      = trace "spillload"
+        (mkUnitList (MOV (kindToSize pk) (OpAddr (spRel (-2 * i))) (OpReg dyn)))
+
+--spRel gives us a stack relative addressing mode for volatile temporaries
+--and for excess call arguments.
+
+spRel  
+    :: Int      -- desired stack offset in words, positive or negative
+    -> Addr
+spRel n = Addr (Just esp) Nothing (ImmInt (n * 4))
+
+kindToSize :: PrimKind -> Size
+kindToSize PtrKind         = L
+kindToSize CodePtrKind     = L
+kindToSize DataPtrKind     = L
+kindToSize RetKind         = L
+kindToSize InfoPtrKind     = L
+kindToSize CostCentreKind   = L
+kindToSize CharKind        = L
+kindToSize IntKind         = L
+kindToSize WordKind        = L
+kindToSize AddrKind        = L
+kindToSize FloatKind       = F
+kindToSize DoubleKind      = D
+kindToSize ArrayKind       = L
+kindToSize ByteArrayKind    = L
+kindToSize StablePtrKind    = L
+kindToSize MallocPtrKind    = L
+
+\end{code}
+
+@i386RegUsage@ returns the sets of src and destination registers used by
+a particular instruction.  Machine registers that are pre-allocated
+to stgRegs are filtered out, because they are uninteresting from a
+register allocation standpoint.  (We wouldn't want them to end up on
+the free list!)
+
+\begin{code}
+
+i386RegUsage :: I386Instr -> RegUsage
+i386RegUsage instr = case instr of
+    MOV  sz src dst    -> usage2 src dst
+    MOVZX sz src dst   -> usage2 src dst
+    MOVSX sz src dst   -> usage2 src dst
+    LEA  sz src dst    -> usage2 src dst
+    ADD  sz src dst    -> usage2 src dst
+    SUB  sz src dst    -> usage2 src dst
+    IMUL sz src dst    -> usage2 src dst
+    IDIV sz src                -> usage (eax:edx:opToReg src) [eax,edx]
+    AND  sz src dst    -> usage2 src dst
+    OR   sz src dst    -> usage2 src dst
+    XOR  sz src dst    -> usage2 src dst
+    NOT  sz op         -> usage1 op
+    NEGI sz op         -> usage1 op
+    SHL  sz imm dst    -> usage1 dst -- imm has to be an Imm
+    SAR  sz imm dst    -> usage1 dst -- imm has to be an Imm
+    SHR  sz imm dst    -> usage1 dst -- imm has to be an Imm
+    PUSH sz op         -> usage (opToReg op) []
+    POP  sz op         -> usage [] (opToReg op)
+    TEST sz src dst    -> usage (opToReg src ++ opToReg dst) []
+    CMP  sz src dst    -> usage (opToReg src ++ opToReg dst) []
+    SETCC cond op      -> usage [] (opToReg op)
+    JXX cond label     -> usage [] []
+    JMP op             -> usage (opToReg op) freeRegs
+    CALL imm           -> usage [] callClobberedRegs
+    CLTD               -> usage [eax] [edx]
+    NOP                        -> usage [] []
+    SAHF               -> usage [eax] []
+    FABS               -> usage [st0] [st0]
+    FADD sz src                -> usage (st0:opToReg src) [st0] -- allFPRegs
+    FADDP              -> usage [st0,st1] [st0] -- allFPRegs
+    FIADD sz asrc      -> usage (addrToRegs asrc) [st0]
+    FCHS               -> usage [st0] [st0]
+    FCOM sz src                -> usage (st0:opToReg src) []
+    FCOS               -> usage [st0] [st0]
+    FDIV sz src        -> usage (st0:opToReg src) [st0]
+    FDIVP              -> usage [st0,st1] [st0]
+    FDIVRP             -> usage [st0,st1] [st0]
+    FIDIV sz asrc      -> usage (addrToRegs asrc) [st0]
+    FDIVR sz src       -> usage (st0:opToReg src) [st0]
+    FIDIVR sz asrc     -> usage (addrToRegs asrc) [st0]
+    FICOM sz asrc      -> usage (addrToRegs asrc) []
+    FILD sz asrc dst   -> usage (addrToRegs asrc) [dst] -- allFPRegs
+    FIST sz adst       -> usage (st0:addrToRegs adst) []
+    FLD         sz src         -> usage (opToReg src) [st0] -- allFPRegs
+    FLD1               -> usage [] [st0] -- allFPRegs
+    FLDZ               -> usage [] [st0] -- allFPRegs
+    FMUL sz src        -> usage (st0:opToReg src) [st0]
+    FMULP              -> usage [st0,st1] [st0]
+    FIMUL sz asrc      -> usage (addrToRegs asrc) [st0]
+    FRNDINT            -> usage [st0] [st0]
+    FSIN               -> usage [st0] [st0]
+    FSQRT              -> usage [st0] [st0]
+    FST sz (OpReg r)   -> usage [st0] [r]
+    FST sz dst         -> usage (st0:opToReg dst) []
+    FSTP sz (OpReg r)  -> usage [st0] [r] -- allFPRegs
+    FSTP sz dst                -> usage (st0:opToReg dst) [] -- allFPRegs
+    FSUB sz src                -> usage (st0:opToReg src) [st0] -- allFPRegs
+    FSUBR sz src       -> usage (st0:opToReg src) [st0] -- allFPRegs
+    FISUB sz asrc      -> usage (addrToRegs asrc) [st0]
+    FSUBP              -> usage [st0,st1] [st0] -- allFPRegs
+    FSUBRP             -> usage [st0,st1] [st0] -- allFPRegs
+    FISUBR sz asrc     -> usage (addrToRegs asrc) [st0]
+    FTST               -> usage [st0] []
+    FCOMP sz op                -> usage (st0:opToReg op) [st0] -- allFPRegs
+    FUCOMPP            -> usage [st0, st1] [] --  allFPRegs
+    FXCH               -> usage [st0, st1] [st0, st1]
+    FNSTSW             -> usage [] [eax]
+    _                  -> noUsage
+
+ where
+
+    usage2 :: Operand -> Operand -> RegUsage
+    usage2 op (OpReg reg) = usage (opToReg op) [reg]
+    usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
+    usage2 op (OpImm imm) = usage (opToReg op) []
+    usage1 :: Operand -> RegUsage
+    usage1 (OpReg reg)    = usage [reg] [reg]
+    usage1 (OpAddr ea)    = usage (addrToRegs ea) []
+    allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
+    --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
+    callClobberedRegs = [eax] 
+
+-- General purpose register collecting functions.
+
+    opToReg (OpReg reg)   = [reg]
+    opToReg (OpImm imm)   = []
+    opToReg (OpAddr  ea)  = addrToRegs ea
+
+    addrToRegs (Addr base index _) = baseToReg base ++ indexToReg index
+      where  baseToReg Nothing       = []
+             baseToReg (Just r)      = [r]
+             indexToReg Nothing      = []
+             indexToReg (Just (r,_)) = [r]
+    addrToRegs (ImmAddr _ _) = []
+
+    usage src dst = RU (mkUniqSet (filter interesting src))
+                      (mkUniqSet (filter interesting dst))
+
+    interesting (FixedReg _) = False
+    interesting _ = True
+
+freeRegs :: [Reg]
+freeRegs = freeMappedRegs (\ x -> x) [0..15]
+
+freeMappedRegs :: (Int -> Int) -> [Int] -> [Reg]
+
+freeMappedRegs modify nums
+  = foldr free [] nums
+  where
+    free n acc
+      = let
+           modified_i = case (modify n) of { IBOX(x) -> x }
+       in
+       if _IS_TRUE_(freeReg modified_i) then (MappedReg modified_i) : acc else acc
+
+freeSet :: UniqSet Reg
+freeSet = mkUniqSet freeRegs
+
+noUsage :: RegUsage
+noUsage = RU emptyUniqSet emptyUniqSet
+
+endUsage :: RegUsage
+endUsage = RU emptyUniqSet freeSet
+
+\end{code}
+
+@i386RegLiveness@ takes future liveness information and modifies it according to
+the semantics of branches and labels.  (An out-of-line branch clobbers the liveness
+passed back by the following instruction; a forward local branch passes back the
+liveness from the target label; a conditional branch merges the liveness from the
+target and the liveness from its successor; a label stashes away the current liveness
+in the future liveness environment).
+
+\begin{code}
+i386RegLiveness :: I386Instr -> RegLiveness -> RegLiveness
+i386RegLiveness instr info@(RL live future@(FL all env)) = case instr of
+
+    JXX _ lbl  -> RL (lookup lbl `unionUniqSets` live) future
+    JMP _      -> RL emptyUniqSet future
+    CALL _      -> RL live future
+    LABEL lbl   -> RL live (FL (all `unionUniqSets` live) (addToFM env lbl live))
+    _              -> info
+
+  where
+    lookup lbl = case lookupFM env lbl of
+       Just regs -> regs
+       Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel (PprForAsm (\_->False) False id) lbl)) ++
+                          " in future?") emptyUniqSet
+
+\end{code}
+
+@i386PatchRegs@ takes an instruction (possibly with MemoryReg/UnmappedReg registers) and
+changes all register references according to the supplied environment.
+
+\begin{code}
+
+i386PatchRegs :: I386Instr -> (Reg -> Reg) -> I386Instr
+i386PatchRegs instr env = case instr of
+    MOV  sz src dst    -> patch2 (MOV  sz) src dst
+    MOVZX sz src dst   -> patch2 (MOVZX sz) src dst
+    MOVSX sz src dst   -> patch2 (MOVSX sz) src dst
+    LEA  sz src dst    -> patch2 (LEA  sz) src dst
+    ADD  sz src dst    -> patch2 (ADD  sz) src dst
+    SUB  sz src dst    -> patch2 (SUB  sz) src dst
+    IMUL sz src dst    -> patch2 (IMUL sz) src dst
+    IDIV sz src        -> patch1 (IDIV sz) src 
+    AND  sz src dst    -> patch2 (AND  sz) src dst
+    OR   sz src dst    -> patch2 (OR   sz) src dst
+    XOR  sz src dst    -> patch2 (XOR  sz) src dst
+    NOT  sz op                 -> patch1 (NOT  sz) op
+    NEGI sz op         -> patch1 (NEGI sz) op
+    SHL  sz imm dst    -> patch1 (SHL  sz imm) dst
+    SAR  sz imm dst    -> patch1 (SAR  sz imm) dst
+    SHR  sz imm dst    -> patch1 (SHR  sz imm) dst
+    TEST sz src dst    -> patch2 (TEST sz) src dst
+    CMP  sz src dst    -> patch2 (CMP  sz) src dst
+    PUSH sz op         -> patch1 (PUSH sz) op
+    POP  sz op         -> patch1 (POP  sz) op
+    SETCC cond op      -> patch1 (SETCC cond) op
+    JMP op             -> patch1 JMP op
+    FADD sz src                -> FADD sz (patchOp src)
+    FIADD sz asrc      -> FIADD sz (lookupAddr asrc)
+    FCOM sz src                -> patch1 (FCOM sz) src
+    FDIV sz src        -> FDIV sz (patchOp src)
+    --FDIVP sz src     -> FDIVP sz (patchOp src)
+    FIDIV sz asrc      -> FIDIV sz (lookupAddr asrc)
+    FDIVR sz src       -> FDIVR sz (patchOp src)
+    --FDIVRP sz src    -> FDIVRP sz (patchOp src)
+    FIDIVR sz asrc     -> FIDIVR sz (lookupAddr asrc)
+    FICOM sz asrc      -> FICOM sz (lookupAddr asrc)
+    FILD sz asrc dst   -> FILD sz (lookupAddr asrc) (env dst)
+    FIST sz adst       -> FIST sz (lookupAddr adst)
+    FLD        sz src          -> patch1 (FLD sz) (patchOp src)
+    FMUL sz src        -> FMUL sz (patchOp src)
+    --FMULP sz src     -> FMULP sz (patchOp src)
+    FIMUL sz asrc      -> FIMUL sz (lookupAddr asrc)
+    FST sz dst         -> FST sz (patchOp dst)
+    FSTP sz dst                -> FSTP sz (patchOp dst)
+    FSUB sz src                -> FSUB sz (patchOp src)
+    --FSUBP sz src     -> FSUBP sz (patchOp src)
+    FISUB sz asrc      -> FISUB sz (lookupAddr asrc)
+    FSUBR sz src       -> FSUBR sz (patchOp src)
+    --FSUBRP sz src    -> FSUBRP sz (patchOp src)
+    FISUBR sz asrc     -> FISUBR sz (lookupAddr asrc)
+    FCOMP sz src       -> FCOMP sz (patchOp src)
+    _                  -> instr
+       
+  where
+               patch1 insn op = insn (patchOp op)
+               patch2 insn src dst = insn (patchOp src) (patchOp dst)
+
+               patchOp (OpReg  reg) = OpReg (env reg)
+               patchOp (OpImm  imm) = OpImm imm
+               patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
+
+               lookupAddr (Addr base index disp) 
+                       = Addr (lookupBase base) (lookupIndex index) disp
+                       where lookupBase Nothing        = Nothing
+                             lookupBase (Just r)       = Just (env r)
+                             lookupIndex Nothing       = Nothing
+                             lookupIndex (Just (r,i))  = Just (env r, i)
+               lookupAddr (ImmAddr imm off) 
+                       = ImmAddr imm off
+
+\end{code}
+
+Sometimes, we want to be able to modify addresses at compile time.
+(Okay, just for chrCode of a fetch.)
+
+\begin{code}
+
+#ifdef __GLASGOW_HASKELL__
+
+{-# SPECIALIZE
+    is13Bits :: Int -> Bool
+  #-}
+{-# SPECIALIZE
+    is13Bits :: Integer -> Bool
+  #-}
+
+#endif
+
+is13Bits :: Integral a => a -> Bool
+is13Bits x = x >= -4096 && x < 4096
+
+offset :: Addr -> Int -> Maybe Addr
+offset (Addr reg index (ImmInt n)) off
+  = Just (Addr reg index (ImmInt n2))
+  where n2 = n + off
+
+offset (Addr reg index (ImmInteger n)) off
+  = Just (Addr reg index (ImmInt (fromInteger n2)))
+  where n2 = n + toInteger off
+
+offset (ImmAddr imm off1) off2
+  = Just (ImmAddr imm off3)
+  where off3 = off1 + off2
+
+offset _ _ = Nothing
+
+\end{code}
+
+If you value your sanity, do not venture below this line.
+
+\begin{code}
+
+-- platform.h is generate and tells us what the target architecture is
+#include "../../includes/platform.h"
+#define STOLEN_X86_REGS 5
+#include "../../includes/MachRegs.h"
+#include "../../includes/i386-unknown-linuxaout.h"
+
+-- Redefine the literals used for I386 register names in the header
+-- files.  Gag me with a spoon, eh?
+
+#define eax 0
+#define ebx 1
+#define ecx 2
+#define edx 3
+#define esi 4
+#define edi 5
+#define ebp 6
+#define esp 7
+#define st0 8
+#define st1 9
+#define st2 10
+#define st3 11
+#define st4 12
+#define st5 13
+#define st6 14
+#define st7 15
+#define CALLER_SAVES_Hp 
+-- ToDo: rm when we give esp back
+#define REG_Hp esp
+#define REG_R2 ecx
+
+baseRegOffset :: MagicId -> Int
+baseRegOffset StkOReg                  = OFFSET_StkO
+baseRegOffset (VanillaReg _ ILIT2(1))  = OFFSET_R1
+baseRegOffset (VanillaReg _ ILIT2(2))  = OFFSET_R2
+baseRegOffset (VanillaReg _ ILIT2(3))  = OFFSET_R3
+baseRegOffset (VanillaReg _ ILIT2(4))  = OFFSET_R4
+baseRegOffset (VanillaReg _ ILIT2(5))  = OFFSET_R5
+baseRegOffset (VanillaReg _ ILIT2(6))  = OFFSET_R6
+baseRegOffset (VanillaReg _ ILIT2(7))  = OFFSET_R7
+baseRegOffset (VanillaReg _ ILIT2(8))  = OFFSET_R8
+baseRegOffset (FloatReg ILIT2(1))      = OFFSET_Flt1
+baseRegOffset (FloatReg ILIT2(2))      = OFFSET_Flt2
+baseRegOffset (FloatReg ILIT2(3))      = OFFSET_Flt3
+baseRegOffset (FloatReg ILIT2(4))      = OFFSET_Flt4
+baseRegOffset (DoubleReg ILIT2(1))     = OFFSET_Dbl1
+baseRegOffset (DoubleReg ILIT2(2))     = OFFSET_Dbl2
+baseRegOffset TagReg                   = OFFSET_Tag
+baseRegOffset RetReg                   = OFFSET_Ret
+baseRegOffset SpA                      = OFFSET_SpA
+baseRegOffset SuA                      = OFFSET_SuA
+baseRegOffset SpB                      = OFFSET_SpB
+baseRegOffset SuB                      = OFFSET_SuB
+baseRegOffset Hp                       = OFFSET_Hp
+baseRegOffset HpLim                    = OFFSET_HpLim
+baseRegOffset LivenessReg              = OFFSET_Liveness
+--baseRegOffset ActivityReg            = OFFSET_Activity
+#ifdef DEBUG
+baseRegOffset BaseReg                  = panic "baseRegOffset:BaseReg"
+baseRegOffset StdUpdRetVecReg          = panic "baseRegOffset:StgUpdRetVecReg"
+baseRegOffset StkStubReg               = panic "baseRegOffset:StkStubReg"
+baseRegOffset CurCostCentre            = panic "baseRegOffset:CurCostCentre"
+baseRegOffset VoidReg                  = panic "baseRegOffset:VoidReg"
+#endif
+
+callerSaves :: MagicId -> Bool
+#ifdef CALLER_SAVES_Base
+callerSaves BaseReg                    = True
+#endif
+#ifdef CALLER_SAVES_StkO
+callerSaves StkOReg            = True
+#endif
+#ifdef CALLER_SAVES_R1
+callerSaves (VanillaReg _ ILIT2(1))    = True
+#endif
+#ifdef CALLER_SAVES_R2
+callerSaves (VanillaReg _ ILIT2(2))    = True
+#endif
+#ifdef CALLER_SAVES_R3
+callerSaves (VanillaReg _ ILIT2(3))    = True
+#endif
+#ifdef CALLER_SAVES_R4
+callerSaves (VanillaReg _ ILIT2(4))    = True
+#endif
+#ifdef CALLER_SAVES_R5
+callerSaves (VanillaReg _ ILIT2(5))    = True
+#endif
+#ifdef CALLER_SAVES_R6
+callerSaves (VanillaReg _ ILIT2(6))    = True
+#endif
+#ifdef CALLER_SAVES_R7
+callerSaves (VanillaReg _ ILIT2(7))    = True
+#endif
+#ifdef CALLER_SAVES_R8
+callerSaves (VanillaReg _ ILIT2(8))    = True
+#endif
+#ifdef CALLER_SAVES_FltReg1
+callerSaves (FloatReg ILIT2(1))        = True
+#endif
+#ifdef CALLER_SAVES_FltReg2
+callerSaves (FloatReg ILIT2(2))        = True
+#endif
+#ifdef CALLER_SAVES_FltReg3
+callerSaves (FloatReg ILIT2(3))        = True
+#endif
+#ifdef CALLER_SAVES_FltReg4
+callerSaves (FloatReg ILIT2(4))        = True
+#endif
+#ifdef CALLER_SAVES_DblReg1
+callerSaves (DoubleReg ILIT2(1))       = True
+#endif
+#ifdef CALLER_SAVES_DblReg2
+callerSaves (DoubleReg ILIT2(2))       = True
+#endif
+#ifdef CALLER_SAVES_Tag
+callerSaves TagReg             = True
+#endif
+#ifdef CALLER_SAVES_Ret
+callerSaves RetReg             = True
+#endif
+#ifdef CALLER_SAVES_SpA
+callerSaves SpA                        = True
+#endif
+#ifdef CALLER_SAVES_SuA
+callerSaves SuA                        = True
+#endif
+#ifdef CALLER_SAVES_SpB
+callerSaves SpB                        = True
+#endif
+#ifdef CALLER_SAVES_SuB
+callerSaves SuB                        = True
+#endif
+#ifdef CALLER_SAVES_Hp 
+callerSaves Hp                 = True
+#endif
+#ifdef CALLER_SAVES_HpLim
+callerSaves HpLim              = True
+#endif
+#ifdef CALLER_SAVES_Liveness
+callerSaves LivenessReg                = True
+#endif
+#ifdef CALLER_SAVES_Activity
+--callerSaves ActivityReg              = True
+#endif
+#ifdef CALLER_SAVES_StdUpdRetVec
+callerSaves StdUpdRetVecReg            = True
+#endif
+#ifdef CALLER_SAVES_StkStub
+callerSaves StkStubReg                 = True
+#endif
+callerSaves _                  = False
+
+stgRegMap :: MagicId -> Maybe Reg
+
+#ifdef REG_Base
+stgRegMap BaseReg         = Just (FixedReg ILIT(REG_Base))
+#endif
+#ifdef REG_StkO
+stgRegMap StkOReg         = Just (FixedReg ILIT(REG_StkOReg))
+#endif
+#ifdef REG_R1
+stgRegMap (VanillaReg _ ILIT2(1)) = Just (FixedReg ILIT(REG_R1))
+#endif
+#ifdef REG_R2
+stgRegMap (VanillaReg _ ILIT2(2)) = Just (FixedReg ILIT(REG_R2))
+#endif
+#ifdef REG_R3
+stgRegMap (VanillaReg _ ILIT2(3)) = Just (FixedReg ILIT(REG_R3))
+#endif
+#ifdef REG_R4
+stgRegMap (VanillaReg _ ILIT2(4)) = Just (FixedReg ILIT(REG_R4))
+#endif
+#ifdef REG_R5
+stgRegMap (VanillaReg _ ILIT2(5)) = Just (FixedReg ILIT(REG_R5))
+#endif
+#ifdef REG_R6
+stgRegMap (VanillaReg _ ILIT2(6)) = Just (FixedReg ILIT(REG_R6))
+#endif
+#ifdef REG_R7
+stgRegMap (VanillaReg _ ILIT2(7)) = Just (FixedReg ILIT(REG_R7))
+#endif
+#ifdef REG_R8
+stgRegMap (VanillaReg _ ILIT2(8)) = Just (FixedReg ILIT(REG_R8))
+#endif
+#ifdef REG_Flt1
+stgRegMap (FloatReg ILIT2(1))     = Just (FixedReg ILIT(REG_Flt1))
+#endif
+#ifdef REG_Flt2
+stgRegMap (FloatReg ILIT2(2))     = Just (FixedReg ILIT(REG_Flt2))
+#endif
+#ifdef REG_Flt3
+stgRegMap (FloatReg ILIT2(3))     = Just (FixedReg ILIT(REG_Flt3))
+#endif
+#ifdef REG_Flt4
+stgRegMap (FloatReg ILIT2(4))     = Just (FixedReg ILIT(REG_Flt4))
+#endif
+#ifdef REG_Dbl1
+stgRegMap (DoubleReg ILIT2(1))    = Just (FixedReg ILIT(REG_Dbl1))
+#endif
+#ifdef REG_Dbl2
+stgRegMap (DoubleReg ILIT2(2))    = Just (FixedReg ILIT(REG_Dbl2))
+#endif
+#ifdef REG_Tag
+stgRegMap TagReg          = Just (FixedReg ILIT(REG_TagReg))
+#endif
+#ifdef REG_Ret
+stgRegMap RetReg          = Just (FixedReg ILIT(REG_Ret))
+#endif
+#ifdef REG_SpA
+stgRegMap SpA             = Just (FixedReg ILIT(REG_SpA))
+#endif
+#ifdef REG_SuA
+stgRegMap SuA             = Just (FixedReg ILIT(REG_SuA))
+#endif
+#ifdef REG_SpB
+stgRegMap SpB             = Just (FixedReg ILIT(REG_SpB))
+#endif
+#ifdef REG_SuB
+stgRegMap SuB             = Just (FixedReg ILIT(REG_SuB))
+#endif
+#ifdef REG_Hp 
+stgRegMap Hp              = Just (FixedReg ILIT(REG_Hp))
+#endif
+#ifdef REG_HpLim
+stgRegMap HpLim                   = Just (FixedReg ILIT(REG_HpLim))
+#endif
+#ifdef REG_Liveness
+stgRegMap LivenessReg     = Just (FixedReg ILIT(REG_Liveness))
+#endif
+#ifdef REG_Activity
+--stgRegMap ActivityReg           = Just (FixedReg ILIT(REG_Activity))
+#endif
+#ifdef REG_StdUpdRetVec
+stgRegMap StdUpdRetVecReg  = Just (FixedReg ILIT(REG_StdUpdRetVec))
+#endif
+#ifdef REG_StkStub
+stgRegMap StkStubReg      = Just (FixedReg ILIT(REG_StkStub))
+#endif
+
+stgRegMap _               = Nothing
+
+\end{code}
+
+Here is the list of registers we can use in register allocation.
+
+\begin{code}
+freeReg :: FAST_INT -> FAST_BOOL
+
+--freeReg ILIT(esp) = _FALSE_  --      %esp is our stack pointer.
+
+#ifdef REG_Base
+freeReg ILIT(REG_Base) = _FALSE_
+#endif
+#ifdef REG_StkO
+freeReg ILIT(REG_StkO) = _FALSE_
+#endif
+#ifdef REG_R1
+freeReg ILIT(REG_R1) = _FALSE_
+#endif
+#ifdef REG_R2
+freeReg ILIT(REG_R2) = _FALSE_
+#endif
+#ifdef REG_R3
+freeReg ILIT(REG_R3) = _FALSE_
+#endif
+#ifdef REG_R4
+freeReg ILIT(REG_R4) = _FALSE_
+#endif
+#ifdef REG_R5
+freeReg ILIT(REG_R5) = _FALSE_
+#endif
+#ifdef REG_R6
+freeReg ILIT(REG_R6) = _FALSE_
+#endif
+#ifdef REG_R7
+freeReg ILIT(REG_R7) = _FALSE_
+#endif
+#ifdef REG_R8
+freeReg ILIT(REG_R8) = _FALSE_
+#endif
+#ifdef REG_Flt1
+freeReg ILIT(REG_Flt1) = _FALSE_
+#endif
+#ifdef REG_Flt2
+freeReg ILIT(REG_Flt2) = _FALSE_
+#endif
+#ifdef REG_Flt3
+freeReg ILIT(REG_Flt3) = _FALSE_
+#endif
+#ifdef REG_Flt4
+freeReg ILIT(REG_Flt4) = _FALSE_
+#endif
+#ifdef REG_Dbl1
+freeReg ILIT(REG_Dbl1) = _FALSE_
+#endif
+#ifdef REG_Dbl2
+freeReg ILIT(REG_Dbl2) = _FALSE_
+#endif
+#ifdef REG_Tag
+freeReg ILIT(REG_Tag) = _FALSE_
+#endif
+#ifdef REG_Ret
+freeReg ILIT(REG_Ret) = _FALSE_
+#endif
+#ifdef REG_SpA
+freeReg ILIT(REG_SpA) = _FALSE_
+#endif
+#ifdef REG_SuA
+freeReg ILIT(REG_SuA) = _FALSE_
+#endif
+#ifdef REG_SpB
+freeReg ILIT(REG_SpB) = _FALSE_
+#endif
+#ifdef REG_SuB
+freeReg ILIT(REG_SuB) = _FALSE_
+#endif
+#ifdef REG_Hp
+freeReg ILIT(REG_Hp) = _FALSE_
+#endif
+#ifdef REG_HpLim
+freeReg ILIT(REG_HpLim) = _FALSE_
+#endif
+#ifdef REG_Liveness
+freeReg ILIT(REG_Liveness) = _FALSE_
+#endif
+#ifdef REG_Activity
+--freeReg ILIT(REG_Activity) = _FALSE_
+#endif
+#ifdef REG_StdUpdRetVec
+freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
+#endif
+#ifdef REG_StkStub
+freeReg ILIT(REG_StkStub) = _FALSE_
+#endif
+freeReg n
+#ifdef REG_Dbl1
+  | n _EQ_ (ILIT(REG_Dbl1) _ADD_ ILIT(1)) = _FALSE_
+#endif
+#ifdef REG_Dbl2
+  | n _EQ_ (ILIT(REG_Dbl2) _ADD_ ILIT(1)) = _FALSE_
+#endif
+
+  | otherwise = _TRUE_
+
+reservedRegs :: [Int]
+reservedRegs = []
+--reservedRegs = [NCG_Reserved_I1, NCG_Reserved_I2,
+--             NCG_Reserved_F1, NCG_Reserved_F2,
+--             NCG_Reserved_D1, NCG_Reserved_D2]
+
+\end{code}
+
diff --git a/ghc/compiler/nativeGen/I386Desc.hi b/ghc/compiler/nativeGen/I386Desc.hi
new file mode 100644 (file)
index 0000000..ef711c7
--- /dev/null
@@ -0,0 +1,25 @@
+{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+interface I386Desc where
+import AbsCSyn(MagicId)
+import CLabelInfo(CLabel)
+import CharSeq(CSeq)
+import CmdLineOpts(GlobalSwitch, SwitchResult)
+import MachDesc(RegLoc, Target)
+import PreludePS(_PackedString)
+import PreludeRatio(Ratio(..))
+import Pretty(PprStyle)
+import PrimKind(PrimKind)
+import PrimOps(PrimOp)
+import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
+import SplitUniq(SplitUniqSupply)
+import Stix(CodeSegment, StixReg, StixTree)
+data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
+data RegLoc    {-# GHC_PRAGMA Save StixTree | Always StixTree #-}
+data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
+data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+mkI386 :: Bool -> (GlobalSwitch -> SwitchResult) -> (Target, PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq, Bool, [Char] -> [Char])
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+
diff --git a/ghc/compiler/nativeGen/I386Desc.lhs b/ghc/compiler/nativeGen/I386Desc.lhs
new file mode 100644 (file)
index 0000000..402cdc0
--- /dev/null
@@ -0,0 +1,204 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1995
+%
+\section[I386Desc]{The I386 Machine Description}
+
+\begin{code}
+#include "HsVersions.h"
+
+module I386Desc (
+       mkI386,
+
+       -- and assorted nonsense referenced by the class methods
+
+        PprStyle, SMRep, MagicId, RegLoc, StixTree, PrimKind, SwitchResult
+
+    ) where
+
+import AbsCSyn
+import AbsPrel     ( PrimOp(..)
+                     IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
+                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
+                   )
+import AsmRegAlloc  ( Reg, MachineCode(..), MachineRegisters(..),
+                     RegLiveness(..), RegUsage(..), FutureLive(..)
+                   )
+import CLabelInfo   ( CLabel )
+import CmdLineOpts  ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResult(..) )
+import HeapOffs            ( hpRelToInt )
+import MachDesc
+import Maybes      ( Maybe(..) )
+import OrdList
+import Outputable
+import PrimKind            ( PrimKind(..) )
+import SMRep       ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
+import I386Code
+import I386Gen     ( i386CodeGen )
+import Stix
+import StixMacro
+import StixPrim
+import SplitUniq
+import Unique
+import Util
+
+\end{code}
+
+Header sizes depend only on command-line options, not on the target
+architecture.  (I think.)
+
+\begin{code}
+
+fhs :: (GlobalSwitch -> SwitchResult) -> Int
+
+fhs switches = 1 + profFHS + ageFHS
+  where
+    profFHS = if switchIsOn switches SccProfilingOn then 1 else 0
+    ageFHS  = if switchIsOn switches SccProfilingOn then 1 else 0
+
+vhs :: (GlobalSwitch -> SwitchResult) -> SMRep -> Int
+
+vhs switches sm = case sm of
+    StaticRep _ _         -> 0
+    SpecialisedRep _ _ _ _ -> 0
+    GenericRep _ _ _      -> 0
+    BigTupleRep _         -> 1
+    MuTupleRep _          -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
+    DataRep _             -> 1
+    DynamicRep            -> 2
+    BlackHoleRep          -> 0
+    PhantomRep            -> panic "vhs:phantom"
+
+\end{code}
+
+Here we map STG registers onto appropriate Stix Trees.  First, we
+handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
+The rest are either in real machine registers or stored as offsets
+from BaseReg.
+
+\begin{code}
+
+i386Reg :: (GlobalSwitch -> SwitchResult) -> MagicId -> RegLoc
+
+i386Reg switches x =
+    case stgRegMap x of
+       Just reg -> Save nonReg
+       Nothing -> Always nonReg
+    where nonReg = case x of
+           StkStubReg -> sStLitLbl SLIT("STK_STUB_closure")
+           StdUpdRetVecReg -> sStLitLbl SLIT("vtbl_StdUpdFrame")
+           BaseReg -> sStLitLbl SLIT("MainRegTable")
+           --Hp -> StInd PtrKind (sStLitLbl SLIT("StorageMgrInfo"))
+           --HpLim -> StInd PtrKind (sStLitLbl SLIT("StorageMgrInfo+4"))
+           TagReg -> StInd IntKind (StPrim IntSubOp [infoptr, StInt (1*4)])
+                     where 
+                         r2 = VanillaReg PtrKind ILIT(2)
+                         infoptr = case i386Reg switches r2 of
+                                       Always tree -> tree
+                                       Save _ -> StReg (StixMagicId r2)
+           _ -> StInd (kindFromMagicId x)
+                      (StPrim IntAddOp [baseLoc, StInt (toInteger (offset*4))])
+         baseLoc = case stgRegMap BaseReg of
+           Just _ -> StReg (StixMagicId BaseReg)
+           Nothing -> sStLitLbl SLIT("MainRegTable")
+          offset = baseRegOffset x
+                   
+\end{code}
+
+Sizes in bytes.
+
+\begin{code}
+
+size pk = case kindToSize pk of
+    {B -> 1; S -> 2; L -> 4; F -> 4; D -> 8 }
+
+\end{code}
+
+Now the volatile saves and restores.  We add the basic guys to the list of ``user''
+registers provided.  Note that there are more basic registers on the restore list,
+because some are reloaded from constants.
+
+\begin{code}
+
+vsaves switches vols = 
+    map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-}] ++ vols))
+    where
+        save x = StAssign (kindFromMagicId x) loc reg
+                   where reg = StReg (StixMagicId x)
+                         loc = case i386Reg switches x of
+                                   Save loc -> loc
+                                   Always loc -> panic "vsaves"
+
+vrests switches vols = 
+    map restore ((filter callerSaves) 
+       ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-},StkStubReg,StdUpdRetVecReg] ++ vols))
+    where
+        restore x = StAssign (kindFromMagicId x) reg loc
+                   where reg = StReg (StixMagicId x)
+                         loc = case i386Reg switches x of
+                                   Save loc -> loc
+                                   Always loc -> panic "vrests"
+
+\end{code}
+
+Static closure sizes.
+
+\begin{code}
+
+charLikeSize, intLikeSize :: Target -> Int
+
+charLikeSize target = 
+    size PtrKind * (fixedHeaderSize target + varHeaderSize target charLikeRep + 1)
+    where charLikeRep = SpecialisedRep CharLikeRep 0 1 SMNormalForm
+
+intLikeSize target = 
+    size PtrKind * (fixedHeaderSize target + varHeaderSize target intLikeRep + 1)
+    where intLikeRep = SpecialisedRep IntLikeRep 0 1 SMNormalForm
+
+mhs, dhs :: (GlobalSwitch -> SwitchResult) -> StixTree
+
+mhs switches = StInt (toInteger words)
+  where 
+    words = fhs switches + vhs switches (MuTupleRep 0)
+
+dhs switches = StInt (toInteger words)
+  where 
+    words = fhs switches + vhs switches (DataRep 0)
+
+\end{code}
+
+Setting up a i386 target.
+
+\begin{code}
+mkI386 :: Bool
+       -> (GlobalSwitch -> SwitchResult)
+       -> (Target,
+           (PprStyle -> [[StixTree]] -> SUniqSM Unpretty), -- codeGen
+           Bool,                                           -- underscore
+           (String -> String))                             -- fmtAsmLbl
+
+mkI386 decentOS switches = 
+    let fhs' = fhs switches
+       vhs' = vhs switches
+       i386Reg' = i386Reg switches
+       vsaves' = vsaves switches
+       vrests' = vrests switches
+       hprel = hpRelToInt target 
+        as = amodeCode target
+        as' = amodeCode' target
+       csz = charLikeSize target
+       isz = intLikeSize target
+       mhs' = mhs switches
+       dhs' = dhs switches
+       ps = genPrimCode target
+       mc = genMacroCode target
+       hc = doHeapCheck --UNUSED NOW: target
+       target = mkTarget {-switches-} fhs' vhs' i386Reg' {-id-} size
+                         hprel as as'
+                         (vsaves', vrests', csz, isz, mhs', dhs', ps, mc, hc)
+                         {-i386CodeGen decentOS id-}
+    in
+    (target, i386CodeGen, decentOS, id)
+\end{code}
+            
+
+
diff --git a/ghc/compiler/nativeGen/I386Gen.hi b/ghc/compiler/nativeGen/I386Gen.hi
new file mode 100644 (file)
index 0000000..41a8681
--- /dev/null
@@ -0,0 +1,18 @@
+{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
+interface I386Gen where
+import CLabelInfo(CLabel)
+import CharSeq(CSeq)
+import CmdLineOpts(GlobalSwitch)
+import PreludePS(_PackedString)
+import PreludeRatio(Ratio(..))
+import Pretty(PprStyle)
+import PrimKind(PrimKind)
+import PrimOps(PrimOp)
+import SplitUniq(SplitUniqSupply)
+import Stix(CodeSegment, StixReg, StixTree)
+data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
+data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+i386CodeGen :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq
+       {-# GHC_PRAGMA _A_ 2 _U_ 211 _N_ _S_ "LS" _N_ _N_ #-}
+
diff --git a/ghc/compiler/nativeGen/I386Gen.lhs b/ghc/compiler/nativeGen/I386Gen.lhs
new file mode 100644 (file)
index 0000000..8f0d191
--- /dev/null
@@ -0,0 +1,1653 @@
+%
+% (c) The AQUA Project, Glasgow University, 1993-1995
+%
+
+\begin{code}
+#include "HsVersions.h"
+#include "../includes/i386-unknown-linuxaout.h"
+
+module I386Gen (
+       i386CodeGen,
+
+       -- and, for self-sufficiency
+       PprStyle, StixTree, CSeq
+    ) where
+
+IMPORT_Trace
+
+import AbsCSyn     ( AbstractC, MagicId(..), kindFromMagicId )
+import AbsPrel     ( PrimOp(..)
+                     IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
+                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
+                   )
+import AsmRegAlloc  ( runRegAllocate, mkReg, extractMappedRegNos,
+                     Reg(..), RegLiveness(..), RegUsage(..), 
+                     FutureLive(..), MachineRegisters(..), MachineCode(..)
+                   )
+import CLabelInfo   ( CLabel, isAsmTemp )
+import I386Code    {- everything -}
+import MachDesc
+import Maybes      ( maybeToBool, Maybe(..) )
+import OrdList     -- ( mkEmptyList, mkUnitList, mkSeqList, mkParList, OrdList )
+import Outputable
+import PrimKind            ( PrimKind(..), isFloatingKind )
+import I386Desc
+import Stix
+import SplitUniq
+import Unique
+import Pretty
+import Unpretty
+import Util
+
+type CodeBlock a = (OrdList a -> OrdList a)
+
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[I386CodeGen]{Generating I386 Code}
+%*                                                                     *
+%************************************************************************
+
+This is the top-level code-generation function for the I386.
+
+\begin{code}
+
+i386CodeGen :: PprStyle -> [[StixTree]] -> SUniqSM Unpretty
+i386CodeGen sty trees = 
+    mapSUs genI386Code trees           `thenSUs` \ dynamicCodes ->
+    let
+       staticCodes = scheduleI386Code dynamicCodes
+       pretty = printLabeledCodes sty staticCodes
+    in
+       returnSUs pretty
+
+\end{code}
+
+This bit does the code scheduling.  The scheduler must also deal with
+register allocation of temporaries.  Much parallelism can be exposed via
+the OrdList, but more might occur, so further analysis might be needed.
+
+\begin{code}
+
+scheduleI386Code :: [I386Code] -> [I386Instr]
+scheduleI386Code = concat . map (runRegAllocate freeI386Regs reservedRegs)
+  where
+    freeI386Regs :: I386Regs
+    freeI386Regs = mkMRegs (extractMappedRegNos freeRegs)
+
+
+\end{code}
+
+Registers passed up the tree.  If the stix code forces the register
+to live in a pre-decided machine register, it comes out as @Fixed@;
+otherwise, it comes out as @Any@, and the parent can decide which
+register to put it in.
+
+\begin{code}
+
+data Register 
+  = Fixed Reg PrimKind (CodeBlock I386Instr) 
+  | Any PrimKind (Reg -> (CodeBlock I386Instr))
+
+registerCode :: Register -> Reg -> CodeBlock I386Instr
+registerCode (Fixed _ _ code) reg = code
+registerCode (Any _ code) reg = code reg
+
+registerName :: Register -> Reg -> Reg
+registerName (Fixed reg _ _) _ = reg
+registerName (Any _ _) reg = reg
+
+registerKind :: Register -> PrimKind
+registerKind (Fixed _ pk _) = pk
+registerKind (Any pk _) = pk
+
+isFixed :: Register -> Bool
+isFixed (Fixed _ _ _) = True
+isFixed (Any _ _)     = False
+
+\end{code}
+
+Memory addressing modes passed up the tree.
+
+\begin{code}
+
+data Amode = Amode Addr (CodeBlock I386Instr)
+
+amodeAddr (Amode addr _) = addr
+amodeCode (Amode _ code) = code
+
+\end{code}
+
+Condition codes passed up the tree.
+
+\begin{code}
+
+data Condition = Condition Bool Cond (CodeBlock I386Instr)
+
+condName (Condition _ cond _) = cond
+condFloat (Condition float _ _) = float
+condCode (Condition _ _ code) = code
+
+\end{code}
+
+General things for putting together code sequences.
+
+\begin{code}
+
+asmVoid :: OrdList I386Instr
+asmVoid = mkEmptyList
+
+asmInstr :: I386Instr -> I386Code
+asmInstr i = mkUnitList i
+
+asmSeq :: [I386Instr] -> I386Code
+asmSeq is = foldr (mkSeqList . asmInstr) asmVoid is
+
+asmParThen :: [I386Code] -> (CodeBlock I386Instr)
+asmParThen others code = mkSeqList (foldr mkParList mkEmptyList others) code
+
+returnInstr :: I386Instr -> SUniqSM (CodeBlock I386Instr)
+returnInstr instr = returnSUs (\xs -> mkSeqList (asmInstr instr) xs)
+
+returnInstrs :: [I386Instr] -> SUniqSM (CodeBlock I386Instr)
+returnInstrs instrs = returnSUs (\xs -> mkSeqList (asmSeq instrs) xs)
+
+returnSeq :: (CodeBlock I386Instr) -> [I386Instr] -> SUniqSM (CodeBlock I386Instr)
+returnSeq code instrs = returnSUs (\xs -> code (mkSeqList (asmSeq instrs) xs))
+
+mkSeqInstr :: I386Instr -> (CodeBlock I386Instr)
+mkSeqInstr instr code = mkSeqList (asmInstr instr) code
+
+mkSeqInstrs :: [I386Instr] -> (CodeBlock I386Instr)
+mkSeqInstrs instrs code = mkSeqList (asmSeq instrs) code
+
+\end{code}
+
+Top level i386 code generator for a chunk of stix code.
+
+\begin{code}
+
+genI386Code :: [StixTree] -> SUniqSM (I386Code)
+
+genI386Code trees =
+    mapSUs getCode trees               `thenSUs` \ blocks ->
+    returnSUs (foldr (.) id blocks asmVoid)
+
+\end{code}
+
+Code extractor for an entire stix tree---stix statement level.
+
+\begin{code}
+
+getCode 
+    :: StixTree     -- a stix statement
+    -> SUniqSM (CodeBlock I386Instr)
+
+getCode (StSegment seg) = returnInstr (SEGMENT seg)
+
+getCode (StAssign pk dst src)
+  | isFloatingKind pk = assignFltCode pk dst src
+  | otherwise = assignIntCode pk dst src
+
+getCode (StLabel lab) = returnInstr (LABEL lab)
+
+getCode (StFunBegin lab) = returnInstr (LABEL lab)
+
+getCode (StFunEnd lab) = returnSUs id
+
+getCode (StJump arg) = genJump arg
+
+getCode (StFallThrough lbl) = returnSUs id
+
+getCode (StCondJump lbl arg) = genCondJump lbl arg
+
+getCode (StData kind args) = 
+    mapAndUnzipSUs getData args                    `thenSUs` \ (codes, imms) ->
+    returnSUs (\xs -> mkSeqList (asmInstr (DATA (kindToSize kind) imms))
+                                (foldr1 (.) codes xs))
+  where
+    getData :: StixTree -> SUniqSM (CodeBlock I386Instr, Imm)
+    getData (StInt i) = returnSUs (id, ImmInteger i)
+#if __GLASGOW_HASKELL__ >= 23
+--  getData (StDouble d) = returnSUs (id, strImmLit ('0' : 'd' : _showRational 30 d))
+    -- yurgh (WDP 94/12)
+    getData (StDouble d) = returnSUs (id, strImmLit ('0' : 'd' : ppShow 80 (ppRational d)))
+#else
+    getData (StDouble d) = returnSUs (id, strImmLit ('0' : 'd' : show d))
+#endif
+    getData (StLitLbl s) = returnSUs (id, ImmLit (uppBeside (uppChar '_') s))
+    getData (StLitLit s) = returnSUs (id, strImmLit (cvtLitLit (_UNPK_ s)))
+    getData (StString s) = 
+        getUniqLabelNCG                    `thenSUs` \ lbl ->
+       returnSUs (mkSeqInstrs [LABEL lbl, ASCII True (_UNPK_ s)], ImmCLbl lbl)
+    getData (StCLbl l)   = returnSUs (id, ImmCLbl l)
+
+getCode (StCall fn VoidKind args) = genCCall fn VoidKind args
+
+getCode (StComment s) = returnInstr (COMMENT s)
+
+\end{code}
+
+Generate code to get a subtree into a register.
+
+\begin{code}
+
+getReg :: StixTree -> SUniqSM Register
+
+getReg (StReg (StixMagicId stgreg)) =
+    case stgRegMap stgreg of
+       Just reg -> returnSUs (Fixed reg (kindFromMagicId stgreg) id)
+       -- cannot be Nothing
+
+getReg (StReg (StixTemp u pk)) = returnSUs (Fixed (UnmappedReg u pk) pk id)
+
+getReg (StDouble 0.0)
+  = let
+       code dst = mkSeqInstrs [FLDZ]
+    in
+       returnSUs (Any DoubleKind code)
+
+getReg (StDouble 1.0)
+  = let
+       code dst = mkSeqInstrs [FLD1]
+    in
+       returnSUs (Any DoubleKind code)
+
+getReg (StDouble d) =
+    getUniqLabelNCG                `thenSUs` \ lbl ->
+    --getNewRegNCG PtrKind         `thenSUs` \ tmp ->
+    let code dst = mkSeqInstrs [
+           SEGMENT DataSegment,
+           LABEL lbl,
+#if __GLASGOW_HASKELL__ >= 23
+--         DATA D [strImmLit ('0' : 'd' :_showRational 30 d)],
+           DATA D [strImmLit ('0' : 'd' :ppShow 80 (ppRational d))],
+#else
+           DATA D [strImmLit ('0' : 'd' :show d)],
+#endif
+           SEGMENT TextSegment,
+           FLD D (OpImm (ImmCLbl lbl)) 
+            ]
+    in
+       returnSUs (Any DoubleKind code)
+
+getReg (StString s) =
+    getUniqLabelNCG                `thenSUs` \ lbl ->
+    let code dst = mkSeqInstrs [
+           SEGMENT DataSegment,
+           LABEL lbl,
+           ASCII True (_UNPK_ s),
+           SEGMENT TextSegment,
+           MOV L (OpImm (ImmCLbl lbl)) (OpReg dst)]
+    in
+       returnSUs (Any PtrKind code)
+
+getReg (StLitLit s) | _HEAD_ s == '"' && last xs == '"' =
+    getUniqLabelNCG                `thenSUs` \ lbl ->
+    let code dst = mkSeqInstrs [
+           SEGMENT DataSegment,
+           LABEL lbl,
+           ASCII False (init xs),
+           SEGMENT TextSegment,
+           MOV L (OpImm (ImmCLbl lbl)) (OpReg dst)]
+    in
+       returnSUs (Any PtrKind code)
+  where
+    xs = _UNPK_ (_TAIL_ s)
+
+
+getReg tree@(StIndex _ _ _) = getReg (mangleIndexTree tree)
+
+getReg (StCall fn kind args) = 
+    genCCall fn kind args          `thenSUs` \ call ->
+    returnSUs (Fixed reg kind call)
+  where
+    reg = if isFloatingKind kind then st0 else eax
+
+getReg (StPrim primop args) = 
+    case primop of
+
+       CharGtOp -> condIntReg GT args
+       CharGeOp -> condIntReg GE args
+       CharEqOp -> condIntReg EQ args
+       CharNeOp -> condIntReg NE args
+       CharLtOp -> condIntReg LT args
+       CharLeOp -> condIntReg LE args
+
+       IntAddOp -> -- this should be optimised by the generic Opts, 
+                    -- I don't know why it is not (sometimes)!
+                    case args of 
+                      [x, StInt 0] -> getReg x
+                      _ -> addCode L args
+
+       IntSubOp -> subCode L args
+       IntMulOp -> trivialCode (IMUL L) args True
+       IntQuotOp -> divCode L args True -- division
+       IntRemOp -> divCode L args False -- remainder
+       IntNegOp -> trivialUCode (NEGI L) args
+       IntAbsOp -> absIntCode args
+   
+       AndOp -> trivialCode (AND L) args True
+       OrOp  -> trivialCode (OR L) args True
+       NotOp -> trivialUCode (NOT L) args
+       SllOp -> trivialCode (SHL L) args False
+       SraOp -> trivialCode (SAR L) args False
+       SrlOp -> trivialCode (SHR L) args False
+       ISllOp -> panic "I386Gen:isll"
+       ISraOp -> panic "I386Gen:isra"
+       ISrlOp -> panic "I386Gen:isrl"
+   
+       IntGtOp -> condIntReg GT args
+       IntGeOp -> condIntReg GE args
+       IntEqOp -> condIntReg EQ args
+       IntNeOp -> condIntReg NE args
+       IntLtOp -> condIntReg LT args
+       IntLeOp -> condIntReg LE args
+   
+       WordGtOp -> condIntReg GU args
+       WordGeOp -> condIntReg GEU args
+       WordEqOp -> condIntReg EQ args
+       WordNeOp -> condIntReg NE args
+       WordLtOp -> condIntReg LU args
+       WordLeOp -> condIntReg LEU args
+
+       AddrGtOp -> condIntReg GU args
+       AddrGeOp -> condIntReg GEU args
+       AddrEqOp -> condIntReg EQ args
+       AddrNeOp -> condIntReg NE args
+       AddrLtOp -> condIntReg LU args
+       AddrLeOp -> condIntReg LEU args
+
+       FloatAddOp -> trivialFCode FloatKind FADD FADD FADDP FADDP args
+       FloatSubOp -> trivialFCode FloatKind FSUB FSUBR FSUBP FSUBRP args
+       FloatMulOp -> trivialFCode FloatKind FMUL FMUL FMULP FMULP args
+       FloatDivOp -> trivialFCode FloatKind FDIV FDIVR FDIVP FDIVRP args
+       FloatNegOp -> trivialUFCode FloatKind FCHS args
+
+       FloatGtOp -> condFltReg GT args
+       FloatGeOp -> condFltReg GE args
+       FloatEqOp -> condFltReg EQ args
+       FloatNeOp -> condFltReg NE args
+       FloatLtOp -> condFltReg LT args
+       FloatLeOp -> condFltReg LE args
+
+       FloatExpOp -> promoteAndCall SLIT("exp") DoubleKind
+       FloatLogOp -> promoteAndCall SLIT("log") DoubleKind
+       FloatSqrtOp -> trivialUFCode FloatKind FSQRT args
+       
+       FloatSinOp -> promoteAndCall SLIT("sin") DoubleKind 
+                      --trivialUFCode FloatKind FSIN args
+       FloatCosOp -> promoteAndCall SLIT("cos") DoubleKind 
+                      --trivialUFCode FloatKind FCOS args
+       FloatTanOp -> promoteAndCall SLIT("tan") DoubleKind
+       
+       FloatAsinOp -> promoteAndCall SLIT("asin") DoubleKind
+       FloatAcosOp -> promoteAndCall SLIT("acos") DoubleKind
+       FloatAtanOp -> promoteAndCall SLIT("atan") DoubleKind
+       
+       FloatSinhOp -> promoteAndCall SLIT("sinh") DoubleKind
+       FloatCoshOp -> promoteAndCall SLIT("cosh") DoubleKind
+       FloatTanhOp -> promoteAndCall SLIT("tanh") DoubleKind
+       
+       FloatPowerOp -> promoteAndCall SLIT("pow") DoubleKind
+
+       DoubleAddOp -> trivialFCode DoubleKind FADD FADD FADDP FADDP args
+       DoubleSubOp -> trivialFCode DoubleKind FSUB FSUBR FSUBP FSUBRP args
+       DoubleMulOp -> trivialFCode DoubleKind FMUL FMUL FMULP FMULP args
+       DoubleDivOp -> trivialFCode DoubleKind FDIV FDIVR FDIVP FDIVRP args
+       DoubleNegOp -> trivialUFCode DoubleKind FCHS args
+   
+       DoubleGtOp -> condFltReg GT args
+       DoubleGeOp -> condFltReg GE args
+       DoubleEqOp -> condFltReg EQ args
+       DoubleNeOp -> condFltReg NE args
+       DoubleLtOp -> condFltReg LT args
+       DoubleLeOp -> condFltReg LE args
+
+       DoubleExpOp -> call SLIT("exp") DoubleKind
+       DoubleLogOp -> call SLIT("log") DoubleKind
+       DoubleSqrtOp -> trivialUFCode DoubleKind FSQRT args
+
+       DoubleSinOp -> call SLIT("sin") DoubleKind
+                       --trivialUFCode DoubleKind FSIN args
+       DoubleCosOp -> call SLIT("cos") DoubleKind
+                       --trivialUFCode DoubleKind FCOS args
+       DoubleTanOp -> call SLIT("tan") DoubleKind
+       
+       DoubleAsinOp -> call SLIT("asin") DoubleKind
+       DoubleAcosOp -> call SLIT("acos") DoubleKind
+       DoubleAtanOp -> call SLIT("atan") DoubleKind
+       
+       DoubleSinhOp -> call SLIT("sinh") DoubleKind
+       DoubleCoshOp -> call SLIT("cosh") DoubleKind
+       DoubleTanhOp -> call SLIT("tanh") DoubleKind
+       
+       DoublePowerOp -> call SLIT("pow") DoubleKind
+
+       OrdOp -> coerceIntCode IntKind args
+       ChrOp -> chrCode args
+
+       Float2IntOp -> coerceFP2Int args
+       Int2FloatOp -> coerceInt2FP FloatKind args
+       Double2IntOp -> coerceFP2Int args
+       Int2DoubleOp -> coerceInt2FP DoubleKind args
+
+       Double2FloatOp -> coerceFltCode args
+       Float2DoubleOp -> coerceFltCode args
+
+  where
+    call fn pk = getReg (StCall fn pk args)
+    promoteAndCall fn pk = getReg (StCall fn pk (map promote args))
+      where
+        promote x = StPrim Float2DoubleOp [x]
+
+getReg (StInd pk mem) =
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code = amodeCode amode
+       src   = amodeAddr amode
+       size = kindToSize pk
+       code__2 dst = code . 
+                      if pk == DoubleKind || pk == FloatKind
+                      then mkSeqInstr (FLD {-D-} size (OpAddr src))
+                      else mkSeqInstr (MOV size (OpAddr src) (OpReg dst))
+    in
+       returnSUs (Any pk code__2)
+
+
+getReg (StInt i)
+  = let
+       src = ImmInt (fromInteger i)
+       code dst = mkSeqInstr (MOV L (OpImm src) (OpReg dst))
+    in
+       returnSUs (Any IntKind code)
+
+getReg leaf
+  | maybeToBool imm =
+    let
+       code dst = mkSeqInstr (MOV L (OpImm imm__2) (OpReg dst)) 
+    in
+       returnSUs (Any PtrKind code)
+  where
+    imm = maybeImm leaf
+    imm__2 = case imm of Just x -> x
+
+\end{code}
+
+Now, given a tree (the argument to an StInd) that references memory,
+produce a suitable addressing mode.
+
+\begin{code}
+
+getAmode :: StixTree -> SUniqSM Amode
+
+getAmode tree@(StIndex _ _ _) = getAmode (mangleIndexTree tree)
+
+getAmode (StPrim IntSubOp [x, StInt i])
+  =
+    getNewRegNCG PtrKind           `thenSUs` \ tmp ->
+    getReg x                       `thenSUs` \ register ->
+    let
+       code = registerCode register tmp
+       reg  = registerName register tmp
+       off  = ImmInt (-(fromInteger i))
+    in
+       returnSUs (Amode (Addr (Just reg) Nothing off) code)
+
+getAmode (StPrim IntAddOp [x, StInt i])
+  | maybeToBool imm 
+  = let
+        code = mkSeqInstrs []
+    in
+       returnSUs (Amode (ImmAddr imm__2 (fromInteger i)) code)
+  where
+    imm = maybeImm x
+    imm__2 = case imm of Just x -> x
+
+getAmode (StPrim IntAddOp [x, StInt i])
+  =
+    getNewRegNCG PtrKind           `thenSUs` \ tmp ->
+    getReg x                       `thenSUs` \ register ->
+    let
+       code = registerCode register tmp
+       reg  = registerName register tmp
+       off  = ImmInt (fromInteger i)
+    in
+       returnSUs (Amode (Addr (Just reg) Nothing off) code)
+
+getAmode (StPrim IntAddOp [x, y]) =
+    getNewRegNCG PtrKind           `thenSUs` \ tmp1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    getReg x                       `thenSUs` \ register1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    let
+       code1 = registerCode register1 tmp1 asmVoid
+       reg1  = registerName register1 tmp1
+       code2 = registerCode register2 tmp2 asmVoid
+       reg2  = registerName register2 tmp2
+       code__2 = asmParThen [code1, code2]
+    in
+       returnSUs (Amode (Addr (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
+
+getAmode leaf
+  | maybeToBool imm =
+    let code = mkSeqInstrs []
+    in
+        returnSUs (Amode (ImmAddr imm__2 0) code)
+  where
+    imm = maybeImm leaf
+    imm__2 = case imm of Just x -> x
+
+getAmode other =
+    getNewRegNCG PtrKind           `thenSUs` \ tmp ->
+    getReg other                   `thenSUs` \ register ->
+    let
+       code = registerCode register tmp
+       reg  = registerName register tmp
+       off  = Nothing
+    in
+       returnSUs (Amode (Addr (Just reg) Nothing (ImmInt 0)) code)
+
+\end{code}
+
+\begin{code}
+getOp
+    :: StixTree        
+    -> SUniqSM (CodeBlock I386Instr,Operand, Size)     -- code, operator, size
+getOp (StInt i)
+  = returnSUs (asmParThen [], OpImm (ImmInt (fromInteger i)), L)
+
+getOp (StInd pk mem)
+  = getAmode mem                   `thenSUs` \ amode ->
+    let
+       code = amodeCode amode --asmVoid
+       addr  = amodeAddr amode
+       sz = kindToSize pk
+    in returnSUs (code, OpAddr addr, sz)
+
+getOp op
+  = getReg op                      `thenSUs` \ register ->
+    getNewRegNCG (registerKind register)
+                                   `thenSUs` \ tmp ->
+    let 
+       code = registerCode register tmp
+       reg = registerName register tmp
+       pk = registerKind register
+       sz = kindToSize pk
+    in
+       returnSUs (code, OpReg reg, sz)
+
+getOpRI
+    :: StixTree        
+    -> SUniqSM (CodeBlock I386Instr,Operand, Size)     -- code, operator, size
+getOpRI op
+  | maybeToBool imm
+  = returnSUs (asmParThen [], OpImm imm_op, L)
+  where
+    imm = maybeImm op
+    imm_op = case imm of Just x -> x
+
+getOpRI op
+  = getReg op                      `thenSUs` \ register ->
+    getNewRegNCG (registerKind register)
+                                   `thenSUs` \ tmp ->
+    let 
+       code = registerCode register tmp
+       reg = registerName register tmp
+       pk = registerKind register
+       sz = kindToSize pk
+    in
+       returnSUs (code, OpReg reg, sz)
+
+\end{code}
+
+Set up a condition code for a conditional branch.
+
+\begin{code}
+
+getCondition :: StixTree -> SUniqSM Condition
+
+getCondition (StPrim primop args) = 
+    case primop of
+
+       CharGtOp -> condIntCode GT args
+       CharGeOp -> condIntCode GE args
+       CharEqOp -> condIntCode EQ args
+       CharNeOp -> condIntCode NE args
+       CharLtOp -> condIntCode LT args
+       CharLeOp -> condIntCode LE args
+
+       IntGtOp -> condIntCode GT args
+       IntGeOp -> condIntCode GE args
+       IntEqOp -> condIntCode EQ args
+       IntNeOp -> condIntCode NE args
+       IntLtOp -> condIntCode LT args
+       IntLeOp -> condIntCode LE args
+   
+       WordGtOp -> condIntCode GU args
+       WordGeOp -> condIntCode GEU args
+       WordEqOp -> condIntCode EQ args
+       WordNeOp -> condIntCode NE args
+       WordLtOp -> condIntCode LU args
+       WordLeOp -> condIntCode LEU args
+
+       AddrGtOp -> condIntCode GU args
+       AddrGeOp -> condIntCode GEU args
+       AddrEqOp -> condIntCode EQ args
+       AddrNeOp -> condIntCode NE args
+       AddrLtOp -> condIntCode LU args
+       AddrLeOp -> condIntCode LEU args
+
+       FloatGtOp -> condFltCode GT args
+       FloatGeOp -> condFltCode GE args
+       FloatEqOp -> condFltCode EQ args
+       FloatNeOp -> condFltCode NE args
+       FloatLtOp -> condFltCode LT args
+       FloatLeOp -> condFltCode LE args
+
+       DoubleGtOp -> condFltCode GT args
+       DoubleGeOp -> condFltCode GE args
+       DoubleEqOp -> condFltCode EQ args
+       DoubleNeOp -> condFltCode NE args
+       DoubleLtOp -> condFltCode LT args
+       DoubleLeOp -> condFltCode LE args
+
+\end{code}
+
+Turn a boolean expression into a condition, to be passed
+back up the tree.
+
+\begin{code}
+
+condIntCode, condFltCode :: Cond -> [StixTree] -> SUniqSM Condition
+condIntCode cond [StInd _ x, y] 
+  | maybeToBool imm
+  = getAmode x                     `thenSUs` \ amode ->
+    let
+       code1 = amodeCode amode asmVoid
+       y__2  = amodeAddr amode
+       code__2 = asmParThen [code1] . 
+                 mkSeqInstr (CMP L (OpImm imm__2) (OpAddr y__2))
+    in
+        returnSUs (Condition False cond code__2)
+  where
+    imm = maybeImm y
+    imm__2 = case imm of Just x -> x
+
+condIntCode cond [x, StInt 0] 
+  = getReg x                       `thenSUs` \ register1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    let
+        code1 = registerCode register1 tmp1 asmVoid
+        src1  = registerName register1 tmp1
+        code__2 = asmParThen [code1] . 
+               mkSeqInstr (TEST L (OpReg src1) (OpReg src1))
+    in
+        returnSUs (Condition False cond code__2)
+
+condIntCode cond [x, y] 
+  | maybeToBool imm
+  = getReg x                       `thenSUs` \ register1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    let
+        code1 = registerCode register1 tmp1 asmVoid
+        src1  = registerName register1 tmp1
+        code__2 = asmParThen [code1] . 
+               mkSeqInstr (CMP L (OpImm imm__2) (OpReg src1))
+    in
+        returnSUs (Condition False cond code__2)
+  where
+    imm = maybeImm y
+    imm__2 = case imm of Just x -> x
+
+condIntCode cond [StInd _ x, y] 
+  = getAmode x                     `thenSUs` \ amode ->
+    getReg y                       `thenSUs` \ register2 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    let
+       code1 = amodeCode amode asmVoid
+       src1  = amodeAddr amode
+        code2 = registerCode register2 tmp2 asmVoid
+        src2  = registerName register2 tmp2
+       code__2 = asmParThen [code1, code2] . 
+                 mkSeqInstr (CMP L (OpReg src2) (OpAddr src1))
+    in
+        returnSUs (Condition False cond code__2)
+
+condIntCode cond [y, StInd _ x] 
+  = getAmode x                     `thenSUs` \ amode ->
+    getReg y                       `thenSUs` \ register2 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    let
+       code1 = amodeCode amode asmVoid
+       src1  = amodeAddr amode
+        code2 = registerCode register2 tmp2 asmVoid
+        src2  = registerName register2 tmp2
+       code__2 = asmParThen [code1, code2] . 
+                 mkSeqInstr (CMP L (OpAddr src1) (OpReg src2))
+    in
+        returnSUs (Condition False cond code__2)
+
+condIntCode cond [x, y] =
+    getReg x                       `thenSUs` \ register1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    let
+        code1 = registerCode register1 tmp1 asmVoid
+        src1  = registerName register1 tmp1
+        code2 = registerCode register2 tmp2 asmVoid
+        src2  = registerName register2 tmp2
+        code__2 = asmParThen [code1, code2] . 
+               mkSeqInstr (CMP L (OpReg src2) (OpReg src1))
+    in
+        returnSUs (Condition False cond code__2)
+
+condFltCode cond [x, StDouble 0.0] =
+    getReg x                       `thenSUs` \ register1 ->
+    getNewRegNCG (registerKind register1)
+                                   `thenSUs` \ tmp1 ->
+    let
+       pk1   = registerKind register1
+       code1 = registerCode register1 tmp1
+       src1  = registerName register1 tmp1
+
+       code__2 = asmParThen [code1 asmVoid] .
+                 mkSeqInstrs [FTST, FSTP D (OpReg st0), -- or FLDZ, FUCOMPP ?
+                               FNSTSW,
+                               --AND HB (OpImm (ImmInt 68)) (OpReg eax),
+                               --XOR HB (OpImm (ImmInt 64)) (OpReg eax)
+                               SAHF
+                              ]
+    in
+       returnSUs (Condition True (fixFPCond cond) code__2)
+
+condFltCode cond [x, y] =
+    getReg x                       `thenSUs` \ register1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    getNewRegNCG (registerKind register1)
+                                   `thenSUs` \ tmp1 ->
+    getNewRegNCG (registerKind register2)
+                                   `thenSUs` \ tmp2 ->
+    let
+       pk1   = registerKind register1
+       code1 = registerCode register1 tmp1
+       src1  = registerName register1 tmp1
+
+       code2 = registerCode register2 tmp2
+       src2  = registerName register2 tmp2
+
+       code__2 = asmParThen [code2 asmVoid, code1 asmVoid] .
+                 mkSeqInstrs [FUCOMPP,
+                               FNSTSW,
+                               --AND HB (OpImm (ImmInt 68)) (OpReg eax),
+                               --XOR HB (OpImm (ImmInt 64)) (OpReg eax)
+                               SAHF
+                              ]
+    in
+       returnSUs (Condition True (fixFPCond cond) code__2)
+
+\end{code}
+
+Turn those condition codes into integers now (when they appear on
+the right hand side of an assignment).
+
+\begin{code}
+
+condIntReg :: Cond -> [StixTree] -> SUniqSM Register
+condIntReg cond args =
+    condIntCode cond args          `thenSUs` \ condition ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp ->
+    --getReg dst                           `thenSUs` \ register ->
+    let 
+       --code2 = registerCode register tmp asmVoid
+       --dst__2  = registerName register tmp
+        code = condCode condition
+        cond = condName condition
+-- ToDo: if dst is eax, ebx, ecx, or edx we would not need the move.
+        code__2 dst = code . mkSeqInstrs [
+           SETCC cond (OpReg tmp),
+           AND L (OpImm (ImmInt 1)) (OpReg tmp),
+           MOV L (OpReg tmp) (OpReg dst)] 
+    in
+        returnSUs (Any IntKind code__2)
+
+condFltReg :: Cond -> [StixTree] -> SUniqSM Register
+
+condFltReg cond args =
+    getUniqLabelNCG                `thenSUs` \ lbl1 ->
+    getUniqLabelNCG                `thenSUs` \ lbl2 ->
+    condFltCode cond args          `thenSUs` \ condition ->
+    let
+       code = condCode condition
+       cond = condName condition
+       code__2 dst = code . mkSeqInstrs [
+           JXX cond lbl1, 
+           MOV L (OpImm (ImmInt 0)) (OpReg dst),
+           JXX ALWAYS lbl2,
+           LABEL lbl1,
+           MOV L (OpImm (ImmInt 1)) (OpReg dst),
+           LABEL lbl2]
+    in
+        returnSUs (Any IntKind code__2)
+
+\end{code}
+
+Assignments are really at the heart of the whole code generation business.
+Almost all top-level nodes of any real importance are assignments, which
+correspond to loads, stores, or register transfers.  If we're really lucky,
+some of the register transfers will go away, because we can use the destination
+register to complete the code generation for the right hand side.  This only
+fails when the right hand side is forced into a fixed register (e.g. the result
+of a call).  
+
+\begin{code}
+
+assignIntCode :: PrimKind -> StixTree -> StixTree -> SUniqSM (CodeBlock I386Instr)
+assignIntCode pk (StInd _ dst) src 
+  = getAmode dst                   `thenSUs` \ amode ->
+    getOpRI src                     `thenSUs` \ (codesrc, opsrc, sz) ->
+    let 
+       code1 = amodeCode amode asmVoid
+       dst__2  = amodeAddr amode
+       code__2 = asmParThen [code1, codesrc asmVoid] . 
+                  mkSeqInstr (MOV sz opsrc (OpAddr dst__2))
+    in
+       returnSUs code__2
+
+assignIntCode pk dst (StInd _ src) =
+    getNewRegNCG IntKind           `thenSUs` \ tmp ->
+    getAmode src                   `thenSUs` \ amode ->
+    getReg dst                     `thenSUs` \ register ->
+    let 
+       code1 = amodeCode amode asmVoid
+       src__2  = amodeAddr amode
+       code2 = registerCode register tmp asmVoid
+       dst__2  = registerName register tmp
+       sz    = kindToSize pk
+       code__2 = asmParThen [code1, code2] . 
+                  mkSeqInstr (MOV sz (OpAddr src__2) (OpReg dst__2))
+    in
+       returnSUs code__2
+
+assignIntCode pk dst src =
+    getReg dst                     `thenSUs` \ register1 ->
+    getReg src                     `thenSUs` \ register2 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp ->
+    let 
+       dst__2 = registerName register1 tmp
+       code = registerCode register2 dst__2
+       src__2 = registerName register2 dst__2
+       code__2 = if isFixed register2 && dst__2 /= src__2
+                 then code . mkSeqInstr (MOV L (OpReg src__2) (OpReg dst__2))
+                 else 
+                       code
+    in
+       returnSUs code__2
+
+assignFltCode :: PrimKind -> StixTree -> StixTree -> SUniqSM (CodeBlock I386Instr)
+assignFltCode pk (StInd pk_dst dst) (StInd pk_src src) 
+  = getNewRegNCG IntKind                   `thenSUs` \ tmp ->
+    getAmode src                   `thenSUs` \ amodesrc ->
+    getAmode dst                   `thenSUs` \ amodedst ->
+    --getReg src                           `thenSUs` \ register ->
+    let 
+       codesrc1 = amodeCode amodesrc asmVoid
+       addrsrc1 = amodeAddr amodesrc
+       codedst1 = amodeCode amodedst asmVoid
+       addrdst1 = amodeAddr amodedst
+       addrsrc2 = case (offset addrsrc1 4) of Just x -> x
+       addrdst2 = case (offset addrdst1 4) of Just x -> x
+
+       code__2 = asmParThen [codesrc1, codedst1] . 
+                 mkSeqInstrs ([MOV L (OpAddr addrsrc1) (OpReg tmp),
+                               MOV L (OpReg tmp) (OpAddr addrdst1)]
+                               ++
+                              if pk == DoubleKind 
+                               then [MOV L (OpAddr addrsrc2) (OpReg tmp),
+                                    MOV L (OpReg tmp) (OpAddr addrdst2)]
+                               else [])
+    in
+        returnSUs code__2
+
+assignFltCode pk (StInd _ dst) src =
+    --getNewRegNCG pk              `thenSUs` \ tmp ->
+    getAmode dst                   `thenSUs` \ amode ->
+    getReg src                     `thenSUs` \ register ->
+    let 
+       sz    = kindToSize pk
+       dst__2  = amodeAddr amode
+
+       code1 = amodeCode amode asmVoid
+       code2 = registerCode register {-tmp-}st0 asmVoid
+
+       --src__2  = registerName register tmp
+       pk__2  = registerKind register
+       sz__2 = kindToSize pk__2
+
+       code__2 = asmParThen [code1, code2] . 
+                 mkSeqInstr (FSTP sz (OpAddr dst__2))
+    in
+        returnSUs code__2
+
+assignFltCode pk dst src =
+    getReg dst                     `thenSUs` \ register1 ->
+    getReg src                     `thenSUs` \ register2 ->
+    --getNewRegNCG (registerKind register2)
+    --                             `thenSUs` \ tmp ->
+    let 
+       sz = kindToSize pk
+       dst__2 = registerName register1 st0 --tmp
+
+       code = registerCode register2 dst__2
+       src__2 = registerName register2 dst__2
+
+       code__2 = code 
+    in
+       returnSUs code__2
+
+\end{code} 
+
+Generating an unconditional branch.  We accept two types of targets:
+an immediate CLabel or a tree that gets evaluated into a register.
+Any CLabels which are AsmTemporaries are assumed to be in the local
+block of code, close enough for a branch instruction.  Other CLabels
+are assumed to be far away, so we use call.
+
+Do not fill the delay slots here; you will confuse the register allocator.
+
+\begin{code}
+
+genJump 
+    :: StixTree     -- the branch target
+    -> SUniqSM (CodeBlock I386Instr)
+
+{-
+genJump (StCLbl lbl) 
+  | isAsmTemp lbl = returnInstrs [JXX ALWAYS lbl]
+  | otherwise     = returnInstrs [JMP (OpImm target)]
+  where
+    target = ImmCLbl lbl
+-}
+
+genJump (StInd pk mem) =
+    getAmode mem                   `thenSUs` \ amode ->
+    let
+       code = amodeCode amode
+       target  = amodeAddr amode
+    in
+       returnSeq code [JMP (OpAddr target)]
+
+genJump tree 
+  | maybeToBool imm
+  = returnInstr (JMP (OpImm target))
+  where
+    imm = maybeImm tree
+    target = case imm of Just x -> x
+
+
+genJump tree =
+    getReg tree                            `thenSUs` \ register ->
+    getNewRegNCG PtrKind           `thenSUs` \ tmp ->
+    let
+       code = registerCode register tmp
+       target = registerName register tmp
+    in
+       returnSeq code [JMP (OpReg target)]
+
+\end{code}
+
+Conditional jumps are always to local labels, so we can use
+branch instructions.  First, we have to ensure that the condition
+codes are set according to the supplied comparison operation.
+
+\begin{code}
+
+genCondJump 
+    :: CLabel      -- the branch target
+    -> StixTree     -- the condition on which to branch
+    -> SUniqSM (CodeBlock I386Instr)
+
+genCondJump lbl bool = 
+    getCondition bool                      `thenSUs` \ condition ->
+    let
+       code = condCode condition
+       cond = condName condition
+        target = ImmCLbl lbl    
+    in
+        returnSeq code [JXX cond lbl]
+
+\end{code}
+
+\begin{code}
+
+genCCall
+    :: FAST_STRING  -- function to call
+    -> PrimKind            -- type of the result
+    -> [StixTree]   -- arguments (of mixed type)
+    -> SUniqSM (CodeBlock I386Instr)
+
+genCCall fn kind [StInt i] 
+  | fn == SLIT ("PerformGC_wrapper")
+  = getUniqLabelNCG                        `thenSUs` \ lbl ->
+    let
+        call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
+                MOV L (OpImm (ImmCLbl lbl)) 
+                      -- this is hardwired
+                      (OpAddr (Addr (Just ebx) Nothing (ImmInt 104))),
+                JMP (OpImm (ImmLit (uppPStr (SLIT ("_PerformGC_wrapper"))))),
+                LABEL lbl]
+    in
+       returnInstrs call
+
+genCCall fn kind args =
+    mapSUs getCallArg args `thenSUs` \ argCode ->
+    let
+        nargs = length args
+        code1 = asmParThen [asmSeq [ -- MOV L (OpReg esp) (OpAddr (Addr (Just ebx) Nothing (ImmInt 80))),
+                        MOV L (OpAddr (Addr (Just ebx) Nothing (ImmInt 100))) (OpReg esp)
+                                   ]
+                           ]
+        code2 = asmParThen (map ($ asmVoid) (reverse argCode)) 
+        call = [CALL (ImmLit fn__2) -- ,
+                -- ADD L (OpImm (ImmInt (nargs * 4))) (OpReg esp),
+                -- MOV L (OpAddr (Addr (Just ebx) Nothing (ImmInt 80))) (OpReg esp)
+                ]
+    in
+       returnSeq (code1 . code2) call
+  where
+    -- function names that begin with '.' are assumed to be special internally
+    -- generated names like '.mul,' which don't get an underscore prefix
+    fn__2 = case (_HEAD_ fn) of
+             '.' -> uppPStr fn
+             _   -> uppBeside (uppChar '_') (uppPStr fn)
+
+    getCallArg 
+        :: StixTree                            -- Current argument
+        -> SUniqSM (CodeBlock I386Instr)       -- code
+    getCallArg arg = 
+        getOp arg                          `thenSUs` \ (code, op, sz) ->
+        returnSUs (code . mkSeqInstr (PUSH sz op))
+\end{code}
+
+Trivial (dyadic) instructions.  Only look for constants on the right hand
+side, because that's where the generic optimizer will have put them.
+
+\begin{code}
+
+trivialCode 
+    :: (Operand -> Operand -> I386Instr) 
+    -> [StixTree]
+    -> Bool    -- is the instr commutative?
+    -> SUniqSM Register
+
+trivialCode instr [x, y] _
+  | maybeToBool imm
+  = getReg x                       `thenSUs` \ register1 ->
+    --getNewRegNCG IntKind         `thenSUs` \ tmp1 ->
+    let
+       fixedname  = registerName register1 eax
+       code__2 dst = let code1 = registerCode register1 dst 
+                         src1  = registerName register1 dst
+                      in code1 .
+                         if isFixed register1 && src1 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
+                                           instr (OpImm imm__2) (OpReg dst)]
+                         else 
+                                mkSeqInstrs [instr (OpImm imm__2) (OpReg src1)]
+    in
+       returnSUs (Any IntKind code__2)
+  where
+    imm = maybeImm y
+    imm__2 = case imm of Just x -> x
+
+trivialCode instr [x, y] _
+  | maybeToBool imm
+  = getReg y                       `thenSUs` \ register1 ->
+    --getNewRegNCG IntKind         `thenSUs` \ tmp1 ->
+    let
+       fixedname  = registerName register1 eax
+       code__2 dst = let code1 = registerCode register1 dst
+                          src1  = registerName register1 dst
+                      in code1 .
+                         if isFixed register1 && src1 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
+                                           instr (OpImm imm__2) (OpReg dst)]
+                         else 
+                                mkSeqInstr (instr (OpImm imm__2) (OpReg src1))
+    in
+       returnSUs (Any IntKind code__2)
+  where
+    imm = maybeImm x
+    imm__2 = case imm of Just x -> x
+
+trivialCode instr [x, StInd pk mem] _
+  = getReg x                       `thenSUs` \ register ->
+    --getNewRegNCG IntKind         `thenSUs` \ tmp ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let
+       fixedname  = registerName register eax
+       code2 = amodeCode amode asmVoid
+       src2  = amodeAddr amode
+       code__2 dst = let code1 = registerCode register dst asmVoid
+                          src1  = registerName register dst
+                      in asmParThen [code1, code2] .
+                         if isFixed register && src1 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
+                                           instr (OpAddr src2)  (OpReg dst)]
+                         else 
+                                mkSeqInstr (instr (OpAddr src2) (OpReg src1))
+    in
+       returnSUs (Any pk code__2)
+
+trivialCode instr [StInd pk mem, y] _
+  = getReg y                       `thenSUs` \ register ->
+    --getNewRegNCG IntKind         `thenSUs` \ tmp ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let
+       fixedname  = registerName register eax
+       code2 = amodeCode amode asmVoid
+       src2  = amodeAddr amode
+       code__2 dst = let 
+                         code1 = registerCode register dst asmVoid
+                         src1  = registerName register dst
+                      in asmParThen [code1, code2] .
+                         if isFixed register && src1 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
+                                           instr (OpAddr src2)  (OpReg dst)]
+                         else 
+                                mkSeqInstr (instr (OpAddr src2) (OpReg src1))
+    in
+       returnSUs (Any pk code__2)
+
+trivialCode instr [x, y] is_comm_op 
+  = getReg x                       `thenSUs` \ register1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    --getNewRegNCG IntKind         `thenSUs` \ tmp1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    let
+       fixedname  = registerName register1 eax
+       code2 = registerCode register2 tmp2 asmVoid
+       src2  = registerName register2 tmp2
+       code__2 dst = let
+                         code1 = registerCode register1 dst asmVoid
+                         src1  = registerName register1 dst
+                      in asmParThen [code1, code2] .
+                         if isFixed register1 && src1 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
+                                           instr (OpReg src2)  (OpReg dst)]
+                         else 
+                                mkSeqInstr (instr (OpReg src2) (OpReg src1))
+    in
+       returnSUs (Any IntKind code__2)
+
+addCode 
+    :: Size
+    -> [StixTree]
+    -> SUniqSM Register
+addCode sz [x, StInt y]
+  =
+    getReg x                       `thenSUs` \ register ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp ->
+    let
+       code = registerCode register tmp
+       src1 = registerName register tmp
+       src2 = ImmInt (fromInteger y)
+       code__2 dst = code . 
+                      mkSeqInstr (LEA sz (OpAddr (Addr (Just src1) Nothing src2)) (OpReg dst))
+    in
+       returnSUs (Any IntKind code__2)
+
+addCode sz [x, StInd _ mem]
+  = getReg x                       `thenSUs` \ register1 ->
+    --getNewRegNCG (registerKind register1)
+    --                                     `thenSUs` \ tmp1 ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code2 = amodeCode amode
+       src2  = amodeAddr amode
+
+       fixedname  = registerName register1 eax
+       code__2 dst = let code1 = registerCode register1 dst
+                         src1  = registerName register1 dst
+                     in asmParThen [code2 asmVoid,code1 asmVoid] .
+                         if isFixed register1 && src1 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
+                                           ADD sz (OpAddr src2)  (OpReg dst)]
+                         else 
+                                mkSeqInstrs [ADD sz (OpAddr src2) (OpReg src1)]
+    in
+       returnSUs (Any IntKind code__2)
+
+addCode sz [StInd _ mem, y]
+  = getReg y                       `thenSUs` \ register2 ->
+    --getNewRegNCG (registerKind register2)
+    --                                     `thenSUs` \ tmp2 ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code1 = amodeCode amode
+       src1  = amodeAddr amode
+
+       fixedname  = registerName register2 eax
+       code__2 dst = let code2 = registerCode register2 dst
+                          src2  = registerName register2 dst
+                      in asmParThen [code1 asmVoid,code2 asmVoid] .
+                         if isFixed register2 && src2 /= dst
+                         then mkSeqInstrs [MOV L (OpReg src2) (OpReg dst),
+                                           ADD sz (OpAddr src1)  (OpReg dst)]
+                         else 
+                                mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
+    in
+       returnSUs (Any IntKind code__2)
+
+addCode sz [x, y] =
+    getReg x                       `thenSUs` \ register1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    let
+       code1 = registerCode register1 tmp1 asmVoid
+       src1  = registerName register1 tmp1
+       code2 = registerCode register2 tmp2 asmVoid
+       src2  = registerName register2 tmp2
+       code__2 dst = asmParThen [code1, code2] .
+                      mkSeqInstr (LEA sz (OpAddr (Addr (Just src1) (Just (src2,1)) (ImmInt 0))) (OpReg dst))
+    in
+       returnSUs (Any IntKind code__2)
+
+subCode 
+    :: Size
+    -> [StixTree]
+    -> SUniqSM Register
+subCode sz [x, StInt y]
+  = getReg x                       `thenSUs` \ register ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp ->
+    let
+       code = registerCode register tmp
+       src1 = registerName register tmp
+       src2 = ImmInt (-(fromInteger y))
+       code__2 dst = code . 
+                      mkSeqInstr (LEA sz (OpAddr (Addr (Just src1) Nothing src2)) (OpReg dst))
+    in
+       returnSUs (Any IntKind code__2)
+
+subCode sz args = trivialCode (SUB sz) args False
+
+divCode 
+    :: Size
+    -> [StixTree]
+    -> Bool -- True => division, False => remainder operation
+    -> SUniqSM Register
+
+-- x must go into eax, edx must be a sign-extension of eax, 
+-- and y should go in some other register (or memory),
+-- so that we get edx:eax / reg -> eax (remainder in edx)
+-- Currently we chose to put y in memory (if it is not there already)
+divCode sz [x, StInd pk mem] is_division
+  = getReg x                       `thenSUs` \ register1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code1 = registerCode register1 tmp1 asmVoid
+       src1 = registerName register1 tmp1
+       code2 = amodeCode amode asmVoid
+       src2  = amodeAddr amode
+       code__2 = asmParThen [code1, code2] .
+                  mkSeqInstrs [MOV L (OpReg src1) (OpReg eax),
+                               CLTD,
+                               IDIV sz (OpAddr src2)]
+    in
+        returnSUs (Fixed (if is_division then eax else edx) IntKind code__2)
+
+divCode sz [x, StInt i] is_division
+  = getReg x                       `thenSUs` \ register1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    let
+       code1 = registerCode register1 tmp1 asmVoid
+       src1 = registerName register1 tmp1
+       src2 = ImmInt (fromInteger i)
+       code__2 = asmParThen [code1] .
+                  mkSeqInstrs [-- we put src2 in (ebx)
+                               MOV L (OpImm src2) (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))),
+                               MOV L (OpReg src1) (OpReg eax),
+                               CLTD,
+                               IDIV sz (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)))]
+    in
+        returnSUs (Fixed (if is_division then eax else edx) IntKind code__2)
+
+divCode sz [x, y] is_division
+  = getReg x                       `thenSUs` \ register1 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    getNewRegNCG IntKind           `thenSUs` \ tmp2 ->
+    let
+       code1 = registerCode register1 tmp1 asmVoid
+       src1 = registerName register1 tmp1
+       code2 = registerCode register2 tmp2 asmVoid
+       src2 = registerName register2 tmp2
+       code__2 = asmParThen [code1, code2] .
+                  if src2 == ecx || src2 == esi
+                  then mkSeqInstrs [ MOV L (OpReg src1) (OpReg eax),
+                                     CLTD,
+                                     IDIV sz (OpReg src2)]
+                  else mkSeqInstrs [ -- we put src2 in (ebx)
+                                     MOV L (OpReg src2) (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))),
+                                     MOV L (OpReg src1) (OpReg eax),
+                                     CLTD,
+                                     IDIV sz (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)))]
+    in
+        returnSUs (Fixed (if is_division then eax else edx) IntKind code__2)
+
+trivialFCode 
+    :: PrimKind
+    -> (Size -> Operand -> I386Instr) 
+    -> (Size -> Operand -> I386Instr) -- reversed instr
+    -> I386Instr -- pop
+    -> I386Instr -- reversed instr, pop
+    -> [StixTree] 
+    -> SUniqSM Register
+trivialFCode pk _ instrr _ _ [StInd pk' mem, y]
+  = getReg y                       `thenSUs` \ register2 ->
+    --getNewRegNCG (registerKind register2)
+    --                                     `thenSUs` \ tmp2 ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code1 = amodeCode amode
+       src1  = amodeAddr amode
+
+       code__2 dst = let 
+                         code2 = registerCode register2 dst
+                         src2  = registerName register2 dst
+                      in asmParThen [code1 asmVoid,code2 asmVoid] .
+                        mkSeqInstrs [instrr (kindToSize pk) (OpAddr src1)]
+    in
+       returnSUs (Any pk code__2)
+
+trivialFCode pk instr _ _ _ [x, StInd pk' mem]
+  = getReg x                       `thenSUs` \ register1 ->
+    --getNewRegNCG (registerKind register1)
+    --                                     `thenSUs` \ tmp1 ->
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code2 = amodeCode amode
+       src2  = amodeAddr amode
+
+       code__2 dst = let 
+                         code1 = registerCode register1 dst
+                         src1  = registerName register1 dst
+                      in asmParThen [code2 asmVoid,code1 asmVoid] .
+                        mkSeqInstrs [instr (kindToSize pk) (OpAddr src2)]
+    in
+       returnSUs (Any pk code__2)
+
+trivialFCode pk _ _ _ instrpr [x, y] =
+    getReg x                       `thenSUs` \ register1 ->
+    getReg y                       `thenSUs` \ register2 ->
+    --getNewRegNCG (registerKind register1)
+    --                                     `thenSUs` \ tmp1 ->
+    --getNewRegNCG (registerKind register2)
+    --                                     `thenSUs` \ tmp2 ->
+    getNewRegNCG DoubleKind        `thenSUs` \ tmp ->
+    let
+       pk1   = registerKind register1
+       code1 = registerCode register1 st0 --tmp1
+       src1  = registerName register1 st0 --tmp1
+
+       pk2   = registerKind register2
+
+       code__2 dst = let 
+                         code2 = registerCode register2 dst
+                         src2  = registerName register2 dst
+                     in asmParThen [code1 asmVoid, code2 asmVoid] .
+                        mkSeqInstr instrpr 
+    in
+       returnSUs (Any pk1 code__2)
+
+\end{code}
+
+Trivial unary instructions.  Note that we don't have to worry about
+matching an StInt as the argument, because genericOpt will already
+have handled the constant-folding.
+
+\begin{code}
+
+trivialUCode 
+    :: (Operand -> I386Instr) 
+    -> [StixTree]
+    -> SUniqSM Register
+
+trivialUCode instr [x] =
+    getReg x                       `thenSUs` \ register ->
+--    getNewRegNCG IntKind         `thenSUs` \ tmp ->
+    let
+--     fixedname = registerName register eax
+       code__2 dst = let
+                         code = registerCode register dst
+                         src  = registerName register dst
+                      in code . if isFixed register && dst /= src
+                                then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+                                                  instr (OpReg dst)]
+                                else mkSeqInstr (instr (OpReg src))
+    in
+        returnSUs (Any IntKind code__2)
+
+trivialUFCode 
+    :: PrimKind
+    -> I386Instr
+    -> [StixTree]
+    -> SUniqSM Register
+
+trivialUFCode pk instr [StInd pk' mem] =
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code = amodeCode amode
+       src  = amodeAddr amode
+       code__2 dst = code . mkSeqInstrs [FLD (kindToSize pk) (OpAddr src),
+                                          instr]
+    in
+       returnSUs (Any pk code__2)
+
+trivialUFCode pk instr [x] =
+    getReg x                       `thenSUs` \ register ->
+    --getNewRegNCG pk              `thenSUs` \ tmp ->
+    let
+       code__2 dst = let
+                         code = registerCode register dst
+                         src  = registerName register dst
+                      in code . mkSeqInstrs [instr]
+    in
+       returnSUs (Any pk code__2)
+\end{code}
+
+Absolute value on integers, mostly for gmp size check macros.  Again,
+the argument cannot be an StInt, because genericOpt already folded
+constants.
+
+\begin{code}
+
+absIntCode :: [StixTree] -> SUniqSM Register
+absIntCode [x] =
+    getReg x                       `thenSUs` \ register ->
+    --getNewRegNCG IntKind         `thenSUs` \ reg ->
+    getUniqLabelNCG                        `thenSUs` \ lbl ->
+    let
+       code__2 dst = let code = registerCode register dst
+                         src  = registerName register dst
+                      in code . if isFixed register && dst /= src
+                                then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+                                                  TEST L (OpReg dst) (OpReg dst),
+                                                  JXX GE lbl,
+                                                  NEGI L (OpReg dst),
+                                                  LABEL lbl]
+                                else mkSeqInstrs [TEST L (OpReg src) (OpReg src),
+                                                  JXX GE lbl,
+                                                  NEGI L (OpReg src),
+                                                  LABEL lbl]
+    in
+       returnSUs (Any IntKind code__2)
+
+\end{code}
+                      
+Simple integer coercions that don't require any code to be generated.
+Here we just change the type on the register passed on up
+
+\begin{code}
+
+coerceIntCode :: PrimKind -> [StixTree] -> SUniqSM Register
+coerceIntCode pk [x] =
+    getReg x                       `thenSUs` \ register ->
+    case register of
+       Fixed reg _ code -> returnSUs (Fixed reg pk code)
+       Any _ code       -> returnSUs (Any pk code)
+
+coerceFltCode :: [StixTree] -> SUniqSM Register
+coerceFltCode [x] =
+    getReg x                       `thenSUs` \ register ->
+    case register of
+       Fixed reg _ code -> returnSUs (Fixed reg DoubleKind code)
+       Any _ code       -> returnSUs (Any DoubleKind code)
+
+\end{code}
+
+Integer to character conversion.  We try to do this in one step if
+the original object is in memory.
+
+\begin{code}
+chrCode :: [StixTree] -> SUniqSM Register
+{-
+chrCode [StInd pk mem] =
+    getAmode mem                   `thenSUs` \ amode ->
+    let 
+       code = amodeCode amode
+       src  = amodeAddr amode
+       code__2 dst = code . mkSeqInstr (MOVZX L (OpAddr src) (OpReg dst))
+    in
+       returnSUs (Any pk code__2)
+-}
+chrCode [x] =
+    getReg x                       `thenSUs` \ register ->
+    --getNewRegNCG IntKind         `thenSUs` \ reg ->
+    let
+       fixedname = registerName register eax
+       code__2 dst = let
+                         code = registerCode register dst
+                         src  = registerName register dst
+                      in code . 
+                         if isFixed register && src /= dst
+                         then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+                                           AND L (OpImm (ImmInt 255)) (OpReg dst)]
+                         else mkSeqInstr (AND L (OpImm (ImmInt 255)) (OpReg src))
+    in
+        returnSUs (Any IntKind code__2)
+
+\end{code}
+
+More complicated integer/float conversions.  Here we have to store
+temporaries in memory to move between the integer and the floating
+point register sets.
+
+\begin{code}
+coerceInt2FP :: PrimKind -> [StixTree] -> SUniqSM Register
+coerceInt2FP pk [x] = 
+    getReg x                       `thenSUs` \ register ->
+    getNewRegNCG IntKind           `thenSUs` \ reg ->
+    let
+       code = registerCode register reg
+       src  = registerName register reg
+
+       code__2 dst = code . mkSeqInstrs [
+        -- to fix: should spill instead of using R1
+                     MOV L (OpReg src) (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))),
+                     FILD (kindToSize pk) (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)) dst]
+    in
+       returnSUs (Any pk code__2)
+
+coerceFP2Int :: [StixTree] -> SUniqSM Register
+coerceFP2Int [x] =
+    getReg x                       `thenSUs` \ register ->
+    getNewRegNCG DoubleKind                `thenSUs` \ tmp ->
+    let
+       code = registerCode register tmp
+       src  = registerName register tmp
+       pk   = registerKind register
+
+       code__2 dst = let 
+                      in code . mkSeqInstrs [
+                               FRNDINT,
+                               FIST L (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)),
+                               MOV L (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))) (OpReg dst)]
+    in
+       returnSUs (Any IntKind code__2)
+\end{code}
+
+Some random little helpers.
+
+\begin{code}
+
+maybeImm :: StixTree -> Maybe Imm
+maybeImm (StInt i) 
+  | i >= toInteger minInt && i <= toInteger maxInt = Just (ImmInt (fromInteger i))
+  | otherwise = Just (ImmInteger i)
+maybeImm (StLitLbl s)  = Just (ImmLit (uppBeside (uppChar '_') s))
+maybeImm (StLitLit s)  = Just (strImmLit (cvtLitLit (_UNPK_ s)))
+maybeImm (StCLbl l) = Just (ImmCLbl l)
+maybeImm _          = Nothing
+
+mangleIndexTree :: StixTree -> StixTree
+
+mangleIndexTree (StIndex pk base (StInt i)) = 
+    StPrim IntAddOp [base, off]
+  where
+    off = StInt (i * size pk)
+    size :: PrimKind -> Integer
+    size pk = case kindToSize pk of
+       {B -> 1; S -> 2; L -> 4; F -> 4; D -> 8 }
+
+mangleIndexTree (StIndex pk base off) = 
+    case pk of
+       CharKind -> StPrim IntAddOp [base, off]
+       _        -> StPrim IntAddOp [base, off__2]
+  where
+    off__2 = StPrim SllOp [off, StInt (shift pk)]
+    shift :: PrimKind -> Integer
+    shift DoubleKind   = 3
+    shift _            = 2
+
+cvtLitLit :: String -> String
+cvtLitLit "stdin"  = "_IO_stdin_"   
+cvtLitLit "stdout" = "_IO_stdout_" 
+cvtLitLit "stderr" = "_IO_stderr_"
+cvtLitLit s 
+  | isHex s = s
+  | otherwise = error ("Native code generator can't handle ``" ++ s ++ "''")
+  where 
+    isHex ('0':'x':xs) = all isHexDigit xs
+    isHex _ = False
+    -- Now, where have I seen this before?
+    isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f'
+
+
+\end{code}
+
+\begin{code}
+
+stackArgLoc = 23 :: Int        -- where to stack call arguments 
+
+\end{code}
+
+\begin{code}
+
+getNewRegNCG :: PrimKind -> SUniqSM Reg
+getNewRegNCG pk = 
+      getSUnique          `thenSUs` \ u ->
+      returnSUs (mkReg u pk)
+
+fixFPCond :: Cond -> Cond
+-- on the 486 the flags set by FP compare are the unsigned ones!
+fixFPCond GE  = GEU
+fixFPCond GT  = GU
+fixFPCond LT  = LU
+fixFPCond LE  = LEU
+fixFPCond any = any
+\end{code}
index 674a649..abc8db6 100644 (file)
@@ -14,82 +14,51 @@ import PreludeRatio(Ratio(..))
 import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
-import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
+import SMRep(SMRep)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree, StixTreeList(..))
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree, StixTreeList(..))
-import UniType(UniType)
 import Unique(Unique)
 import Unpretty(Unpretty(..))
 import Unique(Unique)
 import Unpretty(Unpretty(..))
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CExprMacro        {-# GHC_PRAGMA INFO_PTR | ENTRY_CODE | INFO_TAG | EVAL_TAG #-}
-data CStmtMacro        {-# GHC_PRAGMA ARGS_CHK_A_LOAD_NODE | ARGS_CHK_A | ARGS_CHK_B_LOAD_NODE | ARGS_CHK_B | HEAP_CHK | STK_CHK | UPD_CAF | UPD_IND | UPD_INPLACE_NOPTRS | UPD_INPLACE_PTRS | UPD_BH_UPDATABLE | UPD_BH_SINGLE_ENTRY | PUSH_STD_UPD_FRAME | POP_STD_UPD_FRAME | SET_ARITY | CHK_ARITY | SET_TAG #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data RegRelative       {-# GHC_PRAGMA HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
+data AbstractC 
+data CAddrMode 
+data CExprMacro 
+data CStmtMacro 
+data MagicId 
+data RegRelative 
+data BasicLit 
 data CLabel 
 data CLabel 
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data CSeq 
+data GlobalSwitch 
 data RegLoc   = Save StixTree | Always StixTree
 data RegLoc   = Save StixTree | Always StixTree
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
+data SwitchResult 
 data HeapOffset 
 data HeapOffset 
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
+data PprStyle 
+data PrimKind 
+data PrimOp 
+data SMRep 
 type SUniqSM a = SplitUniqSupply -> a
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+data SplitUniqSupply 
+data StixTree 
 type StixTreeList = [StixTree] -> [StixTree]
 type StixTreeList = [StixTree] -> [StixTree]
-data Target    {-# GHC_PRAGMA Target (GlobalSwitch -> SwitchResult) Int (SMRep -> Int) (MagicId -> RegLoc) (StixTree -> StixTree) (PrimKind -> Int) ([MagicId] -> [StixTree]) ([MagicId] -> [StixTree]) (HeapOffset -> Int) (CAddrMode -> StixTree) (CAddrMode -> StixTree) Int Int StixTree StixTree ([CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) Bool ([Char] -> [Char]) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Target   = Target Int (SMRep -> Int) (MagicId -> RegLoc) (PrimKind -> Int) (HeapOffset -> Int) (CAddrMode -> StixTree) (CAddrMode -> StixTree) ([MagicId] -> [StixTree], [MagicId] -> [StixTree], Int, Int, StixTree, StixTree, [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree], CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree], StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree])
+data Unique 
 type Unpretty = CSeq
 amodeToStix :: Target -> CAddrMode -> StixTree
 type Unpretty = CSeq
 amodeToStix :: Target -> CAddrMode -> StixTree
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAAAASAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: CAddrMode -> StixTree) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ua; _NO_DEFLT_ } _N_ #-}
 amodeToStix' :: Target -> CAddrMode -> StixTree
 amodeToStix' :: Target -> CAddrMode -> StixTree
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAAAAASAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: CAddrMode -> StixTree) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ub; _NO_DEFLT_ } _N_ #-}
 charLikeClosureSize :: Target -> Int
 charLikeClosureSize :: Target -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAAAAAU(P)AAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> uc; _NO_DEFLT_ } _N_ #-}
-codeGen :: Target -> PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222 _N_ _S_ "U(AAAAAAAAAAAAAAAAAASAA)" {_A_ 1 _U_ 1222 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> uj; _NO_DEFLT_ } _N_ #-}
 dataHS :: Target -> StixTree
 dataHS :: Target -> StixTree
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAAAAAAAASAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StixTree) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> uf; _NO_DEFLT_ } _N_ #-}
 fixedHeaderSize :: Target -> Int
 fixedHeaderSize :: Target -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AU(P)AAAAAAAAAAAAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u2; _NO_DEFLT_ } _N_ #-}
-fmtAsmLbl :: Target -> [Char] -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAAAAAAAAAAAAAAAS)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [Char] -> [Char]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ul; _NO_DEFLT_ } _N_ #-}
 heapCheck :: Target -> StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]
 heapCheck :: Target -> StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 1 _U_ 122222 _N_ _S_ "U(AAAAAAAAAAAAAAAAASAAA)" {_A_ 1 _U_ 122222 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ui; _NO_DEFLT_ } _N_ #-}
 hpRel :: Target -> HeapOffset -> Int
 hpRel :: Target -> HeapOffset -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAAASAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: HeapOffset -> Int) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u9; _NO_DEFLT_ } _N_ #-}
 intLikeClosureSize :: Target -> Int
 intLikeClosureSize :: Target -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAAAAAAU(P)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ud; _NO_DEFLT_ } _N_ #-}
 macroCode :: Target -> CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
 macroCode :: Target -> CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 1 _U_ 12222 _N_ _S_ "U(AAAAAAAAAAAAAAAASAAAA)" {_A_ 1 _U_ 12222 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> uh; _NO_DEFLT_ } _N_ #-}
-mkTarget :: (GlobalSwitch -> SwitchResult) -> Int -> (SMRep -> Int) -> (MagicId -> RegLoc) -> (StixTree -> StixTree) -> (PrimKind -> Int) -> ([MagicId] -> [StixTree]) -> ([MagicId] -> [StixTree]) -> (HeapOffset -> Int) -> (CAddrMode -> StixTree) -> (CAddrMode -> StixTree) -> Int -> Int -> StixTree -> StixTree -> ([CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> (CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> (StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> (PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) -> Bool -> ([Char] -> [Char]) -> Target
-       {-# GHC_PRAGMA _A_ 21 _U_ 222222222222222222222 _N_ _N_ _F_ _IF_ARGS_ 0 21 XXXXXXXXXXXXXXXXXXXXX 22 \ (u0 :: GlobalSwitch -> SwitchResult) (u1 :: Int) (u2 :: SMRep -> Int) (u3 :: MagicId -> RegLoc) (u4 :: StixTree -> StixTree) (u5 :: PrimKind -> Int) (u6 :: [MagicId] -> [StixTree]) (u7 :: [MagicId] -> [StixTree]) (u8 :: HeapOffset -> Int) (u9 :: CAddrMode -> StixTree) (ua :: CAddrMode -> StixTree) (ub :: Int) (uc :: Int) (ud :: StixTree) (ue :: StixTree) (uf :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ug :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uj :: Bool) (uk :: [Char] -> [Char]) -> _!_ _ORIG_ MachDesc Target [] [u0, u1, u2, u3, u4, u5, u6, u7, u8, u9, ua, ub, uc, ud, ue, uf, ug, uh, ui, uj, uk] _N_ #-}
+mkTarget :: Int -> (SMRep -> Int) -> (MagicId -> RegLoc) -> (PrimKind -> Int) -> (HeapOffset -> Int) -> (CAddrMode -> StixTree) -> (CAddrMode -> StixTree) -> ([MagicId] -> [StixTree], [MagicId] -> [StixTree], Int, Int, StixTree, StixTree, [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree], CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree], StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> Target
 mutHS :: Target -> StixTree
 mutHS :: Target -> StixTree
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAAAAAAASAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StixTree) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ue; _NO_DEFLT_ } _N_ #-}
-nativeOpt :: Target -> StixTree -> StixTree
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAASAAAAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StixTree -> StixTree) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u5; _NO_DEFLT_ } _N_ #-}
 primToStix :: Target -> [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
 primToStix :: Target -> [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 1 _U_ 122222 _N_ _S_ "U(AAAAAAAAAAAAAAASAAAAA)" {_A_ 1 _U_ 122222 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> ug; _NO_DEFLT_ } _N_ #-}
 saveLoc :: Target -> MagicId -> StixTree
 saveLoc :: Target -> MagicId -> StixTree
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAASAAAAAAAAAAAAAAAAA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 sizeof :: Target -> PrimKind -> Int
 sizeof :: Target -> PrimKind -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAASAAAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: PrimKind -> Int) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u6; _NO_DEFLT_ } _N_ #-}
 stgReg :: Target -> MagicId -> RegLoc
 stgReg :: Target -> MagicId -> RegLoc
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAASAAAAAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: MagicId -> RegLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u4; _NO_DEFLT_ } _N_ #-}
-targetSwitches :: Target -> GlobalSwitch -> SwitchResult
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(SAAAAAAAAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: GlobalSwitch -> SwitchResult) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u1; _NO_DEFLT_ } _N_ #-}
-underscore :: Target -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAAAAAAAAAAAAAEA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Bool) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> uk; _NO_DEFLT_ } _N_ #-}
 varHeaderSize :: Target -> SMRep -> Int
 varHeaderSize :: Target -> SMRep -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AASAAAAAAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SMRep -> Int) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 volatileRestores :: Target -> [MagicId] -> [StixTree]
 volatileRestores :: Target -> [MagicId] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAASAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [MagicId] -> [StixTree]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u8; _NO_DEFLT_ } _N_ #-}
 volatileSaves :: Target -> [MagicId] -> [StixTree]
 volatileSaves :: Target -> [MagicId] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAASAAAAAAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [MagicId] -> [StixTree]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Target) -> case u0 of { _ALG_ _ORIG_ MachDesc Target (u1 :: GlobalSwitch -> SwitchResult) (u2 :: Int) (u3 :: SMRep -> Int) (u4 :: MagicId -> RegLoc) (u5 :: StixTree -> StixTree) (u6 :: PrimKind -> Int) (u7 :: [MagicId] -> [StixTree]) (u8 :: [MagicId] -> [StixTree]) (u9 :: HeapOffset -> Int) (ua :: CAddrMode -> StixTree) (ub :: CAddrMode -> StixTree) (uc :: Int) (ud :: Int) (ue :: StixTree) (uf :: StixTree) (ug :: [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uh :: CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (ui :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (uj :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) (uk :: Bool) (ul :: [Char] -> [Char]) -> u7; _NO_DEFLT_ } _N_ #-}
 
 
index 79b1965..19b0bcb 100644 (file)
@@ -10,15 +10,18 @@ No doubt there will be more...
 #include "HsVersions.h"
 
 module MachDesc (
 #include "HsVersions.h"
 
 module MachDesc (
-       Target, mkTarget, RegLoc(..), 
+       Target(..){-(..) for target_STRICT only-}, mkTarget, RegLoc(..), 
 
        saveLoc,
 
 
        saveLoc,
 
-       targetSwitches, fixedHeaderSize, varHeaderSize, stgReg,
-       nativeOpt, sizeof, volatileSaves, volatileRestores, hpRel,
+--     targetSwitches, UNUSED FOR NOW
+       fixedHeaderSize, varHeaderSize, stgReg,
+--     nativeOpt, UNUSED FOR NOW
+       sizeof, volatileSaves, volatileRestores, hpRel,
        amodeToStix, amodeToStix', charLikeClosureSize,
        intLikeClosureSize, mutHS, dataHS, primToStix, macroCode,
        amodeToStix, amodeToStix', charLikeClosureSize,
        intLikeClosureSize, mutHS, dataHS, primToStix, macroCode,
-       heapCheck, codeGen, underscore, fmtAsmLbl,
+       heapCheck,
+--     codeGen, underscore, fmtAsmLbl, UNUSED FOR NOW (done a diff way)
 
        -- and, for self-sufficiency...
        AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId,
 
        -- and, for self-sufficiency...
        AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId,
@@ -49,57 +52,69 @@ Think of this as a big runtime class dictionary
 \begin{code}
 
 data Target = Target
 \begin{code}
 
 data Target = Target
-    (GlobalSwitch -> SwitchResult)     -- switches
+--  (GlobalSwitch -> SwitchResult)     -- switches
     Int                                -- fixedHeaderSize
     (SMRep -> Int)                             -- varHeaderSize
     (MagicId -> RegLoc)                -- stgReg
     Int                                -- fixedHeaderSize
     (SMRep -> Int)                             -- varHeaderSize
     (MagicId -> RegLoc)                -- stgReg
-    (StixTree -> StixTree)             -- nativeOpt
+--  (StixTree -> StixTree)             -- nativeOpt
     (PrimKind -> Int)                  -- sizeof
     (PrimKind -> Int)                  -- sizeof
-    ([MagicId] -> [StixTree])          -- volatileSaves
-    ([MagicId] -> [StixTree])          -- volatileRestores
     (HeapOffset -> Int)                        -- hpRel
     (CAddrMode -> StixTree)            -- amodeToStix
     (CAddrMode -> StixTree)            -- amodeToStix'
     (HeapOffset -> Int)                        -- hpRel
     (CAddrMode -> StixTree)            -- amodeToStix
     (CAddrMode -> StixTree)            -- amodeToStix'
-    Int                                -- charLikeClosureSize
-    Int                                -- intLikeClosureSize
-    StixTree                           -- mutHS
-    StixTree                           -- dataHS
-    ([CAddrMode] -> PrimOp -> [CAddrMode] -> SUniqSM StixTreeList)
+    (
+    ([MagicId] -> [StixTree]),         -- volatileSaves
+    ([MagicId] -> [StixTree]),         -- volatileRestores
+    Int,                               -- charLikeClosureSize
+    Int,                               -- intLikeClosureSize
+    StixTree,                          -- mutHS
+    StixTree,                          -- dataHS
+    ([CAddrMode] -> PrimOp -> [CAddrMode] -> SUniqSM StixTreeList),
                                        -- primToStix
                                        -- primToStix
-    (CStmtMacro -> [CAddrMode] -> SUniqSM StixTreeList)
+    (CStmtMacro -> [CAddrMode] -> SUniqSM StixTreeList),
                                        -- macroCode
     (StixTree -> StixTree -> StixTree -> SUniqSM StixTreeList)
                                        -- heapCheck
                                        -- macroCode
     (StixTree -> StixTree -> StixTree -> SUniqSM StixTreeList)
                                        -- heapCheck
-
+    )
+{- UNUSED: done a diff way:
     (PprStyle -> [[StixTree]] -> SUniqSM Unpretty)
                                        -- codeGen
 
     Bool                               -- underscore
     (String -> String)                 -- fmtAsmLbl
     (PprStyle -> [[StixTree]] -> SUniqSM Unpretty)
                                        -- codeGen
 
     Bool                               -- underscore
     (String -> String)                 -- fmtAsmLbl
+-}
 
 mkTarget = Target
 
 
 mkTarget = Target
 
-targetSwitches (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = sw
-fixedHeaderSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = fhs
-varHeaderSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = vhs
-stgReg (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = reg
-nativeOpt (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = opt
-sizeof (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = size
-volatileSaves (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = vsave
-volatileRestores (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = vrest
-hpRel (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = hprel
-amodeToStix (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = am
-amodeToStix' (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = am'
-charLikeClosureSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = csz
-intLikeClosureSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = isz
-mutHS (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = mhs
-dataHS (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = dhs
-primToStix (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = ps
-macroCode (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = mc
-heapCheck (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = hc
-codeGen (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = cg
-underscore (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = us
-fmtAsmLbl (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = fmt
+{- UNUSED FOR NOW:
+targetSwitches (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = {-sw-} x
+-}
+fixedHeaderSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = fhs
+varHeaderSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = vhs x
+stgReg (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = reg x
+{- UNUSED FOR NOW:
+nativeOpt (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = {-opt-} x
+-}
+sizeof (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = size x
+-- used only for wrapper-hungry PrimOps:
+hpRel (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = hprel x
+amodeToStix (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = am x
+amodeToStix' (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = am' x
+
+volatileSaves (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = vsave x
+-- used only for wrapper-hungry PrimOps:
+volatileRestores (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = vrest x
+charLikeClosureSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = csz
+intLikeClosureSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = isz
+mutHS (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = mhs
+dataHS (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = dhs
+primToStix (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y z = ps x y z
+macroCode (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y = mc x y
+heapCheck (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y z = hc x y z
+{- UNUSED: done a diff way:
+codeGen (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y = cg x y
+underscore (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = us
+fmtAsmLbl (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = fmt x
+-}
 \end{code}
 
 Trees for register save locations
 \end{code}
 
 Trees for register save locations
index 45e2629..a2004a4 100644 (file)
@@ -16,70 +16,41 @@ import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 data Addr   = AddrRegReg Reg Reg | AddrRegImm Reg Imm
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 data Addr   = AddrRegReg Reg Reg | AddrRegImm Reg Imm
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data Reg       {-# GHC_PRAGMA FixedReg Int# | MappedReg Int# | MemoryReg Int PrimKind | UnmappedReg Unique PrimKind #-}
-data BitSet    {-# GHC_PRAGMA MkBS Word# #-}
+data MagicId 
+data Reg 
+data BitSet 
 data CLabel 
 data CLabel 
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-data OrdList a         {-# GHC_PRAGMA SeqList (OrdList a) (OrdList a) | ParList (OrdList a) (OrdList a) | OrdObj a | NoObj #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data CodeSegment       {-# GHC_PRAGMA DataSegment | TextSegment #-}
+data CSeq 
+data FiniteMap a b 
+data OrdList a 
+data PrimKind 
+data CodeSegment 
 data Cond   = ALWAYS | NEVER | GEU | LU | EQ | GT | GE | GU | LT | LE | LEU | NE | NEG | POS | VC | VS
 data Imm   = ImmInt Int | ImmInteger Integer | ImmCLbl CLabel | ImmLab CSeq | ImmLit CSeq | LO Imm | HI Imm
 data RI   = RIReg Reg | RIImm Imm
 data Size   = SB | HW | UB | UHW | W | D | F | DF
 type SparcCode = OrdList SparcInstr
 data SparcInstr   = LD Size Addr Reg | ST Size Reg Addr | ADD Bool Bool Reg RI Reg | SUB Bool Bool Reg RI Reg | AND Bool Reg RI Reg | ANDN Bool Reg RI Reg | OR Bool Reg RI Reg | ORN Bool Reg RI Reg | XOR Bool Reg RI Reg | XNOR Bool Reg RI Reg | SLL Reg RI Reg | SRL Reg RI Reg | SRA Reg RI Reg | SETHI Imm Reg | NOP | FABS Size Reg Reg | FADD Size Reg Reg Reg | FCMP Bool Size Reg Reg | FDIV Size Reg Reg Reg | FMOV Size Reg Reg | FMUL Size Reg Reg Reg | FNEG Size Reg Reg | FSQRT Size Reg Reg | FSUB Size Reg Reg Reg | FxTOy Size Size Reg Reg | BI Cond Bool Imm | BF Cond Bool Imm | JMP Addr | CALL Imm Int Bool | LABEL CLabel | COMMENT _PackedString | SEGMENT CodeSegment | ASCII Bool [Char] | DATA Size [Imm]
 data Cond   = ALWAYS | NEVER | GEU | LU | EQ | GT | GE | GU | LT | LE | LEU | NE | NEG | POS | VC | VS
 data Imm   = ImmInt Int | ImmInteger Integer | ImmCLbl CLabel | ImmLab CSeq | ImmLit CSeq | LO Imm | HI Imm
 data RI   = RIReg Reg | RIImm Imm
 data Size   = SB | HW | UB | UHW | W | D | F | DF
 type SparcCode = OrdList SparcInstr
 data SparcInstr   = LD Size Addr Reg | ST Size Reg Addr | ADD Bool Bool Reg RI Reg | SUB Bool Bool Reg RI Reg | AND Bool Reg RI Reg | ANDN Bool Reg RI Reg | OR Bool Reg RI Reg | ORN Bool Reg RI Reg | XOR Bool Reg RI Reg | XNOR Bool Reg RI Reg | SLL Reg RI Reg | SRL Reg RI Reg | SRA Reg RI Reg | SETHI Imm Reg | NOP | FABS Size Reg Reg | FADD Size Reg Reg Reg | FCMP Bool Size Reg Reg | FDIV Size Reg Reg Reg | FMOV Size Reg Reg | FMUL Size Reg Reg Reg | FNEG Size Reg Reg | FSQRT Size Reg Reg | FSUB Size Reg Reg Reg | FxTOy Size Size Reg Reg | BI Cond Bool Imm | BF Cond Bool Imm | JMP Addr | CALL Imm Int Bool | LABEL CLabel | COMMENT _PackedString | SEGMENT CodeSegment | ASCII Bool [Char] | DATA Size [Imm]
-data SparcRegs         {-# GHC_PRAGMA SRegs BitSet BitSet BitSet #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data SparcRegs 
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 argRegs :: [Reg]
 argRegs :: [Reg]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 baseRegOffset :: MagicId -> Int
 baseRegOffset :: MagicId -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 callerSaves :: MagicId -> Bool
 callerSaves :: MagicId -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 f0 :: Reg
 f0 :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 fp :: Reg
 fp :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [30#] _N_ #-}
 freeRegs :: [Reg]
 freeRegs :: [Reg]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 g0 :: Reg
 g0 :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [0#] _N_ #-}
 is13Bits :: Integral a => a -> Bool
 is13Bits :: Integral a => a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(LU(U(ALASAAAA)AAA)AAAAAAAAAA)" {_A_ 3 _U_ 1112 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Integer ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(PPP)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 kindToSize :: PrimKind -> Size
 kindToSize :: PrimKind -> Size
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
 o0 :: Reg
 o0 :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 offset :: Addr -> Int -> Labda Addr
 offset :: Addr -> Int -> Labda Addr
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 printLabeledCodes :: PprStyle -> [SparcInstr] -> CSeq
 printLabeledCodes :: PprStyle -> [SparcInstr] -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 reservedRegs :: [Int]
 reservedRegs :: [Int]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 sp :: Reg
 sp :: Reg
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ AsmRegAlloc FixedReg [] [14#] _N_ #-}
 stgRegMap :: MagicId -> Labda Reg
 stgRegMap :: MagicId -> Labda Reg
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 strImmLit :: [Char] -> Imm
 strImmLit :: [Char] -> Imm
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance MachineCode SparcInstr
 instance MachineCode SparcInstr
-       {-# GHC_PRAGMA _M_ SparcCode {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 6 _!_ _TUP_5 [(SparcInstr -> RegUsage), (SparcInstr -> RegLiveness -> RegLiveness), (SparcInstr -> (Reg -> Reg) -> SparcInstr), (Reg -> Reg -> OrdList SparcInstr), (Reg -> Reg -> OrdList SparcInstr)] [_CONSTM_ MachineCode regUsage (SparcInstr), _CONSTM_ MachineCode regLiveness (SparcInstr), _CONSTM_ MachineCode patchRegs (SparcInstr), _CONSTM_ MachineCode spillReg (SparcInstr), _CONSTM_ MachineCode loadReg (SparcInstr)] _N_
-        regUsage = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        regLiveness = _A_ 2 _U_ 11 _N_ _S_ "SU(LU(LL))" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _N_,
-        patchRegs = _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_,
-        spillReg = _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_,
-        loadReg = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instance MachineRegisters SparcRegs
 instance MachineRegisters SparcRegs
-       {-# GHC_PRAGMA _M_ SparcCode {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 7 _!_ _TUP_6 [([Int] -> SparcRegs), (PrimKind -> SparcRegs -> [Int]), (SparcRegs -> Int# -> SparcRegs), (SparcRegs -> [Int] -> SparcRegs), (SparcRegs -> Int# -> SparcRegs), (SparcRegs -> [Int] -> SparcRegs)] [_CONSTM_ MachineRegisters mkMRegs (SparcRegs), _CONSTM_ MachineRegisters possibleMRegs (SparcRegs), _CONSTM_ MachineRegisters useMReg (SparcRegs), _CONSTM_ MachineRegisters useMRegs (SparcRegs), _CONSTM_ MachineRegisters freeMReg (SparcRegs), _CONSTM_ MachineRegisters freeMRegs (SparcRegs)] _N_
-        mkMRegs = _A_ 1 _U_ 1 _N_ _N_ _N_ _N_,
-        possibleMRegs = _A_ 2 _U_ 11 _N_ _S_ "EU(LLL)" {_A_ 4 _U_ 1111 _N_ _N_ _N_ _N_} _N_ _N_,
-        useMReg = _A_ 2 _U_ 12 _N_ _S_ "U(LLL)P" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_,
-        useMRegs = _A_ 2 _U_ 11 _N_ _S_ "U(LLL)L" {_A_ 4 _U_ 1111 _N_ _N_ _N_ _N_} _N_ _N_,
-        freeMReg = _A_ 2 _U_ 12 _N_ _S_ "U(LLL)P" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_,
-        freeMRegs = _A_ 2 _U_ 11 _N_ _S_ "U(LLL)L" {_A_ 4 _U_ 1111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 1c3862e..e068093 100644 (file)
@@ -339,6 +339,7 @@ pprAddr sty (AddrRegReg r1 r2) =
 
 pprAddr sty (AddrRegImm r1 (ImmInt i))
     | i == 0 = pprReg r1
 
 pprAddr sty (AddrRegImm r1 (ImmInt i))
     | i == 0 = pprReg r1
+    | i < -4096 || i > 4095 = large_offset_error i
     | i < 0  =
        uppBesides [
            pprReg r1,
     | i < 0  =
        uppBesides [
            pprReg r1,
@@ -348,6 +349,7 @@ pprAddr sty (AddrRegImm r1 (ImmInt i))
 
 pprAddr sty (AddrRegImm r1 (ImmInteger i))
     | i == 0 = pprReg r1
 
 pprAddr sty (AddrRegImm r1 (ImmInteger i))
     | i == 0 = pprReg r1
+    | i < -4096 || i > 4095 = large_offset_error i
     | i < 0  =
        uppBesides [
            pprReg r1,
     | i < 0  =
        uppBesides [
            pprReg r1,
@@ -362,6 +364,9 @@ pprAddr sty (AddrRegImm r1 imm) =
        pprImm sty imm
     ]
 
        pprImm sty imm
     ]
 
+large_offset_error i
+  = error ("ERROR: SPARC native-code generator cannot handle large offset ("++show i++");\nprobably because of large constant data structures;\nworkaround: use -fvia-C on this module.\n")
+
 pprRI :: PprStyle -> RI -> Unpretty
 pprRI sty (RIReg r) = pprReg r
 pprRI sty (RIImm r) = pprImm sty r
 pprRI :: PprStyle -> RI -> Unpretty
 pprRI sty (RIReg r) = pprReg r
 pprRI sty (RIImm r) = pprImm sty r
@@ -1098,7 +1103,7 @@ baseRegOffset SuB                 = OFFSET_SuB
 baseRegOffset Hp                       = OFFSET_Hp
 baseRegOffset HpLim                    = OFFSET_HpLim
 baseRegOffset LivenessReg              = OFFSET_Liveness
 baseRegOffset Hp                       = OFFSET_Hp
 baseRegOffset HpLim                    = OFFSET_HpLim
 baseRegOffset LivenessReg              = OFFSET_Liveness
-baseRegOffset ActivityReg              = OFFSET_Activity
+--baseRegOffset ActivityReg            = OFFSET_Activity
 #ifdef DEBUG
 baseRegOffset BaseReg                  = panic "baseRegOffset:BaseReg"
 baseRegOffset StdUpdRetVecReg          = panic "baseRegOffset:StgUpdRetVecReg"
 #ifdef DEBUG
 baseRegOffset BaseReg                  = panic "baseRegOffset:BaseReg"
 baseRegOffset StdUpdRetVecReg          = panic "baseRegOffset:StgUpdRetVecReg"
@@ -1184,7 +1189,7 @@ callerSaves HpLim                 = True
 callerSaves LivenessReg                = True
 #endif
 #ifdef CALLER_SAVES_Activity
 callerSaves LivenessReg                = True
 #endif
 #ifdef CALLER_SAVES_Activity
-callerSaves ActivityReg                = True
+--callerSaves ActivityReg              = True
 #endif
 #ifdef CALLER_SAVES_StdUpdRetVec
 callerSaves StdUpdRetVecReg            = True
 #endif
 #ifdef CALLER_SAVES_StdUpdRetVec
 callerSaves StdUpdRetVecReg            = True
@@ -1271,7 +1276,7 @@ stgRegMap HpLim              = Just (FixedReg ILIT(REG_HpLim))
 stgRegMap LivenessReg     = Just (FixedReg ILIT(REG_Liveness))
 #endif
 #ifdef REG_Activity
 stgRegMap LivenessReg     = Just (FixedReg ILIT(REG_Liveness))
 #endif
 #ifdef REG_Activity
-stgRegMap ActivityReg     = Just (FixedReg ILIT(REG_Activity))
+--stgRegMap ActivityReg           = Just (FixedReg ILIT(REG_Activity))
 #endif
 #ifdef REG_StdUpdRetVec
 stgRegMap StdUpdRetVecReg  = Just (FixedReg ILIT(REG_StdUpdRetVec))
 #endif
 #ifdef REG_StdUpdRetVec
 stgRegMap StdUpdRetVecReg  = Just (FixedReg ILIT(REG_StdUpdRetVec))
@@ -1372,7 +1377,7 @@ freeReg ILIT(REG_HpLim) = _FALSE_
 freeReg ILIT(REG_Liveness) = _FALSE_
 #endif
 #ifdef REG_Activity
 freeReg ILIT(REG_Liveness) = _FALSE_
 #endif
 #ifdef REG_Activity
-freeReg ILIT(REG_Activity) = _FALSE_
+--freeReg ILIT(REG_Activity) = _FALSE_
 #endif
 #ifdef REG_StdUpdRetVec
 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
 #endif
 #ifdef REG_StdUpdRetVec
 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
index ae4c32d..9d40f7c 100644 (file)
@@ -11,14 +11,14 @@ import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
+import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import Stix(CodeSegment, StixReg, StixTree)
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
-data RegLoc    {-# GHC_PRAGMA Save StixTree | Always StixTree #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
-mkSparc :: Bool -> (GlobalSwitch -> SwitchResult) -> Target
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+data MagicId 
+data SwitchResult 
+data RegLoc 
+data PprStyle 
+data PrimKind 
+data SMRep 
+data StixTree 
+mkSparc :: Bool -> (GlobalSwitch -> SwitchResult) -> (Target, PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq, Bool, [Char] -> [Char])
 
 
index 91f2d9e..0a0de39 100644 (file)
@@ -120,7 +120,7 @@ because some are reloaded from constants.
 \begin{code}
 
 vsaves switches vols = 
 \begin{code}
 
 vsaves switches vols = 
-    map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,ActivityReg] ++ vols))
+    map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-}] ++ vols))
     where
         save x = StAssign (kindFromMagicId x) loc reg
                    where reg = StReg (StixMagicId x)
     where
         save x = StAssign (kindFromMagicId x) loc reg
                    where reg = StReg (StixMagicId x)
@@ -130,7 +130,7 @@ vsaves switches vols =
 
 vrests switches vols = 
     map restore ((filter callerSaves) 
 
 vrests switches vols = 
     map restore ((filter callerSaves) 
-       ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,ActivityReg,StkStubReg,StdUpdRetVecReg] ++ vols))
+       ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-},StkStubReg,StdUpdRetVecReg] ++ vols))
     where
         restore x = StAssign (kindFromMagicId x) reg loc
                    where reg = StReg (StixMagicId x)
     where
         restore x = StAssign (kindFromMagicId x) reg loc
                    where reg = StReg (StixMagicId x)
@@ -170,10 +170,16 @@ Setting up a sparc target.
 
 \begin{code}
 
 
 \begin{code}
 
-mkSparc :: Bool -> (GlobalSwitch -> SwitchResult) -> Target
+mkSparc :: Bool
+       -> (GlobalSwitch -> SwitchResult)
+       -> (Target,
+           (PprStyle -> [[StixTree]] -> SUniqSM Unpretty), -- codeGen
+           Bool,                                           -- underscore
+           (String -> String))                             -- fmtAsmLbl
 
 mkSparc decentOS switches = 
 
 mkSparc decentOS switches = 
-    let fhs' = fhs switches
+    let
+       fhs' = fhs switches
        vhs' = vhs switches
        sparcReg' = sparcReg switches
        vsaves' = vsaves switches
        vhs' = vhs switches
        sparcReg' = sparcReg switches
        vsaves' = vsaves switches
@@ -187,13 +193,11 @@ mkSparc decentOS switches =
        dhs' = dhs switches
        ps = genPrimCode target
        mc = genMacroCode target
        dhs' = dhs switches
        ps = genPrimCode target
        mc = genMacroCode target
-       hc = doHeapCheck target
-       target = mkTarget switches fhs' vhs' sparcReg' id size vsaves' vrests' 
-                         hprel as as' csz isz mhs' dhs' ps mc hc
-                         sparcCodeGen decentOS id
-    in target
-
+       hc = doHeapCheck --UNUSED NOW: target
+       target = mkTarget {-switches-} fhs' vhs' sparcReg' {-id-} size
+                         hprel as as'
+                         (vsaves', vrests', csz, isz, mhs', dhs', ps, mc, hc)
+                         {-sparcCodeGen decentOS id-}
+    in
+    (target, sparcCodeGen, decentOS, id)
 \end{code}
 \end{code}
-            
-
-
index f4bc7f0..2a32fbc 100644 (file)
@@ -10,9 +10,8 @@ import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+data CSeq 
+data PprStyle 
+data StixTree 
 sparcCodeGen :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq
 sparcCodeGen :: PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 211 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index f5bc3a0..b271591 100644 (file)
@@ -308,7 +308,6 @@ getReg (StPrim primop args) =
        IntSubOp -> trivialCode (SUB False False) args
        IntMulOp -> call SLIT(".umul") IntKind
        IntQuotOp -> call SLIT(".div") IntKind
        IntSubOp -> trivialCode (SUB False False) args
        IntMulOp -> call SLIT(".umul") IntKind
        IntQuotOp -> call SLIT(".div") IntKind
-       IntDivOp -> call SLIT("stg_div") IntKind
        IntRemOp -> call SLIT(".rem") IntKind
        IntNegOp -> trivialUCode (SUB False False g0) args
        IntAbsOp -> absIntCode args
        IntRemOp -> call SLIT(".rem") IntKind
        IntNegOp -> trivialUCode (SUB False False g0) args
        IntAbsOp -> absIntCode args
index 12f2211..4f371d1 100644 (file)
@@ -10,54 +10,32 @@ import PrimOps(PrimOp)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import UniType(UniType)
 import Unique(Unique)
 import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import UniType(UniType)
 import Unique(Unique)
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data MagicId 
 data CLabel 
 data CodeSegment   = DataSegment | TextSegment
 data CLabel 
 data CodeSegment   = DataSegment | TextSegment
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
+data PrimKind 
+data PrimOp 
 type SUniqSM a = SplitUniqSupply -> a
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data SplitUniqSupply 
 data StixReg   = StixMagicId MagicId | StixTemp Unique PrimKind
 data StixTree   = StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString
 type StixTreeList = [StixTree] -> [StixTree]
 data StixReg   = StixMagicId MagicId | StixTemp Unique PrimKind
 data StixTree   = StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString
 type StixTreeList = [StixTree] -> [StixTree]
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 getUniqLabelNCG :: SplitUniqSupply -> CLabel
 getUniqLabelNCG :: SplitUniqSupply -> CLabel
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 sStLitLbl :: _PackedString -> StixTree
 sStLitLbl :: _PackedString -> StixTree
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-stgActivityReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgBaseReg :: StixTree
 stgBaseReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgHp :: StixTree
 stgHp :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgHpLim :: StixTree
 stgHpLim :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgLivenessReg :: StixTree
 stgLivenessReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgNode :: StixTree
 stgNode :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgRetReg :: StixTree
 stgRetReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgSpA :: StixTree
 stgSpA :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgSpB :: StixTree
 stgSpB :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgStdUpdRetVecReg :: StixTree
 stgStdUpdRetVecReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgStkOReg :: StixTree
 stgStkOReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgStkStubReg :: StixTree
 stgStkStubReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgSuA :: StixTree
 stgSuA :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgSuB :: StixTree
 stgSuB :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgTagReg :: StixTree
 stgTagReg :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instance Eq CodeSegment
 instance Eq CodeSegment
-       {-# GHC_PRAGMA _M_ Stix {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(CodeSegment -> CodeSegment -> Bool), (CodeSegment -> CodeSegment -> Bool)] [_CONSTM_ Eq (==) (CodeSegment), _CONSTM_ Eq (/=) (CodeSegment)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 
 
index 321e58d..e2d4aa7 100644 (file)
@@ -11,7 +11,8 @@ module Stix (
 
        stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg, 
        stgSpA, stgSuA, stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg,
 
        stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg, 
        stgSpA, stgSuA, stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg,
-       stgActivityReg, stgStdUpdRetVecReg, stgStkStubReg,
+--     stgActivityReg,
+       stgStdUpdRetVecReg, stgStkStubReg,
        getUniqLabelNCG,
 
        -- And for self-sufficiency, by golly...
        getUniqLabelNCG,
 
        -- And for self-sufficiency, by golly...
@@ -147,7 +148,7 @@ type StixTreeList = [StixTree] -> [StixTree]
 \begin{code}
 
 stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg, stgSpA, stgSuA,
 \begin{code}
 
 stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg, stgSpA, stgSuA,
-    stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg, stgActivityReg, stgStdUpdRetVecReg,
+    stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg{-, stgActivityReg-}, stgStdUpdRetVecReg,
     stgStkStubReg :: StixTree
 
 stgBaseReg = StReg (StixMagicId BaseReg)
     stgStkStubReg :: StixTree
 
 stgBaseReg = StReg (StixMagicId BaseReg)
@@ -163,7 +164,7 @@ stgSuB = StReg (StixMagicId SuB)
 stgHp = StReg (StixMagicId Hp)
 stgHpLim = StReg (StixMagicId HpLim)
 stgLivenessReg = StReg (StixMagicId LivenessReg)
 stgHp = StReg (StixMagicId Hp)
 stgHpLim = StReg (StixMagicId HpLim)
 stgLivenessReg = StReg (StixMagicId LivenessReg)
-stgActivityReg = StReg (StixMagicId ActivityReg)
+--stgActivityReg = StReg (StixMagicId ActivityReg)
 stgStdUpdRetVecReg = StReg (StixMagicId StdUpdRetVecReg)
 stgStkStubReg = StReg (StixMagicId StkStubReg)
 
 stgStdUpdRetVecReg = StReg (StixMagicId StdUpdRetVecReg)
 stgStkStubReg = StReg (StixMagicId StkStubReg)
 
index 3856c3d..686d508 100644 (file)
@@ -1,9 +1,8 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StixInfo where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StixInfo where
-import AbsCSyn(AbstractC)
-import MachDesc(Target)
+import AbsCSyn(AbstractC, CAddrMode)
+import HeapOffs(HeapOffset)
 import SplitUniq(SplitUniqSupply)
 import Stix(StixTree)
 import SplitUniq(SplitUniqSupply)
 import Stix(StixTree)
-genCodeInfoTable :: Target -> AbstractC -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
+genCodeInfoTable :: (HeapOffset -> Int) -> (CAddrMode -> StixTree) -> AbstractC -> SplitUniqSupply -> [StixTree] -> [StixTree]
 
 
index 9f1747f..b976193 100644 (file)
@@ -37,11 +37,13 @@ data___rtbl = sStLitLbl SLIT("Data___rtbl")
 dyn___rtbl     = sStLitLbl SLIT("Dyn___rtbl")
 
 genCodeInfoTable
 dyn___rtbl     = sStLitLbl SLIT("Dyn___rtbl")
 
 genCodeInfoTable
-    :: Target
+    :: {-Target-}
+       (HeapOffset -> Int)     -- needed bit of Target
+    -> (CAddrMode -> StixTree) -- ditto
     -> AbstractC
     -> SUniqSM StixTreeList
 
     -> AbstractC
     -> SUniqSM StixTreeList
 
-genCodeInfoTable target (CClosureInfoAndCode cl_info _ _ upd cl_descr) =
+genCodeInfoTable hp_rel amode2stix (CClosureInfoAndCode cl_info _ _ upd cl_descr _) =
     returnSUs (\xs -> info : lbl : xs)
 
     where
     returnSUs (\xs -> info : lbl : xs)
 
     where
@@ -132,10 +134,10 @@ genCodeInfoTable target (CClosureInfoAndCode cl_info _ _ upd cl_descr) =
 
        size    = if isSpecRep sm_rep
                  then closureNonHdrSize cl_info
 
        size    = if isSpecRep sm_rep
                  then closureNonHdrSize cl_info
-                 else hpRel target (closureSizeWithoutFixedHdr cl_info)
+                 else hp_rel (closureSizeWithoutFixedHdr cl_info)
        ptrs    = closurePtrsSize cl_info
 
        ptrs    = closurePtrsSize cl_info
 
-       upd_code = amodeToStix target upd
+       upd_code = amode2stix upd
 
        info_unused = StInt (-1)
 
 
        info_unused = StInt (-1)
 
index 9e83145..889d352 100644 (file)
@@ -6,22 +6,13 @@ import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import SplitUniq(SplitUniqSupply)
 import Stix(StixTree)
 import PrimKind(PrimKind)
 import SplitUniq(SplitUniqSupply)
 import Stix(StixTree)
-decodeFloatingKind :: PrimKind -> Target -> [CAddrMode] -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 4 _U_ 121102 _N_ _N_ _N_ _N_ #-}
-encodeFloatingKind :: PrimKind -> Target -> [CAddrMode] -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 4 _U_ 121122 _N_ _S_ "LLSL" _N_ _N_ #-}
-gmpCompare :: Target -> CAddrMode -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 3 _U_ 22102 _N_ _N_ _N_ _N_ #-}
-gmpInt2Integer :: Target -> [CAddrMode] -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 3 _U_ 21122 _N_ _S_ "LLS" _N_ _N_ #-}
-gmpInteger2Int :: Target -> CAddrMode -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 3 _U_ 22102 _N_ _N_ _N_ _N_ #-}
-gmpString2Integer :: Target -> [CAddrMode] -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 3 _U_ 21122 _N_ _S_ "U(ALLLAAAAALAAAALASAAAA)LS" _N_ _N_ #-}
-gmpTake1Return1 :: Target -> [CAddrMode] -> _PackedString -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 4 _U_ 212122 _N_ _S_ "U(AAALAAAAALAAAALAASAAA)LLL" _N_ _N_ #-}
-gmpTake2Return1 :: Target -> [CAddrMode] -> _PackedString -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 4 _U_ 212122 _N_ _S_ "U(AAALAAAAALAAAALAASAAA)LLL" _N_ _N_ #-}
-gmpTake2Return2 :: Target -> [CAddrMode] -> _PackedString -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 4 _U_ 212122 _N_ _S_ "U(AAALAAAAALAAAALAASAAA)LLL" _N_ _N_ #-}
+decodeFloatingKind :: PrimKind -> Target -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> (CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+encodeFloatingKind :: PrimKind -> Target -> CAddrMode -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpCompare :: Target -> CAddrMode -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpInt2Integer :: Target -> (CAddrMode, CAddrMode, CAddrMode) -> (CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpInteger2Int :: Target -> CAddrMode -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpString2Integer :: Target -> (CAddrMode, CAddrMode, CAddrMode) -> (CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpTake1Return1 :: Target -> (CAddrMode, CAddrMode, CAddrMode) -> _PackedString -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpTake2Return1 :: Target -> (CAddrMode, CAddrMode, CAddrMode) -> _PackedString -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
+gmpTake2Return2 :: Target -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> _PackedString -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode, CAddrMode) -> SplitUniqSupply -> [StixTree] -> [StixTree]
 
 
index 1051d26..a5268be 100644 (file)
@@ -33,9 +33,10 @@ import Util
 
 gmpTake1Return1 
     :: Target 
 
 gmpTake1Return1 
     :: Target 
-    -> [CAddrMode]         -- result (3 parts)
-    -> FAST_STRING         -- function name
-    -> [CAddrMode]         -- argument (3 parts)
+    -> (CAddrMode,CAddrMode,CAddrMode)  -- result (3 parts)
+    -> FAST_STRING                     -- function name
+    -> (CAddrMode, CAddrMode,CAddrMode,CAddrMode)
+                                       -- argument (4 parts)
     -> SUniqSM StixTreeList
 
 argument1 = mpStruct 1 -- out here to avoid CAF (sigh)
     -> SUniqSM StixTreeList
 
 argument1 = mpStruct 1 -- out here to avoid CAF (sigh)
@@ -47,46 +48,71 @@ init2 = StCall SLIT("mpz_init") VoidKind [result2]
 init3 = StCall SLIT("mpz_init") VoidKind [result3]
 init4 = StCall SLIT("mpz_init") VoidKind [result4]
 
 init3 = StCall SLIT("mpz_init") VoidKind [result3]
 init4 = StCall SLIT("mpz_init") VoidKind [result4]
 
-gmpTake1Return1 target res rtn arg =
-    let        [ar,sr,dr] = map (amodeToStix target) res
-       [liveness, aa,sa,da] = map (amodeToStix target) arg
-       space = mpSpace target 2 1 [sa]
+-- hacking with Uncle Will:
+#define target_STRICT target@(Target _ _ _ _ _ _ _ _)
+
+gmpTake1Return1 target_STRICT res@(car,csr,cdr) rtn arg@(clive,caa,csa,cda) =
+    let
+       a2stix  = amodeToStix target
+       data_hs = dataHS target
+
+       ar      = a2stix car
+       sr      = a2stix csr
+       dr      = a2stix cdr
+       liveness= a2stix clive
+       aa      = a2stix caa
+       sa      = a2stix csa      
+       da      = a2stix cda      
+
+       space = mpSpace data_hs 2 1 [sa]
        oldHp = StIndex PtrKind stgHp (StPrim IntNegOp [space])
        safeHp = saveLoc target Hp
        save = StAssign PtrKind safeHp oldHp
        oldHp = StIndex PtrKind stgHp (StPrim IntNegOp [space])
        safeHp = saveLoc target Hp
        save = StAssign PtrKind safeHp oldHp
-       (a1,a2,a3) = toStruct target argument1 (aa,sa,da)
+       (a1,a2,a3) = toStruct data_hs argument1 (aa,sa,da)
        mpz_op = StCall rtn VoidKind [result2, argument1]
        restore = StAssign PtrKind stgHp safeHp
        mpz_op = StCall rtn VoidKind [result2, argument1]
        restore = StAssign PtrKind stgHp safeHp
-       (r1,r2,r3) = fromStruct target result2 (ar,sr,dr)
+       (r1,r2,r3) = fromStruct data_hs result2 (ar,sr,dr)
     in
     in
-       heapCheck target liveness space (StInt 0)
-                                                       `thenSUs` \ heap_chk ->
+       heapCheck target liveness space (StInt 0) `thenSUs` \ heap_chk ->
 
        returnSUs (heap_chk . 
            (\xs -> a1 : a2 : a3 : save : init2 : mpz_op : r1 : r2 : r3 : restore : xs))
 
 gmpTake2Return1 
     :: Target 
 
        returnSUs (heap_chk . 
            (\xs -> a1 : a2 : a3 : save : init2 : mpz_op : r1 : r2 : r3 : restore : xs))
 
 gmpTake2Return1 
     :: Target 
-    -> [CAddrMode]         -- result (3 parts)
-    -> FAST_STRING         -- function name
-    -> [CAddrMode]         -- arguments (3 parts each)
+    -> (CAddrMode,CAddrMode,CAddrMode) -- result (3 parts)
+    -> FAST_STRING                     -- function name
+    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+                                       -- liveness + 2 arguments (3 parts each)
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-gmpTake2Return1 target res rtn args =
-    let        [ar,sr,dr] = map (amodeToStix target) res
-       [liveness, aa1,sa1,da1, aa2,sa2,da2] = map (amodeToStix target) args
-       space = mpSpace target 3 1 [sa1, sa2]
+gmpTake2Return1 target_STRICT res@(car,csr,cdr) rtn args@(clive, caa1,csa1,cda1, caa2,csa2,cda2) =
+    let
+       a2stix  = amodeToStix target
+       data_hs = dataHS target
+
+       ar      = a2stix car
+       sr      = a2stix csr
+       dr      = a2stix cdr
+       liveness= a2stix clive
+       aa1     = a2stix caa1
+       sa1     = a2stix csa1
+       da1     = a2stix cda1
+       aa2     = a2stix caa2
+       sa2     = a2stix csa2
+       da2     = a2stix cda2
+
+       space = mpSpace data_hs 3 1 [sa1, sa2]
        oldHp = StIndex PtrKind stgHp (StPrim IntNegOp [space])
        safeHp = saveLoc target Hp
        save = StAssign PtrKind safeHp oldHp
        oldHp = StIndex PtrKind stgHp (StPrim IntNegOp [space])
        safeHp = saveLoc target Hp
        save = StAssign PtrKind safeHp oldHp
-       (a1,a2,a3) = toStruct target argument1 (aa1,sa1,da1)
-       (a4,a5,a6) = toStruct target argument2 (aa2,sa2,da2)
+       (a1,a2,a3) = toStruct data_hs argument1 (aa1,sa1,da1)
+       (a4,a5,a6) = toStruct data_hs argument2 (aa2,sa2,da2)
        mpz_op = StCall rtn VoidKind [result3, argument1, argument2]
        restore = StAssign PtrKind stgHp safeHp
        mpz_op = StCall rtn VoidKind [result3, argument1, argument2]
        restore = StAssign PtrKind stgHp safeHp
-       (r1,r2,r3) = fromStruct target result3 (ar,sr,dr)
+       (r1,r2,r3) = fromStruct data_hs result3 (ar,sr,dr)
     in
     in
-       heapCheck target liveness space (StInt 0)
-                                                       `thenSUs` \ heap_chk ->
+       heapCheck target liveness space (StInt 0) `thenSUs` \ heap_chk ->
 
        returnSUs (heap_chk .
            (\xs -> a1 : a2 : a3 : a4 : a5 : a6 
 
        returnSUs (heap_chk .
            (\xs -> a1 : a2 : a3 : a4 : a5 : a6 
@@ -94,28 +120,46 @@ gmpTake2Return1 target res rtn args =
 
 gmpTake2Return2
     :: Target 
 
 gmpTake2Return2
     :: Target 
-    -> [CAddrMode]         -- results (3 parts each)
+    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+                           -- 2 results (3 parts each)
     -> FAST_STRING         -- function name
     -> FAST_STRING         -- function name
-    -> [CAddrMode]         -- arguments (3 parts each)
+    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+                           -- liveness + 2 arguments (3 parts each)
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-gmpTake2Return2 target res rtn args =
-    let        [ar1,sr1,dr1, ar2,sr2,dr2] = map (amodeToStix target) res
-       [liveness, aa1,sa1,da1, aa2,sa2,da2] = map (amodeToStix target) args
-       space = StPrim IntMulOp [mpSpace target 2 1 [sa1, sa2], StInt 2]
+gmpTake2Return2 target_STRICT res@(car1,csr1,cdr1, car2,csr2,cdr2)
+               rtn args@(clive, caa1,csa1,cda1, caa2,csa2,cda2) =
+    let
+       a2stix  = amodeToStix target
+       data_hs = dataHS target
+
+       ar1     = a2stix car1     
+       sr1     = a2stix csr1     
+       dr1     = a2stix cdr1     
+       ar2     = a2stix car2     
+       sr2     = a2stix csr2     
+       dr2     = a2stix cdr2     
+       liveness= a2stix clive
+       aa1     = a2stix caa1     
+       sa1     = a2stix csa1     
+       da1     = a2stix cda1     
+       aa2     = a2stix caa2     
+       sa2     = a2stix csa2
+       da2     = a2stix cda2
+
+       space = StPrim IntMulOp [mpSpace data_hs 2 1 [sa1, sa2], StInt 2]
        oldHp = StIndex PtrKind stgHp (StPrim IntNegOp [space])
        safeHp = saveLoc target Hp
        save = StAssign PtrKind safeHp oldHp
        oldHp = StIndex PtrKind stgHp (StPrim IntNegOp [space])
        safeHp = saveLoc target Hp
        save = StAssign PtrKind safeHp oldHp
-       (a1,a2,a3) = toStruct target argument1 (aa1,sa1,da1)
-       (a4,a5,a6) = toStruct target argument2 (aa2,sa2,da2)
+       (a1,a2,a3) = toStruct data_hs argument1 (aa1,sa1,da1)
+       (a4,a5,a6) = toStruct data_hs argument2 (aa2,sa2,da2)
        mpz_op = StCall rtn VoidKind [result3, result4, argument1, argument2]
        restore = StAssign PtrKind stgHp safeHp
        mpz_op = StCall rtn VoidKind [result3, result4, argument1, argument2]
        restore = StAssign PtrKind stgHp safeHp
-       (r1,r2,r3) = fromStruct target result3 (ar1,sr1,dr1)
-       (r4,r5,r6) = fromStruct target result4 (ar2,sr2,dr2)
+       (r1,r2,r3) = fromStruct data_hs result3 (ar1,sr1,dr1)
+       (r4,r5,r6) = fromStruct data_hs result4 (ar2,sr2,dr2)
 
     in
 
     in
-       heapCheck target liveness space (StInt 0)
-                                                       `thenSUs` \ heap_chk ->
+       heapCheck target liveness space (StInt 0) `thenSUs` \ heap_chk ->
 
        returnSUs (heap_chk .
            (\xs -> a1 : a2 : a3 : a4 : a5 : a6 
 
        returnSUs (heap_chk .
            (\xs -> a1 : a2 : a3 : a4 : a5 : a6 
@@ -124,26 +168,38 @@ gmpTake2Return2 target res rtn args =
 
 \end{code}
 
 
 \end{code}
 
-Although gmpCompare doesn't allocate space, it does temporarily use some
-space just beyond the heap pointer.  This is safe, because the enclosing
-routine has already guaranteed that this space will be available.  
-(See ``primOpHeapRequired.'')
+Although gmpCompare doesn't allocate space, it does temporarily use
+some space just beyond the heap pointer.  This is safe, because the
+enclosing routine has already guaranteed that this space will be
+available.  (See ``primOpHeapRequired.'')
 
 \begin{code}
 
 gmpCompare 
     :: Target 
     -> CAddrMode           -- result (boolean)
 
 \begin{code}
 
 gmpCompare 
     :: Target 
     -> CAddrMode           -- result (boolean)
-    -> [CAddrMode]         -- arguments (3 parts each)
+    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+                           -- alloc hp + 2 arguments (3 parts each)
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-gmpCompare target res args =
-    let        result = amodeToStix target res
-       [hp, aa1,sa1,da1, aa2,sa2,da2] = map (amodeToStix target) args
+gmpCompare target_STRICT res args@(chp, caa1,csa1,cda1, caa2,csa2,cda2) =
+    let
+       a2stix  = amodeToStix target
+       data_hs = dataHS target
+
+       result  = a2stix res
+       hp      = a2stix chp      
+       aa1     = a2stix caa1
+       sa1     = a2stix csa1
+       da1     = a2stix cda1
+       aa2     = a2stix caa2
+       sa2     = a2stix csa2
+       da2     = a2stix cda2
+
        argument1 = hp
        argument2 = StIndex IntKind hp (StInt (toInteger mpIntSize))
        argument1 = hp
        argument2 = StIndex IntKind hp (StInt (toInteger mpIntSize))
-       (a1,a2,a3) = toStruct target argument1 (aa1,sa1,da1)
-       (a4,a5,a6) = toStruct target argument2 (aa2,sa2,da2)
+       (a1,a2,a3) = toStruct data_hs argument1 (aa1,sa1,da1)
+       (a4,a5,a6) = toStruct data_hs argument2 (aa2,sa2,da2)
        mpz_cmp = StCall SLIT("mpz_cmp") IntKind [argument1, argument2]
        r1 = StAssign IntKind result mpz_cmp
     in
        mpz_cmp = StCall SLIT("mpz_cmp") IntKind [argument1, argument2]
        r1 = StAssign IntKind result mpz_cmp
     in
@@ -158,13 +214,21 @@ See the comment above regarding the heap check (or lack thereof).
 gmpInteger2Int 
     :: Target 
     -> CAddrMode           -- result
 gmpInteger2Int 
     :: Target 
     -> CAddrMode           -- result
-    -> [CAddrMode]         -- argument (3 parts)
+    -> (CAddrMode, CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-gmpInteger2Int target res args =
-    let        result = amodeToStix target res
-       [hp, aa,sa,da] = map (amodeToStix target) args
-       (a1,a2,a3) = toStruct target hp (aa,sa,da)
+gmpInteger2Int target_STRICT res args@(chp, caa,csa,cda) =
+    let
+       a2stix  = amodeToStix target
+       data_hs = dataHS target
+
+       result  = a2stix res
+       hp      = a2stix chp
+       aa      = a2stix caa
+       sa      = a2stix csa
+       da      = a2stix cda
+
+       (a1,a2,a3) = toStruct data_hs hp (aa,sa,da)
        mpz_get_si = StCall SLIT("mpz_get_si") IntKind [hp]
        r1 = StAssign IntKind result mpz_get_si
     in
        mpz_get_si = StCall SLIT("mpz_get_si") IntKind [hp]
        r1 = StAssign IntKind result mpz_get_si
     in
@@ -174,16 +238,23 @@ arrayOfData_info = sStLitLbl SLIT("ArrayOfData_info")
 
 gmpInt2Integer 
     :: Target 
 
 gmpInt2Integer 
     :: Target 
-    -> [CAddrMode]         -- result (3 parts)
-    -> [CAddrMode]         -- allocated heap, int to convert
+    -> (CAddrMode, CAddrMode, CAddrMode) -- result (3 parts)
+    -> (CAddrMode, CAddrMode)  -- allocated heap, Int to convert
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-gmpInt2Integer target res args@[_, n] =
-    getUniqLabelNCG                                    `thenSUs` \ zlbl ->
-    getUniqLabelNCG                                    `thenSUs` \ nlbl ->
-    getUniqLabelNCG                                    `thenSUs` \ jlbl ->
-    let        [ar,sr,dr] = map (amodeToStix target) res
-        [hp, i] = map (amodeToStix target) args
+gmpInt2Integer target_STRICT res@(car,csr,cdr) args@(chp, n) =
+    getUniqLabelNCG                    `thenSUs` \ zlbl ->
+    getUniqLabelNCG                    `thenSUs` \ nlbl ->
+    getUniqLabelNCG                    `thenSUs` \ jlbl ->
+    let
+       a2stix = amodeToStix target
+
+       ar  = a2stix car
+       sr  = a2stix csr
+       dr  = a2stix cdr
+        hp  = a2stix chp
+       i   = a2stix n
+
        h1 = StAssign PtrKind (StInd PtrKind hp) arrayOfData_info
        size = varHeaderSize target (DataRep 0) + mIN_MP_INT_SIZE
        h2 = StAssign IntKind (StInd IntKind (StIndex IntKind hp (StInt 1)))
        h1 = StAssign PtrKind (StInd PtrKind hp) arrayOfData_info
        size = varHeaderSize target (DataRep 0) + mIN_MP_INT_SIZE
        h2 = StAssign IntKind (StInd IntKind (StIndex IntKind hp (StInt 1)))
@@ -222,13 +293,20 @@ gmpInt2Integer target res args@[_, n] =
 
 gmpString2Integer 
     :: Target 
 
 gmpString2Integer 
     :: Target 
-    -> [CAddrMode]         -- result (3 parts)
-    -> [CAddrMode]         -- liveness, string
+    -> (CAddrMode, CAddrMode, CAddrMode)    -- result (3 parts)
+    -> (CAddrMode, CAddrMode)              -- liveness, string
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-gmpString2Integer target res [liveness, str] =
+gmpString2Integer target_STRICT res@(car,csr,cdr) (liveness, str) =
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let        [ar,sr,dr] = map (amodeToStix target) res
+    let
+       a2stix  = amodeToStix target
+       data_hs = dataHS target
+
+       ar = a2stix car
+       sr = a2stix csr
+       dr = a2stix cdr
+
        len = case str of
            (CString s) -> _LENGTH_ s
            (CLit (MachStr s)) -> _LENGTH_ s
        len = case str of
            (CString s) -> _LENGTH_ s
            (CLit (MachStr s)) -> _LENGTH_ s
@@ -240,13 +318,13 @@ gmpString2Integer target res [liveness, str] =
        save = StAssign PtrKind safeHp oldHp
        result = StIndex IntKind stgHpLim (StInt (toInteger (-mpIntSize)))
        set_str = StCall SLIT("mpz_init_set_str") IntKind
        save = StAssign PtrKind safeHp oldHp
        result = StIndex IntKind stgHpLim (StInt (toInteger (-mpIntSize)))
        set_str = StCall SLIT("mpz_init_set_str") IntKind
-           [result, amodeToStix target str, StInt 10]
+           [result, a2stix str, StInt 10]
        test = StPrim IntEqOp [set_str, StInt 0]
        cjmp = StCondJump ulbl test
        abort = StCall SLIT("abort") VoidKind []
        join = StLabel ulbl
        restore = StAssign PtrKind stgHp safeHp
        test = StPrim IntEqOp [set_str, StInt 0]
        cjmp = StCondJump ulbl test
        abort = StCall SLIT("abort") VoidKind []
        join = StLabel ulbl
        restore = StAssign PtrKind stgHp safeHp
-       (a1,a2,a3) = fromStruct target result (ar,sr,dr)
+       (a1,a2,a3) = fromStruct data_hs result (ar,sr,dr)
     in
        macroCode target HEAP_CHK [liveness, mkIntCLit space, mkIntCLit_0]
                                                        `thenSUs` \ heap_chk ->
     in
        macroCode target HEAP_CHK [liveness, mkIntCLit space, mkIntCLit_0]
                                                        `thenSUs` \ heap_chk ->
@@ -259,16 +337,28 @@ mkIntCLit_0 = mkIntCLit 0 -- out here to avoid CAF (sigh)
 encodeFloatingKind 
     :: PrimKind 
     -> Target 
 encodeFloatingKind 
     :: PrimKind 
     -> Target 
-    -> [CAddrMode]     -- result
-    -> [CAddrMode]     -- heap pointer for result, integer argument (3 parts), exponent
+    -> CAddrMode       -- result
+    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+               -- heap pointer for result, integer argument (3 parts), exponent
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-encodeFloatingKind pk target [res] args =
-    let        result = amodeToStix target res
-       [hp, aa,sa,da, expon] = map (amodeToStix target) args
-        pk' = if sizeof target FloatKind == sizeof target DoubleKind then DoubleKind
+encodeFloatingKind pk target_STRICT res args@(chp, caa,csa,cda, cexpon) =
+    let
+       a2stix  = amodeToStix target
+       size_of = sizeof target
+       data_hs = dataHS target
+
+       result  = a2stix res
+       hp      = a2stix chp      
+       aa      = a2stix caa      
+       sa      = a2stix csa      
+       da      = a2stix cda      
+       expon   = a2stix cexpon
+
+        pk' = if size_of FloatKind == size_of DoubleKind
+             then DoubleKind
               else pk
               else pk
-       (a1,a2,a3) = toStruct target hp (aa,sa,da)
+       (a1,a2,a3) = toStruct data_hs hp (aa,sa,da)
        fn = case pk' of
            FloatKind -> SLIT("__encodeFloat")
            DoubleKind -> SLIT("__encodeDouble")
        fn = case pk' of
            FloatKind -> SLIT("__encodeFloat")
            DoubleKind -> SLIT("__encodeDouble")
@@ -281,14 +371,27 @@ encodeFloatingKind pk target [res] args =
 decodeFloatingKind 
     :: PrimKind 
     -> Target 
 decodeFloatingKind 
     :: PrimKind 
     -> Target 
-    -> [CAddrMode]         -- exponent result, integer result (3 parts)
-    -> [CAddrMode]         -- heap pointer for exponent, floating argument
+    -> (CAddrMode, CAddrMode, CAddrMode, CAddrMode)
+                       -- exponent result, integer result (3 parts)
+    -> (CAddrMode, CAddrMode)
+                       -- heap pointer for exponent, floating argument
     -> SUniqSM StixTreeList
 
     -> SUniqSM StixTreeList
 
-decodeFloatingKind pk target res args =
-    let        [exponr,ar,sr,dr] = map (amodeToStix target) res
-        [hp, arg] = map (amodeToStix target) args
-        pk' = if sizeof target FloatKind == sizeof target DoubleKind then DoubleKind
+decodeFloatingKind pk target_STRICT res@(cexponr,car,csr,cdr) args@(chp, carg) =
+    let
+       a2stix  = amodeToStix target
+       size_of = sizeof target
+       data_hs = dataHS target
+
+       exponr  = a2stix cexponr  
+       ar      = a2stix car      
+       sr      = a2stix csr      
+       dr      = a2stix cdr      
+        hp     = a2stix chp      
+       arg     = a2stix carg     
+
+        pk' = if size_of FloatKind == size_of DoubleKind
+             then DoubleKind
               else pk
         setup = StAssign PtrKind mpData_mantissa (StIndex IntKind hp (StInt 1))
        fn = case pk' of
               else pk
         setup = StAssign PtrKind mpData_mantissa (StIndex IntKind hp (StInt 1))
        fn = case pk' of
@@ -296,7 +399,7 @@ decodeFloatingKind pk target res args =
            DoubleKind -> SLIT("__decodeDouble")
            _ -> panic "decodeFloatingKind"
        decode = StCall fn VoidKind [mantissa, hp, arg]
            DoubleKind -> SLIT("__decodeDouble")
            _ -> panic "decodeFloatingKind"
        decode = StCall fn VoidKind [mantissa, hp, arg]
-       (a1,a2,a3) = fromStruct target mantissa (ar,sr,dr)
+       (a1,a2,a3) = fromStruct data_hs mantissa (ar,sr,dr)
        a4 = StAssign IntKind exponr (StInd IntKind hp)
     in
        returnSUs (\xs -> setup : decode : a1 : a2 : a3 : a4 : xs)
        a4 = StAssign IntKind exponr (StInd IntKind hp)
     in
        returnSUs (\xs -> setup : decode : a1 : a2 : a3 : a4 : xs)
@@ -317,18 +420,18 @@ mpSize base = StInd IntKind (StIndex IntKind base (StInt 1))
 mpData base = StInd PtrKind (StIndex IntKind base (StInt 2))
 
 mpSpace 
 mpData base = StInd PtrKind (StIndex IntKind base (StInt 2))
 
 mpSpace 
-    :: Target
+    :: StixTree                -- dataHs from Target
     -> Int             -- gmp structures needed
     -> Int             -- number of results
     -> [StixTree]      -- sizes to add for estimating result size
     -> StixTree        -- total space
 
     -> Int             -- gmp structures needed
     -> Int             -- number of results
     -> [StixTree]      -- sizes to add for estimating result size
     -> StixTree        -- total space
 
-mpSpace target gmp res sizes = 
+mpSpace data_hs gmp res sizes = 
     foldr sum (StPrim IntAddOp [fixed, hdrs]) sizes
   where
     sum x y = StPrim IntAddOp [StPrim IntAbsOp [x], y]
     fixed = StInt (toInteger (17 * res + gmp * mpIntSize))
     foldr sum (StPrim IntAddOp [fixed, hdrs]) sizes
   where
     sum x y = StPrim IntAddOp [StPrim IntAbsOp [x], y]
     fixed = StInt (toInteger (17 * res + gmp * mpIntSize))
-    hdrs = StPrim IntMulOp [dataHS target, StInt (toInteger res)]
+    hdrs = StPrim IntMulOp [data_hs, StInt (toInteger res)]
 
 \end{code}
 
 
 \end{code}
 
@@ -338,39 +441,36 @@ HpLim are our temporaries.)  Note that you must have performed a heap check
 which includes the space needed for these temporaries before you use them.
 
 \begin{code}
 which includes the space needed for these temporaries before you use them.
 
 \begin{code}
-
 mpStruct :: Int -> StixTree
 mpStruct n = StIndex IntKind stgHpLim (StInt (toInteger (-(n * mpIntSize))))
 
 toStruct 
 mpStruct :: Int -> StixTree
 mpStruct n = StIndex IntKind stgHpLim (StInt (toInteger (-(n * mpIntSize))))
 
 toStruct 
-    :: Target
+    :: StixTree                -- dataHS, from Target
     -> StixTree 
     -> (StixTree, StixTree, StixTree) 
     -> (StixTree, StixTree, StixTree) 
 
     -> StixTree 
     -> (StixTree, StixTree, StixTree) 
     -> (StixTree, StixTree, StixTree) 
 
-toStruct target str (alloc,size,arr) =
+toStruct data_hs str (alloc,size,arr) =
     let
        f1 = StAssign IntKind (mpAlloc str) alloc
        f2 = StAssign IntKind (mpSize str) size
     let
        f1 = StAssign IntKind (mpAlloc str) alloc
        f2 = StAssign IntKind (mpSize str) size
-       f3 = StAssign PtrKind (mpData str) (StIndex PtrKind arr (dataHS target))
+       f3 = StAssign PtrKind (mpData str) (StIndex PtrKind arr data_hs)
     in
        (f1, f2, f3)
 
 fromStruct 
     in
        (f1, f2, f3)
 
 fromStruct 
-    :: Target
+    :: StixTree                -- dataHS, from Target
     -> StixTree 
     -> (StixTree, StixTree, StixTree) 
     -> (StixTree, StixTree, StixTree) 
 
     -> StixTree 
     -> (StixTree, StixTree, StixTree) 
     -> (StixTree, StixTree, StixTree) 
 
-fromStruct target str (alloc,size,arr) =
+fromStruct data_hs str (alloc,size,arr) =
     let
        e1 = StAssign IntKind alloc (mpAlloc str)
        e2 = StAssign IntKind size (mpSize str)
        e3 = StAssign PtrKind arr (StIndex PtrKind (mpData str) 
     let
        e1 = StAssign IntKind alloc (mpAlloc str)
        e2 = StAssign IntKind size (mpSize str)
        e3 = StAssign PtrKind arr (StIndex PtrKind (mpData str) 
-                                                  (StPrim IntNegOp [dataHS target]))
+                                                  (StPrim IntNegOp [data_hs]))
     in
        (e1, e2, e3)
     in
        (e1, e2, e3)
-
-
 \end{code}
 
 \end{code}
 
index aa0f0ce..dba792d 100644 (file)
@@ -4,29 +4,24 @@ import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelativ
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
-import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import MachDesc(RegLoc, Target)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import MachDesc(RegLoc, Target)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
-import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep)
 import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import Unique(Unique)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep)
 import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import Unique(Unique)
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CExprMacro        {-# GHC_PRAGMA INFO_PTR | ENTRY_CODE | INFO_TAG | EVAL_TAG #-}
-data CStmtMacro        {-# GHC_PRAGMA ARGS_CHK_A_LOAD_NODE | ARGS_CHK_A | ARGS_CHK_B_LOAD_NODE | ARGS_CHK_B | HEAP_CHK | STK_CHK | UPD_CAF | UPD_IND | UPD_INPLACE_NOPTRS | UPD_INPLACE_PTRS | UPD_BH_UPDATABLE | UPD_BH_SINGLE_ENTRY | PUSH_STD_UPD_FRAME | POP_STD_UPD_FRAME | SET_ARITY | CHK_ARITY | SET_TAG #-}
-data Target    {-# GHC_PRAGMA Target (GlobalSwitch -> SwitchResult) Int (SMRep -> Int) (MagicId -> RegLoc) (StixTree -> StixTree) (PrimKind -> Int) ([MagicId] -> [StixTree]) ([MagicId] -> [StixTree]) (HeapOffset -> Int) (CAddrMode -> StixTree) (CAddrMode -> StixTree) Int Int StixTree StixTree ([CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) Bool ([Char] -> [Char]) #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
-doHeapCheck :: Target -> StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 5 _U_ 022012 _N_ _S_ "ALLAU(ALA)" {_A_ 3 _U_ 2212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+data CAddrMode 
+data CExprMacro 
+data CStmtMacro 
+data Target 
+data SplitUniqSupply 
+data StixTree 
+doHeapCheck :: StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]
 genMacroCode :: Target -> CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
 genMacroCode :: Target -> CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 3 _U_ 21122 _N_ _S_ "LEL" _N_ _N_ #-}
 smStablePtrTable :: StixTree
 smStablePtrTable :: StixTree
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index d49158b..6f3e8c7 100644 (file)
@@ -35,15 +35,26 @@ closure address.
 mkIntCLit_0 = mkIntCLit 0 -- out here to avoid CAF (sigh)
 mkIntCLit_3 = mkIntCLit 3
 
 mkIntCLit_0 = mkIntCLit 0 -- out here to avoid CAF (sigh)
 mkIntCLit_3 = mkIntCLit 3
 
+-- hacking with Uncle Will:
+#define target_STRICT target@(Target _ _ _ _ _ _ _ _)
+
 genMacroCode 
     :: Target 
     -> CStmtMacro          -- statement macro
     -> [CAddrMode]         -- args
     -> SUniqSM StixTreeList
 
 genMacroCode 
     :: Target 
     -> CStmtMacro          -- statement macro
     -> [CAddrMode]         -- args
     -> SUniqSM StixTreeList
 
-genMacroCode target ARGS_CHK_A_LOAD_NODE args = 
+genMacroCode target_STRICT macro args
+ = genmacro macro args
+ where
+  a2stix  = amodeToStix target
+  stg_reg = stgReg target
+
+  -- real thing: here we go -----------------------
+
+  genmacro ARGS_CHK_A_LOAD_NODE args = 
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let [words, lbl] = map (amodeToStix target) args
+    let [words, lbl] = map a2stix args
        temp = StIndex PtrKind stgSpA words
        test = StPrim AddrGeOp [stgSuA, temp]
        cjmp = StCondJump ulbl test
        temp = StIndex PtrKind stgSpA words
        test = StPrim AddrGeOp [stgSuA, temp]
        cjmp = StCondJump ulbl test
@@ -52,9 +63,9 @@ genMacroCode target ARGS_CHK_A_LOAD_NODE args =
     in
        returnSUs (\xs -> cjmp : assign : updatePAP : join : xs)
 
     in
        returnSUs (\xs -> cjmp : assign : updatePAP : join : xs)
 
-genMacroCode target ARGS_CHK_A [words] = 
+  genmacro ARGS_CHK_A [words] = 
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let temp = StIndex PtrKind stgSpA (amodeToStix target words)
+    let temp = StIndex PtrKind stgSpA (a2stix words)
        test = StPrim AddrGeOp [stgSuA, temp]
        cjmp = StCondJump ulbl test
        join = StLabel ulbl
        test = StPrim AddrGeOp [stgSuA, temp]
        cjmp = StCondJump ulbl test
        join = StLabel ulbl
@@ -71,9 +82,9 @@ directions are swapped relative to the A stack.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target ARGS_CHK_B_LOAD_NODE args = 
+  genmacro ARGS_CHK_B_LOAD_NODE args = 
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let [words, lbl] = map (amodeToStix target) args
+    let [words, lbl] = map a2stix args
        temp = StIndex PtrKind stgSuB (StPrim IntNegOp [words])
        test = StPrim AddrGeOp [stgSpB, temp]
        cjmp = StCondJump ulbl test
        temp = StIndex PtrKind stgSuB (StPrim IntNegOp [words])
        test = StPrim AddrGeOp [stgSpB, temp]
        cjmp = StCondJump ulbl test
@@ -82,9 +93,9 @@ genMacroCode target ARGS_CHK_B_LOAD_NODE args =
     in
        returnSUs (\xs -> cjmp : assign : updatePAP : join : xs)
 
     in
        returnSUs (\xs -> cjmp : assign : updatePAP : join : xs)
 
-genMacroCode target ARGS_CHK_B [words] = 
+  genmacro ARGS_CHK_B [words] = 
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let        temp = StIndex PtrKind stgSuB (StPrim IntNegOp [amodeToStix target words])
+    let        temp = StIndex PtrKind stgSuB (StPrim IntNegOp [a2stix words])
        test = StPrim AddrGeOp [stgSpB, temp]
        cjmp = StCondJump ulbl test
        join = StLabel ulbl
        test = StPrim AddrGeOp [stgSpB, temp]
        cjmp = StCondJump ulbl test
        join = StLabel ulbl
@@ -103,10 +114,10 @@ primOps, this is just a wrapper.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target HEAP_CHK args =
-    let [liveness,words,reenter] = map (amodeToStix target) args
+  genmacro HEAP_CHK args =
+    let [liveness,words,reenter] = map a2stix args
     in
     in
-       doHeapCheck target liveness words reenter
+       doHeapCheck {-UNUSED NOW:target-} liveness words reenter
 
 \end{code}
 
 
 \end{code}
 
@@ -118,11 +129,11 @@ so we don't have to @callWrapper@ it.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target STK_CHK [liveness, aWords, bWords, spa, spb, prim, reenter] = 
+  genmacro STK_CHK [liveness, aWords, bWords, spa, spb, prim, reenter] = 
 {- Need to check to see if we are compiling with stack checks
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     let words = StPrim IntNegOp 
 {- Need to check to see if we are compiling with stack checks
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     let words = StPrim IntNegOp 
-           [StPrim IntAddOp [amodeToStix target aWords, amodeToStix target bWords]]
+           [StPrim IntAddOp [a2stix aWords, a2stix bWords]]
        temp = StIndex PtrKind stgSpA words
        test = StPrim AddrGtOp [temp, stgSpB]
        cjmp = StCondJump ulbl test
        temp = StIndex PtrKind stgSpA words
        test = StPrim AddrGtOp [temp, stgSpB]
        cjmp = StCondJump ulbl test
@@ -139,8 +150,8 @@ and putting the new CAF on a linked list for the storage manager.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target UPD_CAF args =
-    let [cafptr,bhptr] = map (amodeToStix target) args
+  genmacro UPD_CAF args =
+    let [cafptr,bhptr] = map a2stix args
        w0 = StInd PtrKind cafptr
        w1 = StInd PtrKind (StIndex PtrKind cafptr (StInt 1))
        w2 = StInd PtrKind (StIndex PtrKind cafptr (StInt 2))
        w0 = StInd PtrKind cafptr
        w1 = StInd PtrKind (StIndex PtrKind cafptr (StInt 1))
        w2 = StInd PtrKind (StIndex PtrKind cafptr (StInt 2))
@@ -159,9 +170,9 @@ if we update an old generation object.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target UPD_IND args = 
+  genmacro UPD_IND args = 
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let [updptr, heapptr] = map (amodeToStix target) args
+    let [updptr, heapptr] = map a2stix args
        test = StPrim AddrGtOp [updptr, smOldLim]
        cjmp = StCondJump ulbl test
        updRoots = StAssign PtrKind smOldMutables updptr
        test = StPrim AddrGtOp [updptr, smOldLim]
        cjmp = StCondJump ulbl test
        updRoots = StAssign PtrKind smOldMutables updptr
@@ -180,7 +191,7 @@ genMacroCode target UPD_IND args =
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target UPD_INPLACE_NOPTRS args = returnSUs id
+  genmacro UPD_INPLACE_NOPTRS args = returnSUs id
 
 \end{code}
 
 
 \end{code}
 
@@ -190,7 +201,7 @@ if we update an old generation object.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target UPD_INPLACE_PTRS [liveness] =
+  genmacro UPD_INPLACE_PTRS [liveness] =
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     let cjmp = StCondJump ulbl testOldLim
         testOldLim = StPrim AddrGtOp [stgNode, smOldLim]
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     let cjmp = StCondJump ulbl testOldLim
         testOldLim = StPrim AddrGtOp [stgNode, smOldLim]
@@ -204,7 +215,7 @@ genMacroCode target UPD_INPLACE_PTRS [liveness] =
        updOldMutables = StAssign PtrKind smOldMutables stgNode
        updUpdReg = StAssign PtrKind stgNode hpBack2
     in
        updOldMutables = StAssign PtrKind smOldMutables stgNode
        updUpdReg = StAssign PtrKind stgNode hpBack2
     in
-       genMacroCode target HEAP_CHK [liveness, mkIntCLit_3, mkIntCLit_0]
+       genmacro HEAP_CHK [liveness, mkIntCLit_3, mkIntCLit_0]
                                                        `thenSUs` \ heap_chk ->
        returnSUs (\xs -> (cjmp : 
                            heap_chk (updUpd0 : updUpd1 : updUpd2 : 
                                                        `thenSUs` \ heap_chk ->
        returnSUs (\xs -> (cjmp : 
                            heap_chk (updUpd0 : updUpd1 : updUpd2 : 
@@ -218,11 +229,11 @@ to handle @UPD_BH_SINGLE_ENTRY@ in all cases.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target UPD_BH_UPDATABLE args = returnSUs id
+  genmacro UPD_BH_UPDATABLE args = returnSUs id
 
 
-genMacroCode target UPD_BH_SINGLE_ENTRY [arg] =
+  genmacro UPD_BH_SINGLE_ENTRY [arg] =
     let
     let
-       update = StAssign PtrKind (StInd PtrKind (amodeToStix target arg)) bh_info
+       update = StAssign PtrKind (StInd PtrKind (a2stix arg)) bh_info
     in
         returnSUs (\xs -> update : xs)
 
     in
         returnSUs (\xs -> update : xs)
 
@@ -233,8 +244,8 @@ registers to the current Sp[AB] locations.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target PUSH_STD_UPD_FRAME args =
-    let [bhptr, aWords, bWords] = map (amodeToStix target) args
+  genmacro PUSH_STD_UPD_FRAME args =
+    let [bhptr, aWords, bWords] = map a2stix args
        frame n = StInd PtrKind 
            (StIndex PtrKind stgSpB (StPrim IntAddOp 
                [bWords, StInt (toInteger (sTD_UF_SIZE - n))]))
        frame n = StInd PtrKind 
            (StIndex PtrKind stgSpB (StPrim IntAddOp 
                [bWords, StInt (toInteger (sTD_UF_SIZE - n))]))
@@ -258,7 +269,7 @@ Pop a standard update frame.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target POP_STD_UPD_FRAME args =
+  genmacro POP_STD_UPD_FRAME args =
     let frame n = StInd PtrKind (StIndex PtrKind stgSpB (StInt (toInteger (-n))))
 
        grabRet = StAssign PtrKind stgRetReg (frame uF_RET)
     let frame n = StInd PtrKind (StIndex PtrKind stgSpB (StInt (toInteger (-n))))
 
        grabRet = StAssign PtrKind stgRetReg (frame uF_RET)
@@ -276,7 +287,7 @@ genMacroCode target POP_STD_UPD_FRAME args =
 
 \begin{code}
 {- UNUSED:
 
 \begin{code}
 {- UNUSED:
-genMacroCode target PUSH_CON_UPD_FRAME args = 
+  genmacro PUSH_CON_UPD_FRAME args = 
     panic "genMacroCode:PUSH_CON_UPD_FRAME"
 -}
 \end{code}
     panic "genMacroCode:PUSH_CON_UPD_FRAME"
 -}
 \end{code}
@@ -285,8 +296,8 @@ The @SET_ARITY@ and @CHK_ARITY@ macros are disabled for ``normal'' compilation.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target SET_ARITY args = returnSUs id
-genMacroCode target CHK_ARITY args = returnSUs id
+  genmacro SET_ARITY args = returnSUs id
+  genmacro CHK_ARITY args = returnSUs id
 
 \end{code}
 
 
 \end{code}
 
@@ -294,10 +305,10 @@ This one only applies if we have a machine register devoted to TagReg.
 
 \begin{code}
 
 
 \begin{code}
 
-genMacroCode target SET_TAG [tag] = 
-    let set_tag = StAssign IntKind stgTagReg (amodeToStix target tag)
+  genmacro SET_TAG [tag] = 
+    let set_tag = StAssign IntKind stgTagReg (a2stix tag)
     in
     in
-        case stgReg target TagReg of
+        case stg_reg TagReg of
             Always _ -> returnSUs id
             Save _ -> returnSUs (\xs -> set_tag : xs)
 
             Always _ -> returnSUs id
             Save _ -> returnSUs (\xs -> set_tag : xs)
 
@@ -309,13 +320,13 @@ of StixOp.
 \begin{code}
 
 doHeapCheck 
 \begin{code}
 
 doHeapCheck 
-    :: Target 
-    -> StixTree        -- liveness
+    :: {- unused now: Target 
+    -> -}StixTree      -- liveness
     -> StixTree        -- words needed
     -> StixTree        -- always reenter node? (boolean)
     -> SUniqSM StixTreeList
 
     -> StixTree        -- words needed
     -> StixTree        -- always reenter node? (boolean)
     -> SUniqSM StixTreeList
 
-doHeapCheck target liveness words reenter =
+doHeapCheck {-target:unused now-} liveness words reenter =
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     let newHp = StIndex PtrKind stgHp words
        assign = StAssign PtrKind stgHp newHp
     getUniqLabelNCG                                    `thenSUs` \ ulbl ->
     let newHp = StIndex PtrKind stgHp words
        assign = StAssign PtrKind stgHp newHp
index 2f54eb0..a14b709 100644 (file)
@@ -4,13 +4,11 @@ import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelativ
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CharSeq(CSeq)
-import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import MachDesc(RegLoc, Target)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
 import MachDesc(RegLoc, Target)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
-import Pretty(PprStyle)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep)
@@ -18,16 +16,12 @@ import SplitUniq(SplitUniqSupply)
 import Stix(CodeSegment, StixReg, StixTree)
 import UniType(UniType)
 import Unique(Unique)
 import Stix(CodeSegment, StixReg, StixTree)
 import UniType(UniType)
 import Unique(Unique)
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data Target    {-# GHC_PRAGMA Target (GlobalSwitch -> SwitchResult) Int (SMRep -> Int) (MagicId -> RegLoc) (StixTree -> StixTree) (PrimKind -> Int) ([MagicId] -> [StixTree]) ([MagicId] -> [StixTree]) (HeapOffset -> Int) (CAddrMode -> StixTree) (CAddrMode -> StixTree) Int Int StixTree StixTree ([CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (CStmtMacro -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]) (StixTree -> StixTree -> StixTree -> SplitUniqSupply -> [StixTree] -> [StixTree]) (PprStyle -> [[StixTree]] -> SplitUniqSupply -> CSeq) Bool ([Char] -> [Char]) #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data StixTree  {-# GHC_PRAGMA StSegment CodeSegment | StInt Integer | StDouble (Ratio Integer) | StString _PackedString | StLitLbl CSeq | StLitLit _PackedString | StCLbl CLabel | StReg StixReg | StIndex PrimKind StixTree StixTree | StInd PrimKind StixTree | StAssign PrimKind StixTree StixTree | StLabel CLabel | StFunBegin CLabel | StFunEnd CLabel | StJump StixTree | StFallThrough CLabel | StCondJump CLabel StixTree | StData PrimKind [StixTree] | StPrim PrimOp [StixTree] | StCall _PackedString PrimKind [StixTree] | StComment _PackedString #-}
+data CAddrMode 
+data Target 
+data PrimOp 
+data SplitUniqSupply 
+data StixTree 
 amodeCode :: Target -> CAddrMode -> StixTree
 amodeCode :: Target -> CAddrMode -> StixTree
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 amodeCode' :: Target -> CAddrMode -> StixTree
 amodeCode' :: Target -> CAddrMode -> StixTree
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 genPrimCode :: Target -> [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
 genPrimCode :: Target -> [CAddrMode] -> PrimOp -> [CAddrMode] -> SplitUniqSupply -> [StixTree] -> [StixTree]
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LSSL" _N_ _N_ #-}
 
 
index 977d9ef..40c1a3a 100644 (file)
@@ -62,41 +62,22 @@ btw Why not let programmer use casm to provide assembly code instead
 of C code?  ADR
 
 \begin{code}
 of C code?  ADR
 
 \begin{code}
-
-genPrimCode target lhs (CCallOp fn is_asm may_gc arg_tys result_ty) rhs 
-  | is_asm = error "ERROR: Native code generator can't handle casm"
-  | otherwise =
-    case lhs of
-       [] -> returnSUs (\xs -> (StCall fn VoidKind args) : xs)
-       [lhs] ->
-           let lhs' = amodeToStix target lhs
-               pk = if isFloatingKind (getAmodeKind lhs) then DoubleKind else IntKind
-               call = StAssign pk lhs' (StCall fn pk args)
-           in
-               returnSUs (\xs -> call : xs)
-    where
-       args = map amodeCodeForCCall rhs
-        amodeCodeForCCall x = 
-           let base = amodeToStix' target x
-           in
-               case getAmodeKind x of
-                   ArrayKind -> StIndex PtrKind base (mutHS target)
-                   ByteArrayKind -> StIndex IntKind base (dataHS target)
-                   MallocPtrKind -> error "ERROR: native-code generator can't handle Malloc Ptrs (yet): use -fvia-C!"
-                   _ -> base
-
-\end{code}    
-
-The @ErrorIO@ primitive is actually a bit weird...assign a new value to the root
-closure, flush stdout and stderr, and jump to the @ErrorIO_innards@.
-
-\begin{code}
-
-genPrimCode target [] ErrorIOPrimOp [rhs] = 
-    let changeTop = StAssign PtrKind topClosure (amodeToStix target rhs)
-    in
-       returnSUs (\xs -> changeTop : flushStdout : flushStderr : errorIO : xs)
-
+-- hacking with Uncle Will:
+#define target_STRICT target@(Target _ _ _ _ _ _ _ _)
+
+genPrimCode target_STRICT res op args
+ = genprim res op args
+ where
+  a2stix    = amodeToStix target
+  a2stix'   = amodeToStix' target
+  mut_hs    = mutHS target
+  data_hs   = dataHS target
+  heap_chkr = heapCheck target
+  size_of   = sizeof target
+  fixed_hs  = fixedHeaderSize target
+  var_hs    = varHeaderSize target 
+
+  --- real code will follow... -------------
 \end{code}
 
 The (MP) integer operations are a true nightmare.  Since we don't have a 
 \end{code}
 
 The (MP) integer operations are a true nightmare.  Since we don't have a 
@@ -105,90 +86,107 @@ we use the space just below HpLim for the @MP_INT@ structures, and modify our
 heap check accordingly.
 
 \begin{code}
 heap check accordingly.
 
 \begin{code}
-
-genPrimCode target res IntegerAddOp args =
-    gmpTake2Return1 target res SLIT("mpz_add") args
-genPrimCode target res IntegerSubOp args =
-    gmpTake2Return1 target res SLIT("mpz_sub") args
-genPrimCode target res IntegerMulOp args =
-    gmpTake2Return1 target res SLIT("mpz_mul") args
-
-genPrimCode target res IntegerNegOp arg =
-    gmpTake1Return1 target res SLIT("mpz_neg") arg
-
-genPrimCode target res IntegerQuotRemOp arg =
-    gmpTake2Return2 target res SLIT("mpz_divmod") arg
-genPrimCode target res IntegerDivModOp arg =
-    gmpTake2Return2 target res SLIT("mpz_targetivmod") arg
-
+  -- NB: ordering of clauses somewhere driven by
+  -- the desire to getting sane patt-matching behavior
+
+  genprim res@[ar1,sr1,dr1, ar2,sr2,dr2]
+         IntegerQuotRemOp
+         args@[liveness, aa1,sa1,da1, aa2,sa2,da2] =
+    gmpTake2Return2 target (ar1,sr1,dr1, ar2,sr2,dr2) SLIT("mpz_divmod") (liveness, aa1,sa1,da1, aa2,sa2,da2)
+
+  genprim res@[ar1,sr1,dr1, ar2,sr2,dr2]
+         IntegerDivModOp
+         args@[liveness, aa1,sa1,da1, aa2,sa2,da2] =
+    gmpTake2Return2 target (ar1,sr1,dr1, ar2,sr2,dr2) SLIT("mpz_targetivmod") (liveness, aa1,sa1,da1, aa2,sa2,da2)
+
+  genprim res@[ar,sr,dr] IntegerAddOp args@[liveness, aa1,sa1,da1, aa2,sa2,da2] =
+    gmpTake2Return1 target (ar,sr,dr) SLIT("mpz_add") (liveness, aa1,sa1,da1, aa2,sa2,da2)
+  genprim res@[ar,sr,dr] IntegerSubOp args@[liveness, aa1,sa1,da1, aa2,sa2,da2] =
+    gmpTake2Return1 target (ar,sr,dr) SLIT("mpz_sub") (liveness, aa1,sa1,da1, aa2,sa2,da2)
+  genprim res@[ar,sr,dr] IntegerMulOp args@[liveness, aa1,sa1,da1, aa2,sa2,da2] =
+    gmpTake2Return1 target (ar,sr,dr) SLIT("mpz_mul") (liveness, aa1,sa1,da1, aa2,sa2,da2)
+
+  genprim res@[ar,sr,dr] IntegerNegOp arg@[liveness,aa,sa,da] =
+    gmpTake1Return1 target (ar,sr,dr) SLIT("mpz_neg") (liveness,aa,sa,da)
 \end{code}
 
 Since we are using the heap for intermediate @MP_INT@ structs, integer comparison
 {\em does} require a heap check in the native code implementation.
 
 \begin{code}
 \end{code}
 
 Since we are using the heap for intermediate @MP_INT@ structs, integer comparison
 {\em does} require a heap check in the native code implementation.
 
 \begin{code}
+  genprim res@[exponr,ar,sr,dr] FloatDecodeOp args@[hp, arg] =
+    decodeFloatingKind FloatKind target (exponr,ar,sr,dr) (hp, arg)
+
+  genprim res@[exponr,ar,sr,dr] DoubleDecodeOp args@[hp, arg] =
+    decodeFloatingKind DoubleKind target (exponr,ar,sr,dr) (hp, arg)
 
 
-genPrimCode target [res] IntegerCmpOp args = gmpCompare target res args
+  genprim res@[ar,sr,dr] Int2IntegerOp args@[hp, n]
+    = gmpInt2Integer target (ar,sr,dr) (hp, n)
 
 
-genPrimCode target [res] Integer2IntOp arg = gmpInteger2Int target res arg
+  genprim res@[ar,sr,dr] Addr2IntegerOp args@[liveness,str]
+    = gmpString2Integer target (ar,sr,dr) (liveness,str)
 
 
-genPrimCode target res Int2IntegerOp args = gmpInt2Integer target res args
+  genprim [res] IntegerCmpOp args@[hp, aa1,sa1,da1, aa2,sa2,da2]
+    = gmpCompare target res (hp, aa1,sa1,da1, aa2,sa2,da2)
 
 
-genPrimCode target res Word2IntegerOp args = panic "genPrimCode:Word2IntegerOp"
+  genprim [res] Integer2IntOp arg@[hp, aa,sa,da]
+    = gmpInteger2Int target res (hp, aa,sa,da)
 
 
-genPrimCode target res Addr2IntegerOp args = gmpString2Integer target res args
+  genprim [res] FloatEncodeOp args@[hp, aa,sa,da, expon] =
+    encodeFloatingKind FloatKind target res (hp, aa,sa,da, expon)
 
 
-genPrimCode target res FloatEncodeOp args =
-    encodeFloatingKind FloatKind target res args
+  genprim [res] DoubleEncodeOp args@[hp, aa,sa,da, expon] =
+    encodeFloatingKind DoubleKind target res (hp, aa,sa,da, expon)
 
 
-genPrimCode target res DoubleEncodeOp args =
-    encodeFloatingKind DoubleKind target res args
+  genprim [res] Int2AddrOp [arg] =
+    simpleCoercion AddrKind res arg
 
 
-genPrimCode target res FloatDecodeOp args =
-    decodeFloatingKind FloatKind target res args
+  genprim [res] Addr2IntOp [arg] =
+    simpleCoercion IntKind res arg
 
 
-genPrimCode target res DoubleDecodeOp args =
-    decodeFloatingKind DoubleKind target res args
+  genprim [res] Int2WordOp [arg] =
+    simpleCoercion IntKind{-WordKind?-} res arg
 
 
-genPrimCode target res Int2AddrOp arg =
-    simpleCoercion target AddrKind res arg
+  genprim [res] Word2IntOp [arg] =
+    simpleCoercion IntKind res arg
+
+\end{code}
 
 
-genPrimCode target res Addr2IntOp arg =
-    simpleCoercion target IntKind res arg
+The @ErrorIO@ primitive is actually a bit weird...assign a new value to the root
+closure, flush stdout and stderr, and jump to the @ErrorIO_innards@.
 
 
-genPrimCode target res Int2WordOp arg =
-    simpleCoercion target IntKind{-WordKind?-} res arg
+\begin{code}
 
 
-genPrimCode target res Word2IntOp arg =
-    simpleCoercion target IntKind res arg
+  genprim [] ErrorIOPrimOp [rhs] = 
+    let changeTop = StAssign PtrKind topClosure (a2stix rhs)
+    in
+       returnSUs (\xs -> changeTop : flushStdout : flushStderr : errorIO : xs)
 
 \end{code}
 
 @newArray#@ ops allocate heap space.
 
 \begin{code}
 
 \end{code}
 
 @newArray#@ ops allocate heap space.
 
 \begin{code}
-
-genPrimCode target [res] NewArrayOp args =
-    let        [liveness, n, initial] = map (amodeToStix target) args
-        result = amodeToStix target res
-       space = StPrim IntAddOp [n, mutHS target]
+  genprim [res] NewArrayOp args =
+    let        [liveness, n, initial] = map a2stix args
+        result = a2stix res
+       space = StPrim IntAddOp [n, mut_hs]
        loc = StIndex PtrKind stgHp 
              (StPrim IntNegOp [StPrim IntSubOp [space, StInt 1]])
        assign = StAssign PtrKind result loc
        initialise = StCall SLIT("newArrZh_init") VoidKind [result, n, initial]
     in
        loc = StIndex PtrKind stgHp 
              (StPrim IntNegOp [StPrim IntSubOp [space, StInt 1]])
        assign = StAssign PtrKind result loc
        initialise = StCall SLIT("newArrZh_init") VoidKind [result, n, initial]
     in
-       heapCheck target liveness space (StInt 0)
-                                                       `thenSUs` \ heap_chk ->
+       heap_chkr liveness space (StInt 0)      `thenSUs` \ heap_chk ->
 
        returnSUs (heap_chk . (\xs -> assign : initialise : xs))
 
 
        returnSUs (heap_chk . (\xs -> assign : initialise : xs))
 
-genPrimCode target [res] (NewByteArrayOp pk) args =
-    let        [liveness, count] = map (amodeToStix target) args
-        result = amodeToStix target res
-       n = StPrim IntMulOp [count, StInt (toInteger (sizeof target pk))]
-        slop = StPrim IntAddOp [n, StInt (toInteger (sizeof target IntKind - 1))]
-        words = StPrim IntDivOp [slop, StInt (toInteger (sizeof target IntKind))]
-       space = StPrim IntAddOp [n, StPrim IntAddOp [words, dataHS target]]
+  genprim [res] (NewByteArrayOp pk) args =
+    let        [liveness, count] = map a2stix args
+        result = a2stix res
+       n = StPrim IntMulOp [count, StInt (toInteger (size_of pk))]
+        slop = StPrim IntAddOp [n, StInt (toInteger (size_of IntKind - 1))]
+        words = StPrim IntQuotOp [slop, StInt (toInteger (size_of IntKind))]
+       space = StPrim IntAddOp [n, StPrim IntAddOp [words, data_hs]]
        loc = StIndex PtrKind stgHp 
              (StPrim IntNegOp [StPrim IntSubOp [space, StInt 1]])
        assign = StAssign PtrKind result loc
        loc = StIndex PtrKind stgHp 
              (StPrim IntNegOp [StPrim IntSubOp [space, StInt 1]])
        assign = StAssign PtrKind result loc
@@ -196,24 +194,22 @@ genPrimCode target [res] (NewByteArrayOp pk) args =
         init2 = StAssign IntKind 
                         (StInd IntKind 
                                (StIndex IntKind loc 
         init2 = StAssign IntKind 
                         (StInd IntKind 
                                (StIndex IntKind loc 
-                                        (StInt (toInteger (fixedHeaderSize target)))))
+                                        (StInt (toInteger fixed_hs))))
                          (StPrim IntAddOp [words, 
                          (StPrim IntAddOp [words, 
-                                         StInt (toInteger (varHeaderSize target 
-                                                                         (DataRep 0)))])
+                                         StInt (toInteger (var_hs (DataRep 0)))])
     in
     in
-       heapCheck target liveness space (StInt 0)
-                                                       `thenSUs` \ heap_chk ->
+       heap_chkr liveness space (StInt 0)      `thenSUs` \ heap_chk ->
 
        returnSUs (heap_chk . (\xs -> assign : init1 : init2 : xs))
 
 
        returnSUs (heap_chk . (\xs -> assign : init1 : init2 : xs))
 
-genPrimCode target [res] SameMutableArrayOp args =
-    let compare = StPrim AddrEqOp (map (amodeToStix target) args)
-        assign = StAssign IntKind (amodeToStix target res) compare
+  genprim [res] SameMutableArrayOp args =
+    let compare = StPrim AddrEqOp (map a2stix args)
+        assign = StAssign IntKind (a2stix res) compare
     in
         returnSUs (\xs -> assign : xs)
 
     in
         returnSUs (\xs -> assign : xs)
 
-genPrimCode target res SameMutableByteArrayOp args =
-    genPrimCode target res SameMutableArrayOp args
+  genprim res@[_] SameMutableByteArrayOp args =
+    genprim res SameMutableArrayOp args
 
 \end{code}
 
 
 \end{code}
 
@@ -223,17 +219,17 @@ the indirection (most likely, it's a VanillaReg).
 
 \begin{code}
 
 
 \begin{code}
 
-genPrimCode target [lhs] UnsafeFreezeArrayOp [rhs] =
-    let lhs' = amodeToStix target lhs
-       rhs' = amodeToStix target rhs
+  genprim [lhs] UnsafeFreezeArrayOp [rhs] =
+    let lhs' = a2stix lhs
+       rhs' = a2stix rhs
        header = StInd PtrKind lhs'
        assign = StAssign PtrKind lhs' rhs'
        freeze = StAssign PtrKind header imMutArrayOfPtrs_info
     in
        returnSUs (\xs -> assign : freeze : xs)
 
        header = StInd PtrKind lhs'
        assign = StAssign PtrKind lhs' rhs'
        freeze = StAssign PtrKind header imMutArrayOfPtrs_info
     in
        returnSUs (\xs -> assign : freeze : xs)
 
-genPrimCode target lhs UnsafeFreezeByteArrayOp rhs =
-    simpleCoercion target PtrKind lhs rhs
+  genprim [lhs] UnsafeFreezeByteArrayOp [rhs] =
+    simpleCoercion PtrKind lhs rhs
 
 \end{code}
 
 
 \end{code}
 
@@ -241,56 +237,57 @@ Most other array primitives translate to simple indexing.
 
 \begin{code}
 
 
 \begin{code}
 
-genPrimCode target lhs IndexArrayOp args =
-    genPrimCode target lhs ReadArrayOp args
+  genprim lhs@[_] IndexArrayOp args =
+    genprim lhs ReadArrayOp args
 
 
-genPrimCode target [lhs] ReadArrayOp [obj, ix] =
-    let lhs' = amodeToStix target lhs
-       obj' = amodeToStix target obj
-       ix' = amodeToStix target ix
-       base = StIndex IntKind obj' (mutHS target)
+  genprim [lhs] ReadArrayOp [obj, ix] =
+    let lhs' = a2stix lhs
+       obj' = a2stix obj
+       ix' = a2stix ix
+       base = StIndex IntKind obj' mut_hs
        assign = StAssign PtrKind lhs' (StInd PtrKind (StIndex PtrKind base ix'))
     in
        returnSUs (\xs -> assign : xs)
 
        assign = StAssign PtrKind lhs' (StInd PtrKind (StIndex PtrKind base ix'))
     in
        returnSUs (\xs -> assign : xs)
 
-genPrimCode target [lhs] WriteArrayOp [obj, ix, v] =
-    let        obj' = amodeToStix target obj
-       ix' = amodeToStix target ix
-       v' = amodeToStix target v
-       base = StIndex IntKind obj' (mutHS target)
+  genprim [lhs] WriteArrayOp [obj, ix, v] =
+    let        obj' = a2stix obj
+       ix' = a2stix ix
+       v' = a2stix v
+       base = StIndex IntKind obj' mut_hs
        assign = StAssign PtrKind (StInd PtrKind (StIndex PtrKind base ix')) v'
     in
        returnSUs (\xs -> assign : xs)
 
        assign = StAssign PtrKind (StInd PtrKind (StIndex PtrKind base ix')) v'
     in
        returnSUs (\xs -> assign : xs)
 
-genPrimCode target lhs (IndexByteArrayOp pk) args =
-    genPrimCode target lhs (ReadByteArrayOp pk) args
+  genprim lhs@[_] (IndexByteArrayOp pk) args =
+    genprim lhs (ReadByteArrayOp pk) args
+
+-- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
 
 
-genPrimCode target [lhs] (ReadByteArrayOp pk) [obj, ix] =
-    let lhs' = amodeToStix target lhs
-       obj' = amodeToStix target obj
-       ix' = amodeToStix target ix
-       base = StIndex IntKind obj' (dataHS target)
-       assign = StAssign pk lhs' (StInd pk (StIndex CharKind base ix'))
+  genprim [lhs] (ReadByteArrayOp pk) [obj, ix] =
+    let lhs' = a2stix lhs
+       obj' = a2stix obj
+       ix' = a2stix ix
+       base = StIndex IntKind obj' data_hs
+       assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
     in
        returnSUs (\xs -> assign : xs)
 
     in
        returnSUs (\xs -> assign : xs)
 
-genPrimCode target [] (WriteByteArrayOp pk) [obj, ix, v] =
-    let        obj' = amodeToStix target obj
-       ix' = amodeToStix target ix
-       v' = amodeToStix target v
-       base = StIndex IntKind obj' (dataHS target)
-       assign = StAssign pk (StInd pk (StIndex CharKind base ix')) v'
+  genprim [lhs] (IndexOffAddrOp pk) [obj, ix] =
+    let lhs' = a2stix lhs
+       obj' = a2stix obj
+       ix' = a2stix ix
+       assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
     in
        returnSUs (\xs -> assign : xs)
 
     in
        returnSUs (\xs -> assign : xs)
 
-genPrimCode target [lhs] (IndexOffAddrOp pk) [obj, ix] =
-    let lhs' = amodeToStix target lhs
-       obj' = amodeToStix target obj
-       ix' = amodeToStix target ix
-       assign = StAssign pk lhs' (StInd pk (StIndex CharKind obj' ix'))
+  genprim [] (WriteByteArrayOp pk) [obj, ix, v] =
+    let        obj' = a2stix obj
+       ix' = a2stix ix
+       v' = a2stix v
+       base = StIndex IntKind obj' data_hs
+       assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
     in
        returnSUs (\xs -> assign : xs)
     in
        returnSUs (\xs -> assign : xs)
-
 \end{code}
 
 Stable pointer operations.
 \end{code}
 
 Stable pointer operations.
@@ -299,10 +296,10 @@ First the easy one.
 
 \begin{code}
 
 
 \begin{code}
 
-genPrimCode target [lhs] DeRefStablePtrOp [sp] =
-    let lhs' = amodeToStix target lhs
+  genprim [lhs] DeRefStablePtrOp [sp] =
+    let lhs' = a2stix lhs
        pk = getAmodeKind lhs
        pk = getAmodeKind lhs
-       sp' = amodeToStix target sp
+       sp' = a2stix sp
        call = StCall SLIT("deRefStablePointer") pk [sp', smStablePtrTable]
        assign = StAssign pk lhs' call
     in
        call = StCall SLIT("deRefStablePointer") pk [sp', smStablePtrTable]
        assign = StAssign pk lhs' call
     in
@@ -354,7 +351,7 @@ Notes for ADR:
     --JSM
 
 \begin{pseudocode}
     --JSM
 
 \begin{pseudocode}
-genPrimCode sty md [lhs] MakeStablePtrOp args =
+  genprim [lhs] MakeStablePtrOp args =
     let 
        -- some useful abbreviations (I'm sure these must exist already)
        add = trPrim . IntAddOp 
     let 
        -- some useful abbreviations (I'm sure these must exist already)
        add = trPrim . IntAddOp 
@@ -412,26 +409,51 @@ genPrimCode sty md [lhs] MakeStablePtrOp args =
        (spt_EMPTY spt oklbl : (enlarge ++ (trLabel [oklbl] : allocate)))
 \end{pseudocode}
 
        (spt_EMPTY spt oklbl : (enlarge ++ (trLabel [oklbl] : allocate)))
 \end{pseudocode}
 
+\begin{code}
+  genprim res Word2IntegerOp args = panic "genPrimCode:Word2IntegerOp"
+
+  genprim lhs (CCallOp fn is_asm may_gc arg_tys result_ty) rhs 
+   | is_asm = error "ERROR: Native code generator can't handle casm"
+   | otherwise =
+    case lhs of
+       [] -> returnSUs (\xs -> (StCall fn VoidKind args) : xs)
+       [lhs] ->
+           let lhs' = a2stix lhs
+               pk = if isFloatingKind (getAmodeKind lhs) then DoubleKind else IntKind
+               call = StAssign pk lhs' (StCall fn pk args)
+           in
+               returnSUs (\xs -> call : xs)
+    where
+       args = map amodeCodeForCCall rhs
+        amodeCodeForCCall x = 
+           let base = a2stix' x
+           in
+               case getAmodeKind x of
+                   ArrayKind -> StIndex PtrKind base mut_hs
+                   ByteArrayKind -> StIndex IntKind base data_hs
+                   MallocPtrKind -> error "ERROR: native-code generator can't handle Malloc Ptrs (yet): use -fvia-C!"
+                   _ -> base
+\end{code}    
 
 Now the more mundane operations.
 
 \begin{code}
 
 Now the more mundane operations.
 
 \begin{code}
-
-genPrimCode target lhs op rhs = 
-    let lhs' = map (amodeToStix target) lhs
-       rhs' = map (amodeToStix' target) rhs
+  genprim lhs op rhs = 
+    let lhs' = map a2stix  lhs
+       rhs' = map a2stix' rhs
     in
     in
-        returnSUs (\ xs -> simplePrim target lhs' op rhs' : xs)
-
-simpleCoercion 
-    :: Target 
-    -> PrimKind 
-    -> [CAddrMode] 
-    -> [CAddrMode] 
-    -> SUniqSM StixTreeList
-
-simpleCoercion target pk [lhs] [rhs] =
-    returnSUs (\xs -> StAssign pk (amodeToStix target lhs) (amodeToStix target rhs) : xs)
+        returnSUs (\ xs -> simplePrim lhs' op rhs' : xs)
+
+  {-
+  simpleCoercion 
+      :: Target 
+      -> PrimKind 
+      -> [CAddrMode] 
+      -> [CAddrMode] 
+      -> SUniqSM StixTreeList
+  -}
+  simpleCoercion pk lhs rhs =
+      returnSUs (\xs -> StAssign pk (a2stix lhs) (a2stix rhs) : xs)
 
 \end{code}
 
 
 \end{code}
 
@@ -440,30 +462,30 @@ can understand.    Any primitives not handled here must be handled
 at the level of the specific code generator.
 
 \begin{code}
 at the level of the specific code generator.
 
 \begin{code}
-
-simplePrim 
+  {-
+  simplePrim 
     :: Target 
     -> [StixTree] 
     -> PrimOp 
     -> [StixTree] 
     -> StixTree
     :: Target 
     -> [StixTree] 
     -> PrimOp 
     -> [StixTree] 
     -> StixTree
-
+  -}
 \end{code}
 
 Now look for something more conventional.
 
 \begin{code}
 
 \end{code}
 
 Now look for something more conventional.
 
 \begin{code}
 
-simplePrim target [lhs] op rest = StAssign pk lhs (StPrim op rest)
+  simplePrim [lhs] op rest = StAssign pk lhs (StPrim op rest)
     where pk = if isCompareOp op then IntKind 
                else case getPrimOpResultInfo op of
                 ReturnsPrim pk -> pk
                 _ -> simplePrim_error op
 
     where pk = if isCompareOp op then IntKind 
                else case getPrimOpResultInfo op of
                 ReturnsPrim pk -> pk
                 _ -> simplePrim_error op
 
-simplePrim target _ op _ = simplePrim_error op
+  simplePrim _ op _ = simplePrim_error op
 
 
-simplePrim_error op
-  = error ("ERROR: primitive operation `"++showPrimOp PprDebug op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
+  simplePrim_error op
+    = error ("ERROR: primitive operation `"++showPrimOp PprDebug op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
 \end{code}
 
 %---------------------------------------------------------------------
 \end{code}
 
 %---------------------------------------------------------------------
@@ -481,92 +503,102 @@ amodeCode, amodeCode'
     -> CAddrMode 
     -> StixTree
 
     -> CAddrMode 
     -> StixTree
 
-amodeCode' target am@(CVal rr CharKind) 
+amodeCode'{-'-} target_STRICT am@(CVal rr CharKind) 
     | mixedTypeLocn am = StPrim ChrOp [amodeToStix target am]
     | otherwise = amodeToStix target am
 
 amodeCode' target am = amodeToStix target am
 
     | mixedTypeLocn am = StPrim ChrOp [amodeToStix target am]
     | otherwise = amodeToStix target am
 
 amodeCode' target am = amodeToStix target am
 
-amodeCode target am@(CVal rr CharKind) | mixedTypeLocn am =
-       StInd IntKind (amodeCode target (CAddr rr))
+amodeCode target_STRICT am
+ = acode am
+ where
+ -- grab "target" things:
+ hp_rel    = hpRel target
+ char_like = charLikeClosureSize target
+ int_like  = intLikeClosureSize target
+ a2stix    = amodeToStix target
+
+ -- real code: ----------------------------------
+ acode am@(CVal rr CharKind) | mixedTypeLocn am =
+        StInd IntKind (acode (CAddr rr))
 
 
-amodeCode target (CVal rr pk) = StInd pk (amodeCode target (CAddr rr))
+ acode (CVal rr pk) = StInd pk (acode (CAddr rr))
 
 
-amodeCode target (CAddr r@(SpARel spA off)) =
-    StIndex PtrKind stgSpA (StInt (toInteger (spARelToInt r)))
+ acode (CAddr r@(SpARel spA off)) =
+     StIndex PtrKind stgSpA (StInt (toInteger (spARelToInt r)))
 
 
-amodeCode target (CAddr r@(SpBRel spB off)) =
-    StIndex IntKind stgSpB (StInt (toInteger (spBRelToInt r)))
+ acode (CAddr r@(SpBRel spB off)) =
+     StIndex IntKind stgSpB (StInt (toInteger (spBRelToInt r)))
 
 
-amodeCode target (CAddr (HpRel hp off)) =
-    StIndex IntKind stgHp (StInt (toInteger (-(hpRel target (hp `subOff` off)))))
+ acode (CAddr (HpRel hp off)) =
+     StIndex IntKind stgHp (StInt (toInteger (-(hp_rel (hp `subOff` off)))))
 
 
-amodeCode target (CAddr (NodeRel off)) =
-    StIndex IntKind stgNode (StInt (toInteger (hpRel target off)))
+ acode (CAddr (NodeRel off)) =
+     StIndex IntKind stgNode (StInt (toInteger (hp_rel off)))
 
 
-amodeCode target (CReg magic) = StReg (StixMagicId magic)
-amodeCode target (CTemp uniq pk) = StReg (StixTemp uniq pk)
+ acode (CReg magic) = StReg (StixMagicId magic)
+ acode (CTemp uniq pk) = StReg (StixTemp uniq pk)
 
 
-amodeCode target (CLbl lbl _) = StCLbl lbl
+ acode (CLbl lbl _) = StCLbl lbl
 
 
-amodeCode target (CUnVecLbl dir _) = StCLbl dir
+ acode (CUnVecLbl dir _) = StCLbl dir
 
 
-amodeCode target (CTableEntry base off pk) = 
-    StInd pk (StIndex pk (amodeCode target base) (amodeCode target off))
+ acode (CTableEntry base off pk) = 
+     StInd pk (StIndex pk (acode base) (acode off))
 
 
--- For CharLike and IntLike, we attempt some trivial constant-folding here.
+ -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 
 
-amodeCode target (CCharLike (CLit (MachChar c))) = 
-    StLitLbl (uppBeside (uppPStr SLIT("CHARLIKE_closures+")) (uppInt off))
-    where off = charLikeClosureSize target * ord c
+ acode (CCharLike (CLit (MachChar c))) = 
+     StLitLbl (uppBeside (uppPStr SLIT("CHARLIKE_closures+")) (uppInt off))
+     where off = char_like * ord c
 
 
-amodeCode target (CCharLike x) = 
-    StPrim IntAddOp [charLike, off]
-    where off = StPrim IntMulOp [amodeCode target x, 
-            StInt (toInteger (charLikeClosureSize target))]
+ acode (CCharLike x) = 
+     StPrim IntAddOp [charLike, off]
+     where off = StPrim IntMulOp [acode x, 
+            StInt (toInteger (char_like))]
 
 
-amodeCode target (CIntLike (CLit (MachInt i _))) = 
-    StPrim IntAddOp [intLikePtr, StInt off]
-    where off = toInteger (intLikeClosureSize target) * i
+ acode (CIntLike (CLit (MachInt i _))) = 
+     StPrim IntAddOp [intLikePtr, StInt off]
+     where off = toInteger int_like * i
 
 
-amodeCode target (CIntLike x) = 
-    StPrim IntAddOp [intLikePtr, off]
-    where off = StPrim IntMulOp [amodeCode target x,
-           StInt (toInteger (intLikeClosureSize target))]
+ acode (CIntLike x) = 
+     StPrim IntAddOp [intLikePtr, off]
+     where off = StPrim IntMulOp [acode x,
+            StInt (toInteger int_like)]
 
 
--- A CString is just a (CLit . MachStr)
-amodeCode target (CString s) = StString s
+ -- A CString is just a (CLit . MachStr)
+ acode (CString s) = StString s
 
 
-amodeCode target (CLit core) = case core of
-    (MachChar c) -> StInt (toInteger (ord c))
-    (MachStr s) -> StString s
-    (MachAddr a) -> StInt a
-    (MachInt i _) -> StInt i
-    (MachLitLit s _) -> StLitLit s
-    (MachFloat d) -> StDouble d
-    (MachDouble d) -> StDouble d
-    _ -> panic "amodeCode:core literal"
+ acode (CLit core) = case core of
+     (MachChar c) -> StInt (toInteger (ord c))
+     (MachStr s) -> StString s
+     (MachAddr a) -> StInt a
+     (MachInt i _) -> StInt i
+     (MachLitLit s _) -> StLitLit s
+     (MachFloat d) -> StDouble d
+     (MachDouble d) -> StDouble d
+     _ -> panic "amodeCode:core literal"
 
 
--- A CLitLit is just a (CLit . MachLitLit)
-amodeCode target (CLitLit s _) = StLitLit s
+ -- A CLitLit is just a (CLit . MachLitLit)
+ acode (CLitLit s _) = StLitLit s
 
 
--- COffsets are in words, not bytes!
-amodeCode target (COffset off) = StInt (toInteger (hpRel target off))
+ -- COffsets are in words, not bytes!
+ acode (COffset off) = StInt (toInteger (hp_rel off))
 
 
-amodeCode target (CMacroExpr _ macro [arg]) = 
-    case macro of
-       INFO_PTR -> StInd PtrKind (amodeToStix target arg)
-       ENTRY_CODE -> amodeToStix target arg
-       INFO_TAG -> tag
-       EVAL_TAG -> StPrim IntGeOp [tag, StInt 0]
-  where
-    tag = StInd IntKind (StIndex IntKind (amodeToStix target arg) (StInt (-2)))
-    -- That ``-2'' really bothers me. (JSM)
+ acode (CMacroExpr _ macro [arg]) = 
+     case macro of
+        INFO_PTR -> StInd PtrKind (a2stix arg)
+        ENTRY_CODE -> a2stix arg
+        INFO_TAG -> tag
+        EVAL_TAG -> StPrim IntGeOp [tag, StInt 0]
+   where
+     tag = StInd IntKind (StIndex IntKind (a2stix arg) (StInt (-2)))
+     -- That ``-2'' really bothers me. (JSM)
 
 
-amodeCode target (CCostCentre cc print_as_string)
-  = if noCostCentreAttached cc
-    then StComment SLIT("") -- sigh
-    else panic "amodeCode:CCostCentre"
+ acode (CCostCentre cc print_as_string)
+   = if noCostCentreAttached cc
+     then StComment SLIT("") -- sigh
+     else panic "amodeCode:CCostCentre"
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays in the
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays in the
index ca8ed00..a61cd80 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AbsPrel where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AbsPrel where
-import BasicLit(BasicLit)
 import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import Class(Class)
 import CmdLineOpts(GlobalSwitch)
-import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
-import CostCentre(CostCentre)
+import CoreSyn(CoreExpr)
 import HeapOffs(HeapOffset)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(NamedThing, Outputable)
 import PlainCore(PlainCoreExpr(..))
 import PrelFuns(gLASGOW_MISC, gLASGOW_ST, pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_IO, pRELUDE_LIST, pRELUDE_PRIMIO, pRELUDE_PS, pRELUDE_RATIO, pRELUDE_TEXT)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(NamedThing, Outputable)
 import PlainCore(PlainCoreExpr(..))
 import PrelFuns(gLASGOW_MISC, gLASGOW_ST, pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_IO, pRELUDE_LIST, pRELUDE_PRIMIO, pRELUDE_PS, pRELUDE_RATIO, pRELUDE_TEXT)
-import PrelVals(aBSENT_ERROR_ID, buildId, eRROR_ID, foldlId, foldrId, integerMinusOneId, integerPlusOneId, integerZeroId, mkBuild, mkFoldl, mkFoldr, pAT_ERROR_ID, packStringForCId, realWorldPrimId, unpackCStringAppendId, unpackCStringId, voidPrimId)
+import PrelVals(aBSENT_ERROR_ID, buildId, eRROR_ID, foldlId, foldrId, integerMinusOneId, integerPlusOneId, integerZeroId, mkBuild, mkFoldl, mkFoldr, pAT_ERROR_ID, packStringForCId, realWorldPrimId, unpackCString2Id, unpackCStringAppendId, unpackCStringId, voidPrimId)
 import PreludePS(_PackedString)
 import Pretty(PprStyle, PrettyRep)
 import PrimKind(PrimKind)
 import PreludePS(_PackedString)
 import Pretty(PprStyle, PrettyRep)
 import PrimKind(PrimKind)
-import PrimOps(HeapRequirement(..), PrimOp(..), PrimOpResultInfo(..), fragilePrimOp, getPrimOpResultInfo, isCompareOp, pprPrimOp, primOpCanTriggerGC, primOpHeapReq, primOpIsCheap, primOpNameInfo, primOpNeedsWrapper, primOpOkForSpeculation, showPrimOp, tagOf_PrimOp, typeOfPrimOp)
+import PrimOps(HeapRequirement(..), PrimOp(..), PrimOpResultInfo(..), fragilePrimOp, getPrimOpResultInfo, isCompareOp, pprPrimOp, primOpCanTriggerGC, primOpHeapReq, primOpIsCheap, primOpNameInfo, primOpNeedsWrapper, primOpOkForSpeculation, showPrimOp, typeOfPrimOp)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
-import TysPrim(addrPrimTy, addrPrimTyCon, charPrimTy, charPrimTyCon, doublePrimTy, doublePrimTyCon, floatPrimTy, floatPrimTyCon, intPrimTy, intPrimTyCon, mkStatePrimTy, realWorldStatePrimTy, realWorldTy, realWorldTyCon, voidPrimTy, wordPrimTy, wordPrimTyCon)
-import TysWiredIn(addrDataCon, addrTy, boolTy, boolTyCon, charDataCon, charTy, charTyCon, cmpTagTy, consDataCon, doubleDataCon, doubleTy, doubleTyCon, eqPrimDataCon, falseDataCon, floatDataCon, floatTy, floatTyCon, getStatePairingConInfo, gtPrimDataCon, intDataCon, intTy, intTyCon, integerTy, integerTyCon, liftDataCon, liftTyCon, listTyCon, ltPrimDataCon, mkLiftTy, mkListTy, mkPrimIoTy, mkTupleTy, nilDataCon, ratioDataCon, rationalTy, rationalTyCon, realWorldStateTy, stateDataCon, stringTy, trueDataCon, unitTy, wordDataCon, wordTy)
+import TysPrim(addrPrimTy, addrPrimTyCon, charPrimTy, charPrimTyCon, doublePrimTy, doublePrimTyCon, floatPrimTy, floatPrimTyCon, intPrimTy, intPrimTyCon, realWorldStatePrimTy, realWorldTy, realWorldTyCon, voidPrimTy, wordPrimTy, wordPrimTyCon)
+import TysWiredIn(addrDataCon, addrTy, addrTyCon, boolTy, boolTyCon, charDataCon, charTy, charTyCon, cmpTagTy, consDataCon, doubleDataCon, doubleTy, doubleTyCon, eqPrimDataCon, falseDataCon, floatDataCon, floatTy, floatTyCon, getStatePairingConInfo, gtPrimDataCon, intDataCon, intTy, intTyCon, integerDataCon, integerTy, integerTyCon, liftDataCon, liftTyCon, listTyCon, ltPrimDataCon, mkLiftTy, mkListTy, mkPrimIoTy, mkTupleTy, nilDataCon, ratioDataCon, rationalTy, rationalTyCon, realWorldStateTy, stateDataCon, stringTy, trueDataCon, unitTy, wordDataCon, wordTy, wordTyCon)
 import UniType(TauType(..), UniType)
 import Unique(Unique)
 import UniType(TauType(..), UniType)
 import Unique(Unique)
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
+data GlobalSwitch 
+data CoreExpr a b 
 data HeapOffset 
 data HeapOffset 
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
+data Id 
+data Labda a 
+data Name 
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreExpr = CoreExpr Id Id
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data PprStyle 
+data PrimKind 
 data HeapRequirement   = NoHeapRequired | FixedHeapRequired HeapOffset | VariableHeapRequired
 data PrimOp
   = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp
 data PrimOpResultInfo   = ReturnsPrim PrimKind | ReturnsAlg TyCon
 data HeapRequirement   = NoHeapRequired | FixedHeapRequired HeapOffset | VariableHeapRequired
 data PrimOp
   = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp
 data PrimOpResultInfo   = ReturnsPrim PrimKind | ReturnsAlg TyCon
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
+data TyCon 
 type TauType = UniType
 type TauType = UniType
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniType 
+data Unique 
 gLASGOW_MISC :: _PackedString
 gLASGOW_MISC :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gLASGOW_ST :: _PackedString
 gLASGOW_ST :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE :: _PackedString
 pRELUDE :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_BUILTIN :: _PackedString
 pRELUDE_BUILTIN :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_CORE :: _PackedString
 pRELUDE_CORE :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_IO :: _PackedString
 pRELUDE_IO :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_LIST :: _PackedString
 pRELUDE_LIST :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_PRIMIO :: _PackedString
 pRELUDE_PRIMIO :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_PS :: _PackedString
 pRELUDE_PS :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_RATIO :: _PackedString
 pRELUDE_RATIO :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_TEXT :: _PackedString
 pRELUDE_TEXT :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 aBSENT_ERROR_ID :: Id
 aBSENT_ERROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 buildId :: Id
 buildId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eRROR_ID :: Id
 eRROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 foldlId :: Id
 foldlId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 foldrId :: Id
 foldrId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerMinusOneId :: Id
 integerMinusOneId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerPlusOneId :: Id
 integerPlusOneId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerZeroId :: Id
 integerZeroId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkBuild :: UniType -> TyVar -> Id -> Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkBuild :: UniType -> TyVar -> Id -> Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 mkFoldl :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
 mkFoldl :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkFoldr :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
 mkFoldr :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 fragilePrimOp :: PrimOp -> Bool
 fragilePrimOp :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isCompareOp :: PrimOp -> Bool
 isCompareOp :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 addrPrimTy :: UniType
 addrPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrPrimTyCon :: TyCon
 addrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charPrimTy :: UniType
 charPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charPrimTyCon :: TyCon
 charPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doublePrimTy :: UniType
 doublePrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doublePrimTyCon :: TyCon
 doublePrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatPrimTy :: UniType
 floatPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatPrimTyCon :: TyCon
 floatPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intPrimTy :: UniType
 intPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intPrimTyCon :: TyCon
 intPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrDataCon :: Id
 addrDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrTy :: UniType
 addrTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+addrTyCon :: TyCon
 boolTy :: UniType
 boolTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 boolTyCon :: TyCon
 boolTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 builtinNameInfo :: (GlobalSwitch -> Bool) -> (_PackedString -> Labda Name, _PackedString -> Labda Name)
 builtinNameInfo :: (GlobalSwitch -> Bool) -> (_PackedString -> Labda Name, _PackedString -> Labda Name)
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charDataCon :: Id
 charDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charTy :: UniType
 charTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charTyCon :: TyCon
 charTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cmpTagTy :: UniType
 cmpTagTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 consDataCon :: Id
 consDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleDataCon :: Id
 doubleDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleTy :: UniType
 doubleTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleTyCon :: TyCon
 doubleTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqPrimDataCon :: Id
 eqPrimDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 falseDataCon :: Id
 falseDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatDataCon :: Id
 floatDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatTy :: UniType
 floatTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatTyCon :: TyCon
 floatTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 getStatePairingConInfo :: UniType -> (Id, UniType)
 getStatePairingConInfo :: UniType -> (Id, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 gtPrimDataCon :: Id
 gtPrimDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intDataCon :: Id
 intDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intTy :: UniType
 intTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intTyCon :: TyCon
 intTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+integerDataCon :: Id
 integerTy :: UniType
 integerTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerTyCon :: TyCon
 integerTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 liftDataCon :: Id
 liftDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 liftTyCon :: TyCon
 liftTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 listTyCon :: TyCon
 listTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ltPrimDataCon :: Id
 ltPrimDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkFunTy :: UniType -> UniType -> UniType
 mkFunTy :: UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: UniType) (u1 :: UniType) -> _!_ _ORIG_ UniType UniFun [] [u0, u1] _N_ #-}
 pAT_ERROR_ID :: Id
 pAT_ERROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 packStringForCId :: Id
 packStringForCId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldPrimId :: Id
 realWorldPrimId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+unpackCString2Id :: Id
 unpackCStringAppendId :: Id
 unpackCStringAppendId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 unpackCStringId :: Id
 unpackCStringId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 voidPrimId :: Id
 voidPrimId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep
 pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 primOpCanTriggerGC :: PrimOp -> Bool
 primOpCanTriggerGC :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 primOpHeapReq :: PrimOp -> HeapRequirement
 primOpHeapReq :: PrimOp -> HeapRequirement
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 primOpIsCheap :: PrimOp -> Bool
 primOpIsCheap :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 primOpNameInfo :: PrimOp -> (_PackedString, Name)
 primOpNameInfo :: PrimOp -> (_PackedString, Name)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 primOpNeedsWrapper :: PrimOp -> Bool
 primOpNeedsWrapper :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 primOpOkForSpeculation :: PrimOp -> Bool
 primOpOkForSpeculation :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 showPrimOp :: PprStyle -> PrimOp -> [Char]
 showPrimOp :: PprStyle -> PrimOp -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
-tagOf_PrimOp :: PrimOp -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 typeOfPrimOp :: PrimOp -> UniType
 typeOfPrimOp :: PrimOp -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mkStatePrimTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 realWorldStatePrimTy :: UniType
 realWorldStatePrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_  _ORIG_ TysPrim mkStatePrimTy [ _ORIG_ TysPrim realWorldTy ] _N_ #-}
 realWorldTy :: UniType
 realWorldTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldTyCon :: TyCon
 realWorldTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 voidPrimTy :: UniType
 voidPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordPrimTy :: UniType
 wordPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordPrimTyCon :: TyCon
 wordPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkLiftTy :: UniType -> UniType
 mkLiftTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkListTy :: UniType -> UniType
 mkListTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkPrimIoTy :: UniType -> UniType
 mkPrimIoTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkTupleTy :: Int -> [UniType] -> UniType
 mkTupleTy :: Int -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 nilDataCon :: Id
 nilDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ratioDataCon :: Id
 ratioDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 rationalTy :: UniType
 rationalTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 rationalTyCon :: TyCon
 rationalTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 readUnfoldingPrimOp :: _PackedString -> PrimOp
 readUnfoldingPrimOp :: _PackedString -> PrimOp
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldStateTy :: UniType
 realWorldStateTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateDataCon :: Id
 stateDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stringTy :: UniType
 stringTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_  _ORIG_ TysWiredIn mkListTy [ _ORIG_ TysWiredIn charTy ] _N_ #-}
 trueDataCon :: Id
 trueDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 unitTy :: UniType
 unitTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordDataCon :: Id
 wordDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordTy :: UniType
 wordTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+wordTyCon :: TyCon
 instance Eq GlobalSwitch
 instance Eq GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool)] [_CONSTM_ Eq (==) (GlobalSwitch), _CONSTM_ Eq (/=) (GlobalSwitch)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq PrimKind
 instance Eq PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool)] [_CONSTM_ Eq (==) (PrimKind), _CONSTM_ Eq (/=) (PrimKind)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq PrimOp
 instance Eq PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq TyCon
 instance Eq TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord GlobalSwitch
 instance Ord GlobalSwitch
-       {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq GlobalSwitch}}, (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> _CMP_TAG)] [_DFUN_ Eq (GlobalSwitch), _CONSTM_ Ord (<) (GlobalSwitch), _CONSTM_ Ord (<=) (GlobalSwitch), _CONSTM_ Ord (>=) (GlobalSwitch), _CONSTM_ Ord (>) (GlobalSwitch), _CONSTM_ Ord max (GlobalSwitch), _CONSTM_ Ord min (GlobalSwitch), _CONSTM_ Ord _tagCmp (GlobalSwitch)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord PrimKind
 instance Ord PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq PrimKind}}, (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> _CMP_TAG)] [_DFUN_ Eq (PrimKind), _CONSTM_ Ord (<) (PrimKind), _CONSTM_ Ord (<=) (PrimKind), _CONSTM_ Ord (>=) (PrimKind), _CONSTM_ Ord (>) (PrimKind), _CONSTM_ Ord max (PrimKind), _CONSTM_ Ord min (PrimKind), _CONSTM_ Ord _tagCmp (PrimKind)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Ord TyCon
 instance Ord TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing TyCon
 instance NamedThing TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable PrimKind
 instance Outputable PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (PrimKind) _N_
-        ppr = _A_ 2 _U_ 0120 _N_ _S_ "AL" {_A_ 1 _U_ 120 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable PrimOp
 instance Outputable PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-}
 instance Outputable TyCon
 instance Outputable TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index dffc163..47e93b3 100644 (file)
@@ -29,7 +29,7 @@ module AbsPrel (
 
        -- *odd* values that need to be reached out and grabbed:
        eRROR_ID, pAT_ERROR_ID, aBSENT_ERROR_ID,
 
        -- *odd* values that need to be reached out and grabbed:
        eRROR_ID, pAT_ERROR_ID, aBSENT_ERROR_ID,
-       unpackCStringId, packStringForCId, unpackCStringAppendId,
+       unpackCStringId, unpackCString2Id, packStringForCId, unpackCStringAppendId,
        integerZeroId, integerPlusOneId, integerMinusOneId,
 
 #ifdef DPH
        integerZeroId, integerPlusOneId, integerMinusOneId,
 
 #ifdef DPH
@@ -76,12 +76,13 @@ module AbsPrel (
 
        -- types: Addr#, Int#, Word#, Int
        intPrimTy, intTy, intPrimTyCon, intTyCon, intDataCon,
 
        -- types: Addr#, Int#, Word#, Int
        intPrimTy, intTy, intPrimTyCon, intTyCon, intDataCon,
-       wordPrimTyCon, wordPrimTy, wordTy, wordDataCon,
-       addrPrimTyCon, addrPrimTy, addrTy, addrDataCon,
+       wordPrimTyCon, wordPrimTy, wordTy, wordTyCon, wordDataCon,
+       addrPrimTyCon, addrPrimTy, addrTy, addrTyCon, addrDataCon,
 
        -- types: Integer, Rational (= Ratio Integer)
        integerTy, rationalTy,
 
        -- types: Integer, Rational (= Ratio Integer)
        integerTy, rationalTy,
-       integerTyCon, rationalTyCon, ratioDataCon,
+       integerTyCon, integerDataCon,
+       rationalTyCon, ratioDataCon,
 
        -- type: Lift
        liftTyCon, liftDataCon, mkLiftTy,
 
        -- type: Lift
        liftTyCon, liftDataCon, mkLiftTy,
@@ -259,12 +260,13 @@ totally_wired_in_Ids
      (SLIT("foldl"),           WiredInVal foldlId),
      (SLIT("foldr"),           WiredInVal foldrId),
      (SLIT("_runST"),          WiredInVal runSTId),
      (SLIT("foldl"),           WiredInVal foldlId),
      (SLIT("foldr"),           WiredInVal foldrId),
      (SLIT("_runST"),          WiredInVal runSTId),
-     (SLIT("realWorld#"),      WiredInVal realWorldPrimId)
+     (SLIT("_seq_"),           WiredInVal seqId),  -- yes, used in sequential-land, too
+                                                   -- WDP 95/11
+    (SLIT("realWorld#"),       WiredInVal realWorldPrimId)
     ]
 
 parallel_vals
     ]
 
 parallel_vals
-  =[(SLIT("_seq_"),            WiredInVal seqId),
-    (SLIT("_par_"),            WiredInVal parId),
+  =[(SLIT("_par_"),            WiredInVal parId),
     (SLIT("_fork_"),           WiredInVal forkId)
 #ifdef GRAN
     ,
     (SLIT("_fork_"),           WiredInVal forkId)
 #ifdef GRAN
     ,
@@ -455,7 +457,6 @@ lots_of_primops
        IntSubOp,
        IntMulOp,
        IntQuotOp,
        IntSubOp,
        IntMulOp,
        IntQuotOp,
-       IntDivOp,
        IntRemOp,
        IntNegOp,
        AndOp,
        IntRemOp,
        IntNegOp,
        AndOp,
index bdb8b08..40ae6e7 100644 (file)
@@ -2,30 +2,29 @@
 interface PrelFuns where
 import Bag(Bag)
 import BasicLit(BasicLit)
 interface PrelFuns where
 import Bag(Bag)
 import BasicLit(BasicLit)
-import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
+import BinderInfo(BinderInfo)
 import CharSeq(CSeq)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr)
 import CharSeq(CSeq)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
-import Id(Id, IdDetails)
+import CostCentre(CostCentre)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo, arityMaybe, mkArityInfo, mkUnfolding, noIdInfo, noInfo_UF, nullSpecEnv)
-import InstEnv(InstTemplate, InstTy)
+import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, StrictnessInfo, UpdateInfo, arityMaybe, mkArityInfo, mkUnfolding, noIdInfo, noInfo_UF, nullSpecEnv)
+import InstEnv(InstTemplate)
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import Name(Name(..))
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import Name(Name(..))
-import NameTypes(FullName, Provenance, ShortName, mkPreludeCoreName)
+import NameTypes(FullName, ShortName, mkPreludeCoreName)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PlainCore(PlainCoreAtom(..), PlainCoreExpr(..))
 import PreludePS(_PackedString)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PlainCore(PlainCoreAtom(..), PlainCoreExpr(..))
 import PreludePS(_PackedString)
-import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind(..))
 import PrimOps(PrimOp(..))
 import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance(..))
 import SrcLoc(SrcLoc)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind(..))
 import PrimOps(PrimOp(..))
 import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance(..))
 import SrcLoc(SrcLoc)
-import TyCon(Arity(..), TyCon, cmpTyCon)
+import TyCon(Arity(..), TyCon)
 import TyVar(TyVar, TyVarTemplate, alpha_tv, alpha_tyvar, beta_tv, beta_tyvar, delta_tv, delta_tyvar, epsilon_tv, epsilon_tyvar, gamma_tv, gamma_tyvar)
 import TyVarEnv(TyVarEnv(..))
 import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType(..), alpha, alpha_ty, beta, beta_ty, delta, delta_ty, epsilon, epsilon_ty, gamma, gamma_ty)
 import TyVar(TyVar, TyVarTemplate, alpha_tv, alpha_tyvar, beta_tv, beta_tyvar, delta_tv, delta_tyvar, epsilon_tv, epsilon_tyvar, gamma_tv, gamma_tyvar)
 import TyVarEnv(TyVarEnv(..))
 import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType(..), alpha, alpha_ty, beta, beta_ty, delta, delta_ty, epsilon, epsilon_ty, gamma, gamma_ty)
@@ -33,198 +32,121 @@ import UniqFM(UniqFM)
 import Unique(Unique)
 class OptIdInfo a where
        noInfo :: a
 import Unique(Unique)
 class OptIdInfo a where
        noInfo :: a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) -> _APP_  _TYAPP_  patError# { u0 } [ _NOREP_S_ "%DIdInfo.OptIdInfo.noInfo\"" ] _N_ #-}
        getInfo :: IdInfo -> a
        getInfo :: IdInfo -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.getInfo\"", u2 ] _N_ #-}
        addInfo :: IdInfo -> a -> IdInfo
        addInfo :: IdInfo -> a -> IdInfo
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) (u3 :: u0) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0 -> IdInfo) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.addInfo\"", u2, u3 ] _N_ #-}
        ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
        ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 6 _U_ 022222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 6 XXXXXX 7 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: PprStyle) (u3 :: Id -> Id) (u4 :: u0) (u5 :: Int) (u6 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.ppInfo\"", u2, u3, u4, u5, u6 ] _N_ #-}
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data CoreArg a         {-# GHC_PRAGMA TypeArg UniType | ValArg (CoreAtom a) #-}
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreCaseAlternatives a b  {-# GHC_PRAGMA CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b) #-}
-data CoreCaseDefault a b       {-# GHC_PRAGMA CoNoDefault | CoBindDefault a (CoreExpr a b) #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Bag a 
+data BasicLit 
+data BinderInfo 
+data Class 
+data ClassOp 
+data GlobalSwitch 
+data CoreArg a 
+data CoreAtom a 
+data CoreBinding a b 
+data CoreCaseAlternatives a b 
+data CoreCaseDefault a b 
+data CoreExpr a b 
+data CostCentre 
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data ArgUsage  {-# GHC_PRAGMA ArgUsage Int | UnknownArgUsage #-}
-data ArgUsageInfo      {-# GHC_PRAGMA NoArgUsageInfo | SomeArgUsageInfo [ArgUsage] #-}
-data ArityInfo         {-# GHC_PRAGMA UnknownArity | ArityExactly Int #-}
-data DeforestInfo      {-# GHC_PRAGMA Don'tDeforest | DoDeforest #-}
-data Demand    {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-}
-data DemandInfo        {-# GHC_PRAGMA UnknownDemand | DemandedAsPer Demand #-}
-data FBConsum  {-# GHC_PRAGMA FBGoodConsum | FBBadConsum #-}
-data FBProd    {-# GHC_PRAGMA FBGoodProd | FBBadProd #-}
-data FBType    {-# GHC_PRAGMA FBType [FBConsum] FBProd #-}
-data FBTypeInfo        {-# GHC_PRAGMA NoFBTypeInfo | SomeFBTypeInfo FBType #-}
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data SpecEnv   {-# GHC_PRAGMA SpecEnv [SpecInfo] #-}
-data StrictnessInfo    {-# GHC_PRAGMA NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id) #-}
-data UpdateInfo        {-# GHC_PRAGMA NoUpdateInfo | SomeUpdateInfo [Int] #-}
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data ArgUsage 
+data ArgUsageInfo 
+data ArityInfo 
+data DeforestInfo 
+data Demand 
+data DemandInfo 
+data FBConsum 
+data FBProd 
+data FBType 
+data FBTypeInfo 
+data IdInfo 
+data SpecEnv 
+data StrictnessInfo 
+data UpdateInfo 
+data InstTemplate 
+data Labda a 
 data Name   = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString
 data Name   = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
+data FullName 
+data ShortName 
+data ExportFlag 
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreExpr = CoreExpr Id Id
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
+data PrettyRep 
 data PrimKind   = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
 data PrimOp
   = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp
 data PrimKind   = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
 data PrimOp
   = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp
-data UnfoldingDetails  {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-}
+data UnfoldingDetails 
 data UnfoldingGuidance   = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int
 data UnfoldingGuidance   = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data SrcLoc 
 type Arity = Int
 type Arity = Int
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type TyVarEnv a = UniqFM a
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 data UniType   = UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType
 type TyVarEnv a = UniqFM a
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 data UniType   = UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniqFM a 
+data Unique 
 arityMaybe :: ArityInfo -> Labda Int
 arityMaybe :: ArityInfo -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: ArityInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo UnknownArity  -> _!_ _ORIG_ Maybes Hamna [Int] []; _ORIG_ IdInfo ArityExactly (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; _NO_DEFLT_ } _N_ #-}
 mkArityInfo :: Int -> ArityInfo
 mkArityInfo :: Int -> ArityInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ IdInfo ArityExactly [] [u0] _N_ #-}
 mkUnfolding :: UnfoldingGuidance -> CoreExpr Id Id -> UnfoldingDetails
 mkUnfolding :: UnfoldingGuidance -> CoreExpr Id Id -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 noIdInfo :: IdInfo
 noIdInfo :: IdInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _ORIG_ IdInfo IdInfo [] [_CONSTM_ OptIdInfo noInfo (ArityInfo), _CONSTM_ OptIdInfo noInfo (DemandInfo), _ORIG_ IdInfo nullSpecEnv, _CONSTM_ OptIdInfo noInfo (StrictnessInfo), _ORIG_ IdInfo noInfo_UF, _CONSTM_ OptIdInfo noInfo (UpdateInfo), _CONSTM_ OptIdInfo noInfo (DeforestInfo), _CONSTM_ OptIdInfo noInfo (ArgUsageInfo), _CONSTM_ OptIdInfo noInfo (FBTypeInfo), _ORIG_ SrcLoc mkUnknownSrcLoc] _N_ #-}
 noInfo_UF :: UnfoldingDetails
 noInfo_UF :: UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ SimplEnv NoUnfoldingDetails [] [] _N_ #-}
 nullSpecEnv :: SpecEnv
 nullSpecEnv :: SpecEnv
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkPreludeCoreName :: _PackedString -> _PackedString -> FullName
 mkPreludeCoreName :: _PackedString -> _PackedString -> FullName
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
-cmpTyCon :: TyCon -> TyCon -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 alpha_tv :: TyVarTemplate
 alpha_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 alpha_tyvar :: TyVar
 alpha_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 beta_tv :: TyVarTemplate
 beta_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 beta_tyvar :: TyVar
 beta_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 delta_tv :: TyVarTemplate
 delta_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 delta_tyvar :: TyVar
 delta_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 epsilon_tv :: TyVarTemplate
 epsilon_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 epsilon_tyvar :: TyVar
 epsilon_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gamma_tv :: TyVarTemplate
 gamma_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gamma_tyvar :: TyVar
 gamma_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 alpha :: UniType
 alpha :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar alpha_tv] _N_ #-}
 alpha_ty :: UniType
 alpha_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar alpha_tyvar] _N_ #-}
 beta :: UniType
 beta :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar beta_tv] _N_ #-}
 beta_ty :: UniType
 beta_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar beta_tyvar] _N_ #-}
 delta :: UniType
 delta :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar delta_tv] _N_ #-}
 delta_ty :: UniType
 delta_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar delta_tyvar] _N_ #-}
 epsilon :: UniType
 epsilon :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar epsilon_tv] _N_ #-}
 epsilon_ty :: UniType
 epsilon_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar epsilon_tyvar] _N_ #-}
 gLASGOW_MISC :: _PackedString
 gLASGOW_MISC :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gLASGOW_ST :: _PackedString
 gLASGOW_ST :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gamma :: UniType
 gamma :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar gamma_tv] _N_ #-}
 gamma_ty :: UniType
 gamma_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar gamma_tyvar] _N_ #-}
 pRELUDE :: _PackedString
 pRELUDE :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_BUILTIN :: _PackedString
 pRELUDE_BUILTIN :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_CORE :: _PackedString
 pRELUDE_CORE :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_IO :: _PackedString
 pRELUDE_IO :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_LIST :: _PackedString
 pRELUDE_LIST :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_PRIMIO :: _PackedString
 pRELUDE_PRIMIO :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_PS :: _PackedString
 pRELUDE_PS :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_RATIO :: _PackedString
 pRELUDE_RATIO :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_TEXT :: _PackedString
 pRELUDE_TEXT :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pcDataCon :: Unique -> _PackedString -> _PackedString -> [TyVarTemplate] -> [(Class, UniType)] -> [UniType] -> TyCon -> SpecEnv -> Id
 pcDataCon :: Unique -> _PackedString -> _PackedString -> [TyVarTemplate] -> [(Class, UniType)] -> [UniType] -> TyCon -> SpecEnv -> Id
-       {-# GHC_PRAGMA _A_ 8 _U_ 22222222 _N_ _N_ _N_ _N_ #-}
 pcDataTyCon :: Unique -> _PackedString -> _PackedString -> [TyVarTemplate] -> [Id] -> TyCon
 pcDataTyCon :: Unique -> _PackedString -> _PackedString -> [TyVarTemplate] -> [Id] -> TyCon
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 pcGenerateDataSpecs :: UniType -> SpecEnv
 pcGenerateDataSpecs :: UniType -> SpecEnv
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 pcGenerateSpecs :: Unique -> Id -> IdInfo -> UniType -> SpecEnv
 pcGenerateSpecs :: Unique -> Id -> IdInfo -> UniType -> SpecEnv
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 pcMiscPrelId :: Unique -> _PackedString -> _PackedString -> UniType -> IdInfo -> Id
 pcMiscPrelId :: Unique -> _PackedString -> _PackedString -> UniType -> IdInfo -> Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 pcPrimTyCon :: Unique -> _PackedString -> Int -> ([PrimKind] -> PrimKind) -> TyCon
 pcPrimTyCon :: Unique -> _PackedString -> Int -> ([PrimKind] -> PrimKind) -> TyCon
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 
 
index 9f146df..cf521b9 100644 (file)
@@ -7,55 +7,30 @@ import TyVar(TyVar)
 import UniType(UniType)
 import Unique(Unique)
 aBSENT_ERROR_ID :: Id
 import UniType(UniType)
 import Unique(Unique)
 aBSENT_ERROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 buildId :: Id
 buildId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eRROR_ID :: Id
 eRROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 errorTy :: UniType
 errorTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 foldlId :: Id
 foldlId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 foldrId :: Id
 foldrId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 forkId :: Id
 forkId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerMinusOneId :: Id
 integerMinusOneId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerPlusOneId :: Id
 integerPlusOneId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerZeroId :: Id
 integerZeroId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkBuild :: UniType -> TyVar -> Id -> Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id
 mkBuild :: UniType -> TyVar -> Id -> Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _N_ _N_ #-}
 mkFoldl :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
 mkFoldl :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 mkFoldr :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
 mkFoldr :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-}
 pAR_ERROR_ID :: Id
 pAR_ERROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pAT_ERROR_ID :: Id
 pAT_ERROR_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pRELUDE_FB :: _PackedString
 pRELUDE_FB :: _PackedString
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 packStringForCId :: Id
 packStringForCId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 parId :: Id
 parId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 pc_bottoming_Id :: Unique -> _PackedString -> _PackedString -> UniType -> Id
 pc_bottoming_Id :: Unique -> _PackedString -> _PackedString -> UniType -> Id
-       {-# GHC_PRAGMA _A_ 0 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 realWorldPrimId :: Id
 realWorldPrimId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 runSTId :: Id
 runSTId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 seqId :: Id
 seqId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 tRACE_ID :: Id
 tRACE_ID :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+unpackCString2Id :: Id
 unpackCStringAppendId :: Id
 unpackCStringAppendId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 unpackCStringId :: Id
 unpackCStringId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 voidPrimId :: Id
 voidPrimId :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index 47a4dbe..e97a16d 100644 (file)
@@ -116,11 +116,17 @@ int2IntegerId
 
 unpackCStringId
   = pcMiscPrelId unpackCStringIdKey pRELUDE_PS SLIT("unpackPS#")
 
 unpackCStringId
   = pcMiscPrelId unpackCStringIdKey pRELUDE_PS SLIT("unpackPS#")
-       (UniFun addrPrimTy{-a char *-} stringTy) noIdInfo
+                (addrPrimTy{-a char *-} `UniFun` stringTy) noIdInfo
+
+unpackCString2Id -- for cases when a string has a NUL in it
+  = pcMiscPrelId unpackCString2IdKey pRELUDE_PS SLIT("unpackPS2#")
+                (addrPrimTy{-a char *-}
+       `UniFun` (intPrimTy -- length
+       `UniFun` stringTy)) noIdInfo
 
 --------------------------------------------------------------------
 unpackCStringAppendId
 
 --------------------------------------------------------------------
 unpackCStringAppendId
-  = pcMiscPrelId unpackCStringIdKey pRELUDE_BUILTIN SLIT("unpackCStringAppend#")
+  = pcMiscPrelId unpackCStringAppendIdKey pRELUDE_BUILTIN SLIT("unpackCStringAppend#")
                                (addrPrimTy{-a "char *" pointer-} 
                `UniFun`        (stringTy
                `UniFun`        stringTy)) noIdInfo
                                (addrPrimTy{-a "char *" pointer-} 
                `UniFun`        (stringTy
                `UniFun`        stringTy)) noIdInfo
index bcaa943..7dd2713 100644 (file)
@@ -1,50 +1,23 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface PrimKind where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface PrimKind where
-import Class(Class)
-import Id(DataCon(..), Id, IdDetails)
-import IdInfo(IdInfo)
-import Maybes(Labda)
-import NameTypes(FullName)
+import Id(DataCon(..), Id)
 import Outputable(Outputable)
 import TyCon(TyCon)
 import Outputable(Outputable)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import UniType(UniType)
-import Unique(Unique)
 type DataCon = Id
 type DataCon = Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 data PrimKind   = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
 data PrimKind   = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data TyCon 
+data UniType 
 getKindInfo :: PrimKind -> ([Char], UniType, TyCon)
 getKindInfo :: PrimKind -> ([Char], UniType, TyCon)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
 getKindSize :: PrimKind -> Int
 getKindSize :: PrimKind -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
 guessPrimKind :: [Char] -> PrimKind
 guessPrimKind :: [Char] -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isFloatingKind :: PrimKind -> Bool
 isFloatingKind :: PrimKind -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 20 \ (u0 :: PrimKind) -> case u0 of { _ALG_ _ORIG_ PrimKind DoubleKind  -> _!_ True [] []; _ORIG_ PrimKind FloatKind  -> _!_ True [] []; (u1 :: PrimKind) -> _!_ False [] [] } _N_ #-}
 isFollowableKind :: PrimKind -> Bool
 isFollowableKind :: PrimKind -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
 retKindSize :: Int
 retKindSize :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 separateByPtrFollowness :: (a -> PrimKind) -> [a] -> ([a], [a])
 separateByPtrFollowness :: (a -> PrimKind) -> [a] -> ([a], [a])
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 showPrimKind :: PrimKind -> [Char]
 showPrimKind :: PrimKind -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-}
 instance Eq PrimKind
 instance Eq PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool)] [_CONSTM_ Eq (==) (PrimKind), _CONSTM_ Eq (/=) (PrimKind)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Ord PrimKind
 instance Ord PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq PrimKind}}, (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> _CMP_TAG)] [_DFUN_ Eq (PrimKind), _CONSTM_ Ord (<) (PrimKind), _CONSTM_ Ord (<=) (PrimKind), _CONSTM_ Ord (>=) (PrimKind), _CONSTM_ Ord (>) (PrimKind), _CONSTM_ Ord max (PrimKind), _CONSTM_ Ord min (PrimKind), _CONSTM_ Ord _tagCmp (PrimKind)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Outputable PrimKind
 instance Outputable PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (PrimKind) _N_
-        ppr = _A_ 2 _U_ 0120 _N_ _S_ "AL" {_A_ 1 _U_ 120 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index cc35ae3..030fec1 100644 (file)
@@ -2,9 +2,7 @@
 interface PrimOps where
 import Class(Class)
 import HeapOffs(HeapOffset)
 interface PrimOps where
 import Class(Class)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Maybes(Labda)
+import Id(Id)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(Outputable)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(Outputable)
@@ -17,49 +15,30 @@ import UniType(UniType)
 import Unique(Unique)
 data HeapOffset 
 data HeapRequirement   = NoHeapRequired | FixedHeapRequired HeapOffset | VariableHeapRequired
 import Unique(Unique)
 data HeapOffset 
 data HeapRequirement   = NoHeapRequired | FixedHeapRequired HeapOffset | VariableHeapRequired
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data Id 
+data Name 
+data PrimKind 
 data PrimOp
   = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp
 data PrimOpInfo   = Dyadic _PackedString UniType | Monadic _PackedString UniType | Compare _PackedString UniType | Coerce _PackedString UniType UniType | PrimResult _PackedString [TyVarTemplate] [UniType] TyCon PrimKind [UniType] | AlgResult _PackedString [TyVarTemplate] [UniType] TyCon [UniType]
 data PrimOpResultInfo   = ReturnsPrim PrimKind | ReturnsAlg TyCon
 data PrimOp
   = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp
 data PrimOpInfo   = Dyadic _PackedString UniType | Monadic _PackedString UniType | Compare _PackedString UniType | Coerce _PackedString UniType UniType | PrimResult _PackedString [TyVarTemplate] [UniType] TyCon PrimKind [UniType] | AlgResult _PackedString [TyVarTemplate] [UniType] TyCon [UniType]
 data PrimOpResultInfo   = ReturnsPrim PrimKind | ReturnsAlg TyCon
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data TyCon 
+data TyVarTemplate 
+data UniType 
 fragilePrimOp :: PrimOp -> Bool
 fragilePrimOp :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isCompareOp :: PrimOp -> Bool
 isCompareOp :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep
 pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 primOpCanTriggerGC :: PrimOp -> Bool
 primOpCanTriggerGC :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 primOpHeapReq :: PrimOp -> HeapRequirement
 primOpHeapReq :: PrimOp -> HeapRequirement
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 primOpId :: PrimOp -> Id
 primOpId :: PrimOp -> Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 primOpIsCheap :: PrimOp -> Bool
 primOpIsCheap :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 primOpNameInfo :: PrimOp -> (_PackedString, Name)
 primOpNameInfo :: PrimOp -> (_PackedString, Name)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 primOpNeedsWrapper :: PrimOp -> Bool
 primOpNeedsWrapper :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 primOpOkForSpeculation :: PrimOp -> Bool
 primOpOkForSpeculation :: PrimOp -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 showPrimOp :: PprStyle -> PrimOp -> [Char]
 showPrimOp :: PprStyle -> PrimOp -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 tagOf_PrimOp :: PrimOp -> Int#
 tagOf_PrimOp :: PrimOp -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 typeOfPrimOp :: PrimOp -> UniType
 typeOfPrimOp :: PrimOp -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance Eq PrimOp
 instance Eq PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Outputable PrimOp
 instance Outputable PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-}
 
 
index 99e4cdb..6aca5a0 100644 (file)
@@ -82,7 +82,7 @@ data PrimOp
     -- Int#-related ops:
     -- IntAbsOp unused?? ADR
     | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
     -- Int#-related ops:
     -- IntAbsOp unused?? ADR
     | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
-    | IntDivOp | IntRemOp | IntNegOp | IntAbsOp
+    | IntDivOp{-UNUSED-} | IntRemOp | IntNegOp | IntAbsOp
 
     -- Word#-related ops:
     | AndOp  | OrOp   | NotOp
 
     -- Word#-related ops:
     | AndOp  | OrOp   | NotOp
@@ -314,7 +314,7 @@ tagOf_PrimOp IntAddOp                       = ILIT( 39)
 tagOf_PrimOp IntSubOp                  = ILIT( 40)
 tagOf_PrimOp IntMulOp                  = ILIT( 41)
 tagOf_PrimOp IntQuotOp                 = ILIT( 42)
 tagOf_PrimOp IntSubOp                  = ILIT( 40)
 tagOf_PrimOp IntMulOp                  = ILIT( 41)
 tagOf_PrimOp IntQuotOp                 = ILIT( 42)
-tagOf_PrimOp IntDivOp                  = ILIT( 43)
+--UNUSED:tagOf_PrimOp IntDivOp                 = ILIT( 43)
 tagOf_PrimOp IntRemOp                  = ILIT( 44)
 tagOf_PrimOp IntNegOp                  = ILIT( 45)
 tagOf_PrimOp IntAbsOp                  = ILIT( 46)
 tagOf_PrimOp IntRemOp                  = ILIT( 44)
 tagOf_PrimOp IntNegOp                  = ILIT( 45)
 tagOf_PrimOp IntAbsOp                  = ILIT( 46)
@@ -611,7 +611,7 @@ primOpInfo IntAddOp  = Dyadic SLIT("plusInt#")       intPrimTy
 primOpInfo IntSubOp  = Dyadic SLIT("minusInt#") intPrimTy
 primOpInfo IntMulOp  = Dyadic SLIT("timesInt#") intPrimTy
 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#")  intPrimTy
 primOpInfo IntSubOp  = Dyadic SLIT("minusInt#") intPrimTy
 primOpInfo IntMulOp  = Dyadic SLIT("timesInt#") intPrimTy
 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#")  intPrimTy
-primOpInfo IntDivOp  = Dyadic SLIT("divInt#")   intPrimTy
+--UNUSED:primOpInfo IntDivOp  = Dyadic SLIT("divInt#")  intPrimTy
 primOpInfo IntRemOp  = Dyadic SLIT("remInt#")   intPrimTy
 
 primOpInfo IntNegOp  = Monadic SLIT("negateInt#") intPrimTy
 primOpInfo IntRemOp  = Dyadic SLIT("remInt#")   intPrimTy
 
 primOpInfo IntNegOp  = Monadic SLIT("negateInt#") intPrimTy
@@ -1006,9 +1006,9 @@ Here's what the operations and types are supposed to be (from
 state-interface document).
 
 \begin{verbatim}
 state-interface document).
 
 \begin{verbatim}
-makeStablePointer#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
-freeStablePointer#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
-deRefStablePointer# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
+makeStablePtr#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
+freeStablePtr#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
+deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
 \end{verbatim}
 
 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
 \end{verbatim}
 
 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
@@ -1017,10 +1017,10 @@ reason is that if some optimisation pass decided to duplicate calls to
 @makeStablePtr#@ and we only pass one of the stable pointers over, a
 massive space leak can result.  Putting it into the PrimIO monad
 prevents this.  (Another reason for putting them in a monad is to
 @makeStablePtr#@ and we only pass one of the stable pointers over, a
 massive space leak can result.  Putting it into the PrimIO monad
 prevents this.  (Another reason for putting them in a monad is to
-ensure correct sequencing wrt the side-effecting @freeStablePointer#@
+ensure correct sequencing wrt the side-effecting @freeStablePtr#@
 operation.)
 
 operation.)
 
-Note that we can implement @freeStablePointer#@ using @_ccall_@ (and,
+Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
 besides, it's not likely to be used from Haskell) so it's not a
 primop.
 
 besides, it's not likely to be used from Haskell) so it's not a
 primop.
 
@@ -1330,7 +1330,7 @@ of by data dependencies.
 primOpOkForSpeculation :: PrimOp -> Bool
 
 -- Int.
 primOpOkForSpeculation :: PrimOp -> Bool
 
 -- Int.
-primOpOkForSpeculation IntDivOp                = False         -- Divide by zero
+--UNUSED:primOpOkForSpeculation IntDivOp               = False         -- Divide by zero
 primOpOkForSpeculation IntQuotOp       = False         -- Divide by zero
 primOpOkForSpeculation IntRemOp                = False         -- Divide by zero
 
 primOpOkForSpeculation IntQuotOp       = False         -- Divide by zero
 primOpOkForSpeculation IntRemOp                = False         -- Divide by zero
 
@@ -1408,7 +1408,7 @@ primOpNeedsWrapper :: PrimOp -> Bool
 
 primOpNeedsWrapper (CCallOp _ _ _ _ _)         = True
 
 
 primOpNeedsWrapper (CCallOp _ _ _ _ _)         = True
 
-primOpNeedsWrapper IntDivOp            = True
+--UNUSED:primOpNeedsWrapper IntDivOp           = True
 
 primOpNeedsWrapper NewArrayOp          = True  -- ToDo: for nativeGen only!(JSM)
 primOpNeedsWrapper (NewByteArrayOp _)          = True
 
 primOpNeedsWrapper NewArrayOp          = True  -- ToDo: for nativeGen only!(JSM)
 primOpNeedsWrapper (NewByteArrayOp _)          = True
index 3603479..e93ab6a 100644 (file)
@@ -3,65 +3,34 @@ interface TysPrim where
 import TyCon(TyCon)
 import UniType(UniType)
 addrPrimTy :: UniType
 import TyCon(TyCon)
 import UniType(UniType)
 addrPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrPrimTyCon :: TyCon
 addrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 arrayPrimTyCon :: TyCon
 arrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 byteArrayPrimTy :: UniType
 byteArrayPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 byteArrayPrimTyCon :: TyCon
 byteArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charPrimTy :: UniType
 charPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charPrimTyCon :: TyCon
 charPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doublePrimTy :: UniType
 doublePrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doublePrimTyCon :: TyCon
 doublePrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatPrimTy :: UniType
 floatPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatPrimTyCon :: TyCon
 floatPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intPrimTy :: UniType
 intPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intPrimTyCon :: TyCon
 intPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mallocPtrPrimTyCon :: TyCon
 mallocPtrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkArrayPrimTy :: UniType -> UniType
 mkArrayPrimTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkMutableArrayPrimTy :: UniType -> UniType -> UniType
 mkMutableArrayPrimTy :: UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkMutableByteArrayPrimTy :: UniType -> UniType
 mkMutableByteArrayPrimTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStablePtrPrimTy :: UniType -> UniType
 mkStablePtrPrimTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStatePrimTy :: UniType -> UniType
 mkStatePrimTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkSynchVarPrimTy :: UniType -> UniType -> UniType
 mkSynchVarPrimTy :: UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mutableArrayPrimTyCon :: TyCon
 mutableArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mutableByteArrayPrimTyCon :: TyCon
 mutableByteArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldStatePrimTy :: UniType
 realWorldStatePrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_  _ORIG_ TysPrim mkStatePrimTy [ _ORIG_ TysPrim realWorldTy ] _N_ #-}
 realWorldTy :: UniType
 realWorldTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldTyCon :: TyCon
 realWorldTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stablePtrPrimTyCon :: TyCon
 stablePtrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 statePrimTyCon :: TyCon
 statePrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 synchVarPrimTyCon :: TyCon
 synchVarPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 voidPrimTy :: UniType
 voidPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordPrimTy :: UniType
 wordPrimTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordPrimTyCon :: TyCon
 wordPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index 270b1d6..6999800 100644 (file)
@@ -4,143 +4,74 @@ import Id(Id)
 import TyCon(TyCon)
 import UniType(UniType)
 addrDataCon :: Id
 import TyCon(TyCon)
 import UniType(UniType)
 addrDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrTy :: UniType
 addrTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 addrTyCon :: TyCon
 addrTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 boolTy :: UniType
 boolTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 boolTyCon :: TyCon
 boolTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charDataCon :: Id
 charDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charTy :: UniType
 charTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 charTyCon :: TyCon
 charTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cmpTagTy :: UniType
 cmpTagTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cmpTagTyCon :: TyCon
 cmpTagTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 consDataCon :: Id
 consDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleDataCon :: Id
 doubleDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleTy :: UniType
 doubleTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 doubleTyCon :: TyCon
 doubleTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqPrimDataCon :: Id
 eqPrimDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 falseDataCon :: Id
 falseDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatDataCon :: Id
 floatDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatTy :: UniType
 floatTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 floatTyCon :: TyCon
 floatTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 getStatePairingConInfo :: UniType -> (Id, UniType)
 getStatePairingConInfo :: UniType -> (Id, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 gtPrimDataCon :: Id
 gtPrimDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intDataCon :: Id
 intDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intTy :: UniType
 intTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 intTyCon :: TyCon
 intTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+integerDataCon :: Id
 integerTy :: UniType
 integerTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 integerTyCon :: TyCon
 integerTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 liftDataCon :: Id
 liftDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 liftTyCon :: TyCon
 liftTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 listTyCon :: TyCon
 listTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ltPrimDataCon :: Id
 ltPrimDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mallocPtrTyCon :: TyCon
 mallocPtrTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkLiftTy :: UniType -> UniType
 mkLiftTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkListTy :: UniType -> UniType
 mkListTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkPrimIoTy :: UniType -> UniType
 mkPrimIoTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 mkStateTransformerTy :: UniType -> UniType -> UniType
 mkStateTransformerTy :: UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkTupleTy :: Int -> [UniType] -> UniType
 mkTupleTy :: Int -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 nilDataCon :: Id
 nilDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 primIoTyCon :: TyCon
 primIoTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ratioDataCon :: Id
 ratioDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ratioTyCon :: TyCon
 ratioTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 rationalTy :: UniType
 rationalTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 rationalTyCon :: TyCon
 rationalTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 realWorldStateTy :: UniType
 realWorldStateTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 return2GMPsTyCon :: TyCon
 return2GMPsTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 returnIntAndGMPTyCon :: TyCon
 returnIntAndGMPTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stTyCon :: TyCon
 stTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stablePtrTyCon :: TyCon
 stablePtrTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndAddrPrimTyCon :: TyCon
 stateAndAddrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndArrayPrimTyCon :: TyCon
 stateAndArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndByteArrayPrimTyCon :: TyCon
 stateAndByteArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndCharPrimTyCon :: TyCon
 stateAndCharPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndDoublePrimTyCon :: TyCon
 stateAndDoublePrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndFloatPrimTyCon :: TyCon
 stateAndFloatPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndIntPrimTyCon :: TyCon
 stateAndIntPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMallocPtrPrimTyCon :: TyCon
 stateAndMallocPtrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMutableArrayPrimTyCon :: TyCon
 stateAndMutableArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndMutableByteArrayPrimTyCon :: TyCon
 stateAndMutableByteArrayPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndPtrPrimTyCon :: TyCon
 stateAndPtrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndStablePtrPrimTyCon :: TyCon
 stateAndStablePtrPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndSynchVarPrimTyCon :: TyCon
 stateAndSynchVarPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateAndWordPrimTyCon :: TyCon
 stateAndWordPrimTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateDataCon :: Id
 stateDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stateTyCon :: TyCon
 stateTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stringTy :: UniType
 stringTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_  _ORIG_ TysWiredIn mkListTy [ _ORIG_ TysWiredIn charTy ] _N_ #-}
 stringTyCon :: TyCon
 stringTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 trueDataCon :: Id
 trueDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 unitTy :: UniType
 unitTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordDataCon :: Id
 wordDataCon :: Id
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordTy :: UniType
 wordTy :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 wordTyCon :: TyCon
 wordTyCon :: TyCon
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index ce28587..b0b198c 100644 (file)
@@ -39,6 +39,7 @@ module TysWiredIn (
        intTyCon,
        integerTy,
        integerTyCon,
        intTyCon,
        integerTy,
        integerTyCon,
+       integerDataCon,
        liftDataCon,
        liftTyCon,
        listTyCon,
        liftDataCon,
        liftTyCon,
        listTyCon,
index 6b44d01..abb818d 100644 (file)
@@ -1,76 +1,45 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CostCentre where
 import CharSeq(CSeq)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CostCentre where
 import CharSeq(CSeq)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import Pretty(PprStyle)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import Pretty(PprStyle)
-import UniType(UniType)
-import Unique(Unique)
 import Unpretty(Unpretty(..))
 import Unpretty(Unpretty(..))
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data CcKind    {-# GHC_PRAGMA UserCC _PackedString | AutoCC Id | DictCC Id #-}
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CSeq 
+data CcKind 
+data CostCentre 
+data Id 
 data IsCafCC   = IsCafCC | IsNotCafCC
 data IsCafCC   = IsCafCC | IsNotCafCC
-data IsDupdCC  {-# GHC_PRAGMA AnOriginalCC | ADupdCC #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data IsDupdCC 
+data Labda a 
 type Unpretty = CSeq
 cafifyCC :: CostCentre -> CostCentre
 type Unpretty = CSeq
 cafifyCC :: CostCentre -> CostCentre
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 ccFromThisModule :: CostCentre -> _PackedString -> Bool
 ccFromThisModule :: CostCentre -> _PackedString -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 ccMentionsId :: CostCentre -> Labda Id
 ccMentionsId :: CostCentre -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 cmpCostCentre :: CostCentre -> CostCentre -> Int#
 cmpCostCentre :: CostCentre -> CostCentre -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 costsAreSubsumed :: CostCentre -> Bool
 costsAreSubsumed :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 12 \ (u0 :: CostCentre) -> case u0 of { _ALG_ _ORIG_ CostCentre SubsumedCosts  -> _!_ True [] []; (u1 :: CostCentre) -> _!_ False [] [] } _N_ #-}
 currentOrSubsumedCosts :: CostCentre -> Bool
 currentOrSubsumedCosts :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 13 \ (u0 :: CostCentre) -> case u0 of { _ALG_ _ORIG_ CostCentre SubsumedCosts  -> _!_ True [] []; _ORIG_ CostCentre CurrentCC  -> _!_ True [] []; (u1 :: CostCentre) -> _!_ False [] [] } _N_ #-}
 dontCareCostCentre :: CostCentre
 dontCareCostCentre :: CostCentre
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CostCentre DontCareCC [] [] _N_ #-}
 dupifyCC :: CostCentre -> CostCentre
 dupifyCC :: CostCentre -> CostCentre
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isCafCC :: CostCentre -> Bool
 isCafCC :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isDictCC :: CostCentre -> Bool
 isDictCC :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isDupdCC :: CostCentre -> Bool
 isDupdCC :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkAllCafsCC :: _PackedString -> _PackedString -> CostCentre
 mkAllCafsCC :: _PackedString -> _PackedString -> CostCentre
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _ORIG_ CostCentre AllCafsCC [] [u0, u1] _N_ #-}
 mkAllDictsCC :: _PackedString -> _PackedString -> Bool -> CostCentre
 mkAllDictsCC :: _PackedString -> _PackedString -> Bool -> CostCentre
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _N_ _N_ #-}
 mkAutoCC :: Id -> _PackedString -> _PackedString -> IsCafCC -> CostCentre
 mkAutoCC :: Id -> _PackedString -> _PackedString -> IsCafCC -> CostCentre
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 mkDictCC :: Id -> _PackedString -> _PackedString -> IsCafCC -> CostCentre
 mkDictCC :: Id -> _PackedString -> _PackedString -> IsCafCC -> CostCentre
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 mkUserCC :: _PackedString -> _PackedString -> _PackedString -> CostCentre
 mkUserCC :: _PackedString -> _PackedString -> _PackedString -> CostCentre
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 noCostCentre :: CostCentre
 noCostCentre :: CostCentre
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CostCentre NoCostCentre [] [] _N_ #-}
 noCostCentreAttached :: CostCentre -> Bool
 noCostCentreAttached :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 12 \ (u0 :: CostCentre) -> case u0 of { _ALG_ _ORIG_ CostCentre NoCostCentre  -> _!_ True [] []; (u1 :: CostCentre) -> _!_ False [] [] } _N_ #-}
 overheadCostCentre :: CostCentre
 overheadCostCentre :: CostCentre
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CostCentre OverheadCC [] [] _N_ #-}
 preludeCafsCostCentre :: CostCentre
 preludeCafsCostCentre :: CostCentre
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CostCentre PreludeCafsCC [] [] _N_ #-}
 preludeDictsCostCentre :: Bool -> CostCentre
 preludeDictsCostCentre :: Bool -> CostCentre
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 setToAbleCostCentre :: CostCentre -> Bool
 setToAbleCostCentre :: CostCentre -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 showCostCentre :: PprStyle -> Bool -> CostCentre -> [Char]
 showCostCentre :: PprStyle -> Bool -> CostCentre -> [Char]
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLS" _N_ _N_ #-}
 subsumedCosts :: CostCentre
 subsumedCosts :: CostCentre
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CostCentre SubsumedCosts [] [] _N_ #-}
 unCafifyCC :: CostCentre -> CostCentre
 unCafifyCC :: CostCentre -> CostCentre
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 uppCostCentre :: PprStyle -> Bool -> CostCentre -> CSeq
 uppCostCentre :: PprStyle -> Bool -> CostCentre -> CSeq
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LLS" _N_ _N_ #-}
 uppCostCentreDecl :: PprStyle -> Bool -> CostCentre -> CSeq
 uppCostCentreDecl :: PprStyle -> Bool -> CostCentre -> CSeq
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LEL" _N_ _N_ #-}
 useCurrentCostCentre :: CostCentre
 useCurrentCostCentre :: CostCentre
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CostCentre CurrentCC [] [] _N_ #-}
 
 
index b65db55..cca120d 100644 (file)
@@ -5,5 +5,4 @@ import CoreSyn(CoreBinding)
 import Id(Id)
 import PreludePS(_PackedString)
 addAutoCostCentres :: (GlobalSwitch -> SwitchResult) -> _PackedString -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 import Id(Id)
 import PreludePS(_PackedString)
 addAutoCostCentres :: (GlobalSwitch -> SwitchResult) -> _PackedString -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLS" _N_ _N_ #-}
 
 
index 3814da2..088fee5 100644 (file)
@@ -7,5 +7,4 @@ import PreludePS(_PackedString)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 stgMassageForProfiling :: _PackedString -> _PackedString -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> [StgBinding Id Id] -> (([CostCentre], [CostCentre]), [StgBinding Id Id])
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 stgMassageForProfiling :: _PackedString -> _PackedString -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> [StgBinding Id Id] -> (([CostCentre], [CostCentre]), [StgBinding Id Id])
-       {-# GHC_PRAGMA _A_ 5 _U_ 22221 _N_ _N_ _N_ _N_ #-}
 
 
index 8ed77a5..ad4b74d 100644 (file)
@@ -19,5 +19,4 @@ type SrcFile = _PackedString
 type SrcFun = _PackedString
 type SrcLine = Int
 readInteger :: [Char] -> Integer
 type SrcFun = _PackedString
 type SrcLine = Int
 readInteger :: [Char] -> Integer
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 
 
index c51ebb4..d7a5a8f 100644 (file)
@@ -9,25 +9,14 @@ import PrefixSyn(RdrBinding, RdrMatch)
 import PreludePS(_PackedString)
 import ProtoName(ProtoName)
 cvBinds :: _PackedString -> (RdrBinding -> [Sig ProtoName]) -> RdrBinding -> Binds ProtoName (InPat ProtoName)
 import PreludePS(_PackedString)
 import ProtoName(ProtoName)
 cvBinds :: _PackedString -> (RdrBinding -> [Sig ProtoName]) -> RdrBinding -> Binds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LLS" _N_ _N_ #-}
 cvClassOpSig :: RdrBinding -> [Sig ProtoName]
 cvClassOpSig :: RdrBinding -> [Sig ProtoName]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 cvInstDeclSig :: RdrBinding -> [Sig ProtoName]
 cvInstDeclSig :: RdrBinding -> [Sig ProtoName]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 cvInstDecls :: Bool -> _PackedString -> _PackedString -> [_PackedString -> _PackedString -> Bool -> InstDecl ProtoName (InPat ProtoName)] -> [InstDecl ProtoName (InPat ProtoName)]
 cvInstDecls :: Bool -> _PackedString -> _PackedString -> [_PackedString -> _PackedString -> Bool -> InstDecl ProtoName (InPat ProtoName)] -> [InstDecl ProtoName (InPat ProtoName)]
-       {-# GHC_PRAGMA _A_ 4 _U_ 2221 _N_ _S_ "LLLS" _N_ _N_ #-}
 cvMatches :: _PackedString -> Bool -> [RdrMatch] -> [Match ProtoName (InPat ProtoName)]
 cvMatches :: _PackedString -> Bool -> [RdrMatch] -> [Match ProtoName (InPat ProtoName)]
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 cvMonoBinds :: _PackedString -> [RdrBinding] -> MonoBinds ProtoName (InPat ProtoName)
 cvMonoBinds :: _PackedString -> [RdrBinding] -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 cvSepdBinds :: _PackedString -> (RdrBinding -> [Sig ProtoName]) -> [RdrBinding] -> Binds ProtoName (InPat ProtoName)
 cvSepdBinds :: _PackedString -> (RdrBinding -> [Sig ProtoName]) -> [RdrBinding] -> Binds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LLS" _N_ _N_ #-}
 cvValSig :: RdrBinding -> [Sig ProtoName]
 cvValSig :: RdrBinding -> [Sig ProtoName]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 sepDeclsForInterface :: RdrBinding -> ([TyDecl ProtoName], [ClassDecl ProtoName (InPat ProtoName)], [_PackedString -> _PackedString -> Bool -> InstDecl ProtoName (InPat ProtoName)], [RdrBinding], [IfaceImportDecl])
 sepDeclsForInterface :: RdrBinding -> ([TyDecl ProtoName], [ClassDecl ProtoName (InPat ProtoName)], [_PackedString -> _PackedString -> Bool -> InstDecl ProtoName (InPat ProtoName)], [RdrBinding], [IfaceImportDecl])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 sepDeclsForTopBinds :: RdrBinding -> ([TyDecl ProtoName], [DataTypeSig ProtoName], [ClassDecl ProtoName (InPat ProtoName)], [_PackedString -> _PackedString -> Bool -> InstDecl ProtoName (InPat ProtoName)], [SpecialisedInstanceSig ProtoName], [DefaultDecl ProtoName], [RdrBinding])
 sepDeclsForTopBinds :: RdrBinding -> ([TyDecl ProtoName], [DataTypeSig ProtoName], [ClassDecl ProtoName (InPat ProtoName)], [_PackedString -> _PackedString -> Bool -> InstDecl ProtoName (InPat ProtoName)], [SpecialisedInstanceSig ProtoName], [DefaultDecl ProtoName], [RdrBinding])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 sepDeclsIntoSigsAndBinds :: RdrBinding -> ([RdrBinding], [RdrBinding])
 sepDeclsIntoSigsAndBinds :: RdrBinding -> ([RdrBinding], [RdrBinding])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 4e787b3..45eeb4f 100644 (file)
@@ -9,13 +9,8 @@ import ProtoName(ProtoName)
 import U_hpragma(U_hpragma)
 type ProtoUfBinder = (ProtoName, PolyType ProtoName)
 wlkClassPragma :: U_hpragma -> _PackedString -> _State _RealWorld -> (ClassPragmas ProtoName, _State _RealWorld)
 import U_hpragma(U_hpragma)
 type ProtoUfBinder = (ProtoName, PolyType ProtoName)
 wlkClassPragma :: U_hpragma -> _PackedString -> _State _RealWorld -> (ClassPragmas ProtoName, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 wlkDataPragma :: U_hpragma -> _PackedString -> _State _RealWorld -> (DataPragmas ProtoName, _State _RealWorld)
 wlkDataPragma :: U_hpragma -> _PackedString -> _State _RealWorld -> (DataPragmas ProtoName, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 wlkInstPragma :: U_hpragma -> _PackedString -> _State _RealWorld -> ((Labda _PackedString, InstancePragmas ProtoName), _State _RealWorld)
 wlkInstPragma :: U_hpragma -> _PackedString -> _State _RealWorld -> ((Labda _PackedString, InstancePragmas ProtoName), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 wlkTySigPragmas :: U_hpragma -> _PackedString -> _State _RealWorld -> (RdrTySigPragmas, _State _RealWorld)
 wlkTySigPragmas :: U_hpragma -> _PackedString -> _State _RealWorld -> (RdrTySigPragmas, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 wlkTypePragma :: U_hpragma -> _PackedString -> _State _RealWorld -> (TypePragmas, _State _RealWorld)
 wlkTypePragma :: U_hpragma -> _PackedString -> _State _RealWorld -> (TypePragmas, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 5857d24..3eda3e9 100644 (file)
@@ -9,11 +9,7 @@ import ProtoName(ProtoName)
 import U_list(U_list)
 import U_ttype(U_ttype)
 rdConDecl :: _Addr -> _PackedString -> _State _RealWorld -> (ConDecl ProtoName, _State _RealWorld)
 import U_list(U_list)
 import U_ttype(U_ttype)
 rdConDecl :: _Addr -> _PackedString -> _State _RealWorld -> (ConDecl ProtoName, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdModule :: _State _RealWorld -> ((_PackedString, (_PackedString -> Bool, _PackedString -> Bool), Module ProtoName (InPat ProtoName)), _State _RealWorld)
 rdModule :: _State _RealWorld -> ((_PackedString, (_PackedString -> Bool, _PackedString -> Bool), Module ProtoName (InPat ProtoName)), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 wlkList :: (_Addr -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> U_list -> _PackedString -> _State _RealWorld -> ([a], _State _RealWorld)
 wlkList :: (_Addr -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> U_list -> _PackedString -> _State _RealWorld -> ([a], _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 wlkMonoType :: U_ttype -> _PackedString -> _State _RealWorld -> (MonoType ProtoName, _State _RealWorld)
 wlkMonoType :: U_ttype -> _PackedString -> _State _RealWorld -> (MonoType ProtoName, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 5735736..5529665 100644 (file)
@@ -2,7 +2,6 @@
 interface Rename where
 import AbsSyn(Module)
 import Bag(Bag)
 interface Rename where
 import AbsSyn(Module)
 import Bag(Bag)
-import CharSeq(CSeq)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import HsBinds(Binds, Sig)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import HsBinds(Binds, Sig)
@@ -15,32 +14,30 @@ import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..), GlobalNameFuns(..), PreludeNameFun(..), PreludeNameFuns(..))
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..), GlobalNameFuns(..), PreludeNameFun(..), PreludeNameFuns(..))
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data Module a b 
+data Bag a 
+data GlobalSwitch 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data InPat a 
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data SplitUniqSupply 
 renameModule :: (GlobalSwitch -> Bool) -> (_PackedString -> Labda Name, _PackedString -> Labda Name) -> Module ProtoName (InPat ProtoName) -> SplitUniqSupply -> (Module Name (InPat Name), [_PackedString], (ProtoName -> Labda Name, ProtoName -> Labda Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 renameModule :: (GlobalSwitch -> Bool) -> (_PackedString -> Labda Name, _PackedString -> Labda Name) -> Module ProtoName (InPat ProtoName) -> SplitUniqSupply -> (Module Name (InPat Name), [_PackedString], (ProtoName -> Labda Name, ProtoName -> Labda Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2121 _N_ _S_ "LU(LL)U(LLSLLLLLLLLAL)U(ALL)" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 76ece57..808dd8b 100644 (file)
@@ -20,18 +20,17 @@ import RenameAuxFuns(PreludeNameFun(..), PreludeNameFuns(..))
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data Module a b 
+data Bag a 
+data InPat a 
 type ProtoNamePat = InPat ProtoName
 type ProtoNamePat = InPat ProtoName
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
 rnModule1 :: (_PackedString -> Labda Name, _PackedString -> Labda Name) -> Bool -> Module ProtoName (InPat ProtoName) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ((Module ProtoName (InPat ProtoName), [_PackedString]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
 rnModule1 :: (_PackedString -> Labda Name, _PackedString -> Labda Name) -> Bool -> Module ProtoName (InPat ProtoName) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ((Module ProtoName (InPat ProtoName), [_PackedString]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 12122 _N_ _S_ "U(LL)LU(LLSLLLLLLLLAL)" {_A_ 4 _U_ 222122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index b9efb8a..80f56d7 100644 (file)
@@ -508,6 +508,13 @@ doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAbs orig_name)
 doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAll orig_name)
   = int_import1_help orig_to_pn local_to_pn acc orig_name
 
 doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAll orig_name)
   = int_import1_help orig_to_pn local_to_pn acc orig_name
 
+-- the next ones will go away with 1.3:
+doIfaceImport1 orig_to_pn local_to_pn acc (IEConWithCons orig_name _)
+  = int_import1_help orig_to_pn local_to_pn acc orig_name
+
+doIfaceImport1 orig_to_pn local_to_pn acc (IEClsWithOps orig_name _)
+  = int_import1_help orig_to_pn local_to_pn acc orig_name
+
 doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) other
   = panic "Rename1: strange import decl"
 
 doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) other
   = panic "Rename1: strange import decl"
 
index 787f628..68f4a63 100644 (file)
@@ -14,14 +14,13 @@ import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import SrcLoc(SrcLoc)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import SrcLoc(SrcLoc)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data Module a b 
+data Bag a 
+data InPat a 
 type ProtoNamePat = InPat ProtoName
 type ProtoNamePat = InPat ProtoName
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 rnModule2 :: Module ProtoName (InPat ProtoName) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (Module ProtoName (InPat ProtoName), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnModule2 :: Module ProtoName (InPat ProtoName) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (Module ProtoName (InPat ProtoName), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLSSSSSSLLSL)" _N_ _N_ #-}
 
 
index a89d682..484bf85 100644 (file)
@@ -2,8 +2,6 @@
 interface Rename3 where
 import AbsSyn(Module)
 import Bag(Bag)
 interface Rename3 where
 import AbsSyn(Module)
 import Bag(Bag)
-import CharSeq(CSeq)
-import CmdLineOpts(GlobalSwitch)
 import FiniteMap(FiniteMap)
 import HsBinds(Binds, Sig)
 import HsDecls(ClassDecl, DataTypeSig, DefaultDecl, FixityDecl, InstDecl, SpecialisedInstanceSig, TyDecl)
 import FiniteMap(FiniteMap)
 import HsBinds(Binds, Sig)
 import HsDecls(ClassDecl, DataTypeSig, DefaultDecl, FixityDecl, InstDecl, SpecialisedInstanceSig, TyDecl)
@@ -16,7 +14,7 @@ import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(ExportFlag)
 import PreludePS(_PackedString)
 import NameTypes(FullName, ShortName)
 import Outputable(ExportFlag)
 import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import RenameAuxFuns(PreludeNameFun(..), PreludeNameFuns(..))
 import RenameMonad3(Rn3M(..), initRn3)
 import ProtoName(ProtoName)
 import RenameAuxFuns(PreludeNameFun(..), PreludeNameFuns(..))
 import RenameMonad3(Rn3M(..), initRn3)
@@ -24,23 +22,21 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data Module a b 
+data Bag a 
+data InPat a 
 type ProtoNamePat = InPat ProtoName
 type ProtoNamePat = InPat ProtoName
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Labda a 
+data Name 
+data ExportFlag 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
 type Rn3M a = (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
 type Rn3M a = (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data SplitUniqSupply 
 initRn3 :: ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> SplitUniqSupply -> a
 initRn3 :: ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 rnModule3 :: (_PackedString -> Labda Name, _PackedString -> Labda Name) -> [_PackedString] -> Module ProtoName (InPat ProtoName) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> ([(ProtoName, Name)], [(ProtoName, Name)], ProtoName -> Labda Name, ProtoName -> Labda Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnModule3 :: (_PackedString -> Labda Name, _PackedString -> Labda Name) -> [_PackedString] -> Module ProtoName (InPat ProtoName) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> ([(ProtoName, Name)], [(ProtoName, Name)], ProtoName -> Labda Name, ProtoName -> Labda Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 121001 _N_ _S_ "U(LL)LU(LLLASASAAALLA)AAU(ALS)" {_A_ 5 _U_ 22211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index b456e57..2e48e8a 100644 (file)
@@ -26,30 +26,26 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import Unique(Unique)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Module a b 
+data Bag a 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data InPat a 
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
 type ProtoNamePat = InPat ProtoName
 type RenamedPat = InPat Name
-data PolyType a        {-# GHC_PRAGMA UnoverloadedTy (MonoType a) | OverloadedTy [(a, a)] (MonoType a) | ForAllTy [a] (MonoType a) #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PolyType a 
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type GlobalNameFun = ProtoName -> Labda Name
 type Rn4M a = (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type TyVarNamesEnv = [(ProtoName, Name)]
 type GlobalNameFun = ProtoName -> Labda Name
 type Rn4M a = (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type TyVarNamesEnv = [(ProtoName, Name)]
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data SplitUniqSupply 
+data SrcLoc 
 initRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> SplitUniqSupply -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 initRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> SplitUniqSupply -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2212 _N_ _S_ "LLSL" _N_ _N_ #-}
 rnGenPragmas4 :: GenPragmas ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (GenPragmas Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnGenPragmas4 :: GenPragmas ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (GenPragmas Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 rnModule4 :: Module ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Module Name (InPat Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnModule4 :: Module ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Module Name (InPat Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1222210 _N_ _S_ "U(LLASSSSSSSSSL)LLLLU(ALS)A" {_A_ 6 _U_ 122221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rnPolyType4 :: Bool -> Bool -> [(ProtoName, Name)] -> PolyType ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (PolyType Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnPolyType4 :: Bool -> Bool -> [(ProtoName, Name)] -> PolyType ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (PolyType Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2221222222 _N_ _S_ "LLLS" _N_ _N_ #-}
 
 
index 708da6d..a04866e 100644 (file)
@@ -5,15 +5,13 @@ import Maybes(Labda)
 import Name(Name)
 import PreludePS(_PackedString)
 import ProtoName(ProtoName)
 import Name(Name)
 import PreludePS(_PackedString)
 import ProtoName(ProtoName)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Bag a 
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
 type PreludeNameFun = _PackedString -> Labda Name
 type PreludeNameFuns = (_PackedString -> Labda Name, _PackedString -> Labda Name)
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data ProtoName 
 mkGlobalNameFun :: _PackedString -> (_PackedString -> Labda Name) -> [(ProtoName, Name)] -> ProtoName -> Labda Name
 mkGlobalNameFun :: _PackedString -> (_PackedString -> Labda Name) -> [(ProtoName, Name)] -> ProtoName -> Labda Name
-       {-# GHC_PRAGMA _A_ 3 _U_ 2111 _N_ _N_ _N_ _N_ #-}
 mkNameFun :: Bag (_PackedString, a) -> (_PackedString -> Labda a, [[(_PackedString, a)]])
 mkNameFun :: Bag (_PackedString, a) -> (_PackedString -> Labda a, [[(_PackedString, a)]])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index b806693..beedca4 100644 (file)
@@ -1,7 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface RenameBinds4 where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface RenameBinds4 where
 import Bag(Bag)
-import CharSeq(CSeq)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import FiniteMap(FiniteMap)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import FiniteMap(FiniteMap)
@@ -16,7 +15,7 @@ import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..))
 import SplitUniq(SplitUniqSupply)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..))
 import SplitUniq(SplitUniqSupply)
@@ -26,29 +25,26 @@ import TyVar(TyVar)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Bag a 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
+data Binds a b 
 type DefinedVars = UniqFM Name
 type FreeVars = UniqFM Name
 type DefinedVars = UniqFM Name
 type FreeVars = UniqFM Name
-data MonoBinds a b     {-# GHC_PRAGMA EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data MonoBinds a b 
+data InPat a 
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFun = ProtoName -> Labda Name
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data SplitUniqSupply 
+data SrcLoc 
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 rnBinds4 :: Binds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((Binds Name (InPat Name), UniqFM Name, [Name]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnBinds4 :: Binds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((Binds Name (InPat Name), UniqFM Name, [Name]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 rnMethodBinds4 :: Name -> MonoBinds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (MonoBinds Name (InPat Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnMethodBinds4 :: Name -> MonoBinds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (MonoBinds Name (InPat Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222222 _N_ _S_ "LS" _N_ _N_ #-}
 rnTopBinds4 :: Binds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Binds Name (InPat Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnTopBinds4 :: Binds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Binds Name (InPat Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index fe41495..76943f9 100644 (file)
@@ -275,7 +275,8 @@ rnMonoBinds4 mbinds siglist
     case (inline_sigs_in_recursive_binds final_binds) of
       Nothing -> happy_answer
       Just names_n_locns ->
     case (inline_sigs_in_recursive_binds final_binds) of
       Nothing -> happy_answer
       Just names_n_locns ->
-       addErrRn4 (inlineInRecursiveBindsErr names_n_locns) `thenRn4_`
+-- SLPJ: sometimes want recursive INLINE for worker wrapper style stuff
+--     addErrRn4 (inlineInRecursiveBindsErr names_n_locns) `thenRn4_`
        {-not so-}happy_answer
   where
     f :: (a,b, FreeVars, c,d) -> FreeVars -> FreeVars
        {-not so-}happy_answer
   where
     f :: (a,b, FreeVars, c,d) -> FreeVars -> FreeVars
index 45efb1b..cda02c4 100644 (file)
@@ -1,7 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface RenameExpr4 where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface RenameExpr4 where
 import Bag(Bag)
-import CharSeq(CSeq)
 import CmdLineOpts(GlobalSwitch)
 import FiniteMap(FiniteMap)
 import HsBinds(Binds)
 import CmdLineOpts(GlobalSwitch)
 import FiniteMap(FiniteMap)
 import HsBinds(Binds)
@@ -13,7 +12,7 @@ import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..))
 import SplitUniq(SplitUniqSupply)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..))
 import SplitUniq(SplitUniqSupply)
@@ -23,25 +22,22 @@ import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data GRHSsAndBinds a b         {-# GHC_PRAGMA GRHSsAndBindsIn [GRHS a b] (Binds a b) | GRHSsAndBindsOut [GRHS a b] (Binds a b) UniType #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Bag a 
+data GRHSsAndBinds a b 
+data InPat a 
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFun = ProtoName -> Labda Name
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data SplitUniqSupply 
+data SrcLoc 
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 rnGRHSsAndBinds4 :: GRHSsAndBinds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((GRHSsAndBinds Name (InPat Name), UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnGRHSsAndBinds4 :: GRHSsAndBinds ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((GRHSsAndBinds Name (InPat Name), UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 rnMatch4 :: Match ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((Match Name (InPat Name), UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnMatch4 :: Match ProtoName (InPat ProtoName) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((Match Name (InPat Name), UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222222 _N_ _S_ "S" _N_ _N_ #-}
 rnPat4 :: InPat ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (InPat Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rnPat4 :: InPat ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (InPat Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 23bb01b..0a929ad 100644 (file)
@@ -6,27 +6,18 @@ import CmdLineOpts(GlobalSwitch)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 infixr 9 `thenRn12`
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 infixr 9 `thenRn12`
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Bag a 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
+data PrettyRep 
 type Rn12M a = _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 addErrRn12 :: (PprStyle -> Int -> Bool -> PrettyRep) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ((), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type Rn12M a = _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 addErrRn12 :: (PprStyle -> Int -> Bool -> PrettyRep) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ((), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _S_ "LAL" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 foldrRn12 :: (a -> b -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> b -> [a] -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 foldrRn12 :: (a -> b -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> b -> [a] -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-}
 getModuleNameRn12 :: _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (_PackedString, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getModuleNameRn12 :: _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (_PackedString, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _TUP_2 [_PackedString, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u0, u1] _N_ #-}
 initRn12 :: _PackedString -> (_PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 initRn12 :: _PackedString -> (_PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _F_ _IF_ARGS_ 1 2 XX 5 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> let {(u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) = _!_ _ORIG_ Bag EmptyBag [(PprStyle -> Int -> Bool -> PrettyRep)] []} in _APP_  u2 [ u1, u3 ] _N_ #-}
 mapRn12 :: (a -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ([b], Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mapRn12 :: (a -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ([b], Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 recoverQuietlyRn12 :: a -> (_PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 recoverQuietlyRn12 :: a -> (_PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _N_ _N_ _N_ #-}
 returnRn12 :: a -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 returnRn12 :: a -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _PackedString) (u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _TUP_2 [u0, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u1, u3] _N_ #-}
 thenRn12 :: (_PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 thenRn12 :: (_PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "SSLL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: u0 -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (u1, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u4 :: _PackedString) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> case _APP_  u2 [ u4, u5 ] of { _ALG_ _TUP_2 (u6 :: u0) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ u6, u4, u7 ]; _NO_DEFLT_ } _N_ #-}
 zipWithRn12 :: (a -> b -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (c, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> [b] -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ([c], Bag (PprStyle -> Int -> Bool -> PrettyRep))
 zipWithRn12 :: (a -> b -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> (c, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> [b] -> _PackedString -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> ([c], Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 21122 _N_ _S_ "LSS" _N_ _N_ #-}
 
 
index 75a899f..9d7799b 100644 (file)
@@ -4,39 +4,28 @@ import FiniteMap(FiniteMap)
 import HsImpExp(IE)
 import Maybes(Labda)
 import Name(Name)
 import HsImpExp(IE)
 import Maybes(Labda)
 import Name(Name)
-import NameTypes(FullName, Provenance)
+import NameTypes(FullName)
 import Outputable(ExportFlag)
 import PreludePS(_PackedString)
 import ProtoName(ProtoName)
 import Outputable(ExportFlag)
 import PreludePS(_PackedString)
 import ProtoName(ProtoName)
-import SplitUniq(SplitUniqSupply, splitUniqSupply)
+import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Unique(Unique)
 infixr 9 `thenRn3`
 import SrcLoc(SrcLoc)
 import Unique(Unique)
 infixr 9 `thenRn3`
-data IE        {-# GHC_PRAGMA IEVar _PackedString | IEThingAbs _PackedString | IEThingAll _PackedString | IEConWithCons _PackedString [_PackedString] | IEClsWithOps _PackedString [_PackedString] | IEModuleContents _PackedString #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data IE 
+data FullName 
+data ExportFlag 
+data ProtoName 
 type Rn3M a = (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
 type Rn3M a = (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data SplitUniqSupply 
+data Unique 
 andRn3 :: (a -> a -> a) -> ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
 andRn3 :: (a -> a -> a) -> ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 6 _U_ 111221 _N_ _S_ "SLLLLU(ALL)" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0 -> u0 -> u0) (u2 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u0) (u3 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u0) (u4 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) (u5 :: _PackedString) (u6 :: SplitUniqSupply) -> case u6 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u7 :: Int) (u8 :: SplitUniqSupply) (u9 :: SplitUniqSupply) -> let {(ua :: u0) = _APP_  u2 [ u4, u5, u8 ]} in let {(ub :: u0) = _APP_  u3 [ u4, u5, u9 ]} in _APP_  u1 [ ua, ub ]; _NO_DEFLT_ } _N_ #-}
 fixRn3 :: (a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
 fixRn3 :: (a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "SLLL" _F_ _IF_ARGS_ 1 4 XXXX 7 _/\_ u0 -> \ (u1 :: u0 -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u0) (u2 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) (u3 :: _PackedString) (u4 :: SplitUniqSupply) -> _LETREC_ {(u5 :: u0) = _APP_  u1 [ u5, u2, u3, u4 ]} in u5 _N_ #-}
 initRn3 :: ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> SplitUniqSupply -> a
 initRn3 :: ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mapRn3 :: (a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> b) -> [a] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> [b]
 mapRn3 :: (a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> b) -> [a] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222 _N_ _S_ "LS" _N_ _N_ #-}
 newFullNameM3 :: ProtoName -> SrcLoc -> Bool -> Labda ExportFlag -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> (Unique, FullName)
 newFullNameM3 :: ProtoName -> SrcLoc -> Bool -> Labda ExportFlag -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> (Unique, FullName)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1211121 _N_ _N_ _N_ _N_ #-}
 newInvisibleNameM3 :: ProtoName -> SrcLoc -> Bool -> Labda ExportFlag -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> (Unique, FullName)
 newInvisibleNameM3 :: ProtoName -> SrcLoc -> Bool -> Labda ExportFlag -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> (Unique, FullName)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1211121 _N_ _N_ _N_ _N_ #-}
 putInfoDownM3 :: _PackedString -> [IE] -> ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
 putInfoDownM3 :: _PackedString -> [IE] -> ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 6 _U_ 221002 _N_ _S_ "LLSAAL" {_A_ 4 _U_ 2212 _N_ _N_ _F_ _IF_ARGS_ 1 4 XXXX 7 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: [IE]) (u3 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u0) (u4 :: SplitUniqSupply) -> let {(u5 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) = _APP_  _ORIG_ HsImpExp getIEStrings [ u2 ]} in _APP_  u3 [ u5, u1, u4 ] _N_} _F_ _IF_ARGS_ 1 6 XXXXXX 7 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: [IE]) (u3 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u0) (u4 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) (u5 :: _PackedString) (u6 :: SplitUniqSupply) -> let {(u7 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) = _APP_  _ORIG_ HsImpExp getIEStrings [ u2 ]} in _APP_  u3 [ u7, u1, u6 ] _N_ #-}
 returnRn3 :: a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
 returnRn3 :: a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 4 _U_ 1000 _N_ _S_ "SLLL" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) (u3 :: _PackedString) (u4 :: SplitUniqSupply) -> u1 _N_ #-}
-splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
 thenRn3 :: ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> b) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> b
 thenRn3 :: ((FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> a) -> (a -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> b) -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> b
-       {-# GHC_PRAGMA _A_ 5 _U_ 11221 _N_ _S_ "LSLLU(ALL)" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u0) (u3 :: u0 -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) -> _PackedString -> SplitUniqSupply -> u1) (u4 :: (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ())) (u5 :: _PackedString) (u6 :: SplitUniqSupply) -> case u6 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u7 :: Int) (u8 :: SplitUniqSupply) (u9 :: SplitUniqSupply) -> let {(ua :: u0) = _APP_  u2 [ u4, u5, u8 ]} in _APP_  u3 [ ua, u4, u5, u9 ]; _NO_DEFLT_ } _N_ #-}
 
 
index a91e72f..4d3f3e4 100644 (file)
@@ -19,7 +19,7 @@ import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..), GlobalNameFuns(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..), GlobalNameFuns(..))
-import SplitUniq(SplitUniqSupply, splitUniqSupply)
+import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import UniqFM(UniqFM)
 import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import UniqFM(UniqFM)
@@ -27,84 +27,53 @@ import UniqSet(UniqSet(..))
 import Unique(Unique)
 infixr 9 `thenRn4`
 infixr 9 `thenRn4_`
 import Unique(Unique)
 infixr 9 `thenRn4`
 infixr 9 `thenRn4_`
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data Module a b 
+data Bag a 
+data GlobalSwitch 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data InPat a 
 type RenamedPat = InPat Name
 type RenamedPat = InPat Name
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type Rn4M a = (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type Rn4M a = (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data SplitUniqSupply 
+data SrcLoc 
 type TyVarNamesEnv = [(ProtoName, Name)]
 type TyVarNamesEnv = [(ProtoName, Name)]
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 addErrRn4 :: (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 addErrRn4 :: (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2000200 _N_ _S_ "LAAALAA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 XXXXXXX 9 \ (u0 :: PprStyle -> Int -> Bool -> PrettyRep) (u1 :: GlobalSwitch -> Bool) (u2 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u3 :: FiniteMap _PackedString Name) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SplitUniqSupply) (u6 :: SrcLoc) -> let {(u7 :: ()) = _!_ _TUP_0 [] []} in let {(u8 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) = _APP_  _TYAPP_  _ORIG_ Bag snocBag { (PprStyle -> Int -> Bool -> PrettyRep) } [ u4, u0 ]} in _!_ _TUP_2 [(), (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u7, u8] _N_ #-}
 andRn4 :: (a -> a -> a) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 andRn4 :: (a -> a -> a) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 9 _U_ 111222212 _N_ _S_ "LSSLLLLU(ALL)L" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0 -> u0 -> u0) (u2 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u4 :: GlobalSwitch -> Bool) (u5 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u6 :: FiniteMap _PackedString Name) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SplitUniqSupply) (u9 :: SrcLoc) -> case u8 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ u4, u5, u6, u7, ub, u9 ] of { _ALG_ _TUP_2 (ud :: u0) (ue :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> case _APP_  u3 [ u4, u5, u6, ue, uc, u9 ] of { _ALG_ _TUP_2 (uf :: u0) (ug :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> let {(uh :: u0) = _APP_  u1 [ ud, uf ]} in _!_ _TUP_2 [u0, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [uh, ug]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 catTyVarNamesEnvs :: [(ProtoName, Name)] -> [(ProtoName, Name)] -> [(ProtoName, Name)]
 catTyVarNamesEnvs :: [(ProtoName, Name)] -> [(ProtoName, Name)] -> [(ProtoName, Name)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ PreludeList (++) { (ProtoName, Name) } _N_ #-}
 domTyVarNamesEnv :: [(ProtoName, Name)] -> [ProtoName]
 domTyVarNamesEnv :: [(ProtoName, Name)] -> [ProtoName]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extendSS :: [Name] -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 extendSS :: [Name] -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 11222222 _N_ _S_ "LSSLLLLL" _N_ _N_ #-}
 extendSS2 :: [Name] -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((a, UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((a, UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 extendSS2 :: [Name] -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((a, UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((a, UniqFM Name), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 21222222 _N_ _S_ "LSSLLLLL" _N_ _N_ #-}
 failButContinueRn4 :: a -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 failButContinueRn4 :: a -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22000200 _N_ _S_ "LLAAALAA" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 1 8 XXXXXXXX 7 _/\_ u0 -> \ (u1 :: u0) (u2 :: PprStyle -> Int -> Bool -> PrettyRep) (u3 :: GlobalSwitch -> Bool) (u4 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u5 :: FiniteMap _PackedString Name) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SplitUniqSupply) (u8 :: SrcLoc) -> let {(u9 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) = _APP_  _TYAPP_  _ORIG_ Bag snocBag { (PprStyle -> Int -> Bool -> PrettyRep) } [ u6, u2 ]} in _!_ _TUP_2 [u0, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u1, u9] _N_ #-}
 getSrcLocRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (SrcLoc, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getSrcLocRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (SrcLoc, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 000202 _N_ _S_ "AAALAL" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u1 :: SrcLoc) -> _!_ _TUP_2 [SrcLoc, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u1, u0] _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 3 \ (u0 :: GlobalSwitch -> Bool) (u1 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u2 :: FiniteMap _PackedString Name) (u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u4 :: SplitUniqSupply) (u5 :: SrcLoc) -> _!_ _TUP_2 [SrcLoc, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u5, u3] _N_ #-}
 getSwitchCheckerRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> Bool, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getSwitchCheckerRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (GlobalSwitch -> Bool, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 200200 _N_ _S_ "LAALAA" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: GlobalSwitch -> Bool) (u1 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _TUP_2 [(GlobalSwitch -> Bool), (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u0, u1] _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 3 \ (u0 :: GlobalSwitch -> Bool) (u1 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u2 :: FiniteMap _PackedString Name) (u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u4 :: SplitUniqSupply) (u5 :: SrcLoc) -> _!_ _TUP_2 [(GlobalSwitch -> Bool), (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u0, u3] _N_ #-}
 initRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> SplitUniqSupply -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 initRn4 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> SplitUniqSupply -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2212 _N_ _S_ "LLSL" _N_ _N_ #-}
 lookupClass :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupClass :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2010202 _N_ _S_ "LAU(AS)ALAL" {_A_ 4 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupClassOp :: Name -> ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupClassOp :: Name -> ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22010202 _N_ _S_ "LLAU(SA)ALAL" {_A_ 5 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupFixityOp :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Labda Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupFixityOp :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Labda Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 2012222 _N_ _S_ "SAU(LA)" {_A_ 2 _U_ 212222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupTyCon :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupTyCon :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2010212 _N_ _S_ "SALALU(AAA)L" {_A_ 4 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupTyConEvenIfInvisible :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupTyConEvenIfInvisible :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2010202 _N_ _S_ "SALALAL" {_A_ 4 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupTyVarName :: [(ProtoName, Name)] -> ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupTyVarName :: [(ProtoName, Name)] -> ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 12000212 _N_ _S_ "SLAAALLL" {_A_ 5 _U_ 12212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupValue :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupValue :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2012212 _N_ _S_ "SAU(LA)LLU(AAA)L" {_A_ 5 _U_ 21222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupValueEvenIfInvisible :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 lookupValueEvenIfInvisible :: ProtoName -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (Name, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2012202 _N_ _S_ "SAU(LA)LLAL" {_A_ 5 _U_ 21222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mapAndUnzipRn4 :: (a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((b, c), Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (([b], [c]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mapAndUnzipRn4 :: (a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ((b, c), Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (([b], [c]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 mapRn4 :: (a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ([b], Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mapRn4 :: (a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ([b], Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 mkTyVarNamesEnv :: SrcLoc -> [ProtoName] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (([(ProtoName, Name)], [Name]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mkTyVarNamesEnv :: SrcLoc -> [ProtoName] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (([(ProtoName, Name)], [Name]), Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22222212 _N_ _S_ "LSLLLLU(ASA)L" _N_ _N_ #-}
 namesFromProtoNames :: [Char] -> [(ProtoName, SrcLoc)] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ([Name], Bag (PprStyle -> Int -> Bool -> PrettyRep))
 namesFromProtoNames :: [Char] -> [(ProtoName, SrcLoc)] -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> ([Name], Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22222212 _N_ _S_ "LSLLLLU(ALS)L" _N_ _N_ #-}
 nullTyVarNamesEnv :: [(ProtoName, Name)]
 nullTyVarNamesEnv :: [(ProtoName, Name)]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _NIL_ [(ProtoName, Name)] [] _N_ #-}
 pushSrcLocRn4 :: SrcLoc -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 pushSrcLocRn4 :: SrcLoc -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 21222220 _N_ _S_ "LSLLLLLA" {_A_ 7 _U_ 2122222 _N_ _N_ _F_ _IF_ARGS_ 1 7 XXXXXXX 7 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: GlobalSwitch -> Bool) (u4 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u5 :: FiniteMap _PackedString Name) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SplitUniqSupply) -> _APP_  u2 [ u3, u4, u5, u6, u7, u1 ] _N_} _F_ _IF_ARGS_ 1 8 XXXXXXXX 7 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: GlobalSwitch -> Bool) (u4 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u5 :: FiniteMap _PackedString Name) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SplitUniqSupply) (u8 :: SrcLoc) -> _APP_  u2 [ u3, u4, u5, u6, u7, u1 ] _N_ #-}
 recoverQuietlyRn4 :: a -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 recoverQuietlyRn4 :: a -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 21222222 _N_ _N_ _N_ _N_ #-}
 returnRn4 :: a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 returnRn4 :: a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2000200 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: GlobalSwitch -> Bool) (u3 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u4 :: FiniteMap _PackedString Name) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: SplitUniqSupply) (u7 :: SrcLoc) -> _!_ _TUP_2 [u0, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u1, u5] _N_ #-}
-splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
 thenRn4 :: ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 thenRn4 :: ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 11222212 _N_ _S_ "SSLLLLU(ALL)L" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: u0 -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u1, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u4 :: GlobalSwitch -> Bool) (u5 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u6 :: FiniteMap _PackedString Name) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SplitUniqSupply) (u9 :: SrcLoc) -> case u8 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ u4, u5, u6, u7, ub, u9 ] of { _ALG_ _TUP_2 (ud :: u0) (ue :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ ud, u4, u5, u6, ue, uc, u9 ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 thenRn4_ :: ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 thenRn4_ :: ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (b, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 11222212 _N_ _S_ "SSLLLLU(ALL)L" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u0, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (u1, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u4 :: GlobalSwitch -> Bool) (u5 :: (ProtoName -> Labda Name, ProtoName -> Labda Name)) (u6 :: FiniteMap _PackedString Name) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SplitUniqSupply) (u9 :: SrcLoc) -> case u8 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ u4, u5, u6, u7, ub, u9 ] of { _ALG_ _TUP_2 (ud :: u0) (ue :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ u4, u5, u6, ue, uc, u9 ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 
 
index 7252397..68e6ce4 100644 (file)
@@ -79,6 +79,7 @@ type Rn4M result
 #ifdef __GLASGOW_HASKELL__
 {-# INLINE andRn4 #-}
 {-# INLINE thenRn4 #-}
 #ifdef __GLASGOW_HASKELL__
 {-# INLINE andRn4 #-}
 {-# INLINE thenRn4 #-}
+{-# INLINE thenLazilyRn4 #-}
 {-# INLINE thenRn4_ #-}
 {-# INLINE returnRn4 #-}
 #endif
 {-# INLINE thenRn4_ #-}
 {-# INLINE returnRn4 #-}
 #endif
@@ -92,7 +93,8 @@ initRn4 :: (GlobalSwitch -> Bool)
 initRn4 sw_chkr gnfs renamer init_us
   = renamer sw_chkr gnfs emptyFM emptyBag init_us mkUnknownSrcLoc
 
 initRn4 sw_chkr gnfs renamer init_us
   = renamer sw_chkr gnfs emptyFM emptyBag init_us mkUnknownSrcLoc
 
-thenRn4  :: Rn4M a -> (a -> Rn4M b) -> Rn4M b
+thenRn4, thenLazilyRn4
+        :: Rn4M a -> (a -> Rn4M b) -> Rn4M b
 thenRn4_ :: Rn4M a -> Rn4M b -> Rn4M b
 andRn4   :: (a -> a -> a) -> Rn4M a -> Rn4M a -> Rn4M a
 
 thenRn4_ :: Rn4M a -> Rn4M b -> Rn4M b
 andRn4   :: (a -> a -> a) -> Rn4M a -> Rn4M a -> Rn4M a
 
@@ -102,6 +104,14 @@ thenRn4 expr cont sw_chkr gnfs ss errs uniqs locn
     case (cont res1 sw_chkr gnfs ss errs1 s2 locn) of { (res2, errs2) ->
     (res2, errs2) }}}
 
     case (cont res1 sw_chkr gnfs ss errs1 s2 locn) of { (res2, errs2) ->
     (res2, errs2) }}}
 
+thenLazilyRn4 expr cont sw_chkr gnfs ss errs uniqs locn
+  = let
+       (s1, s2)      = splitUniqSupply uniqs
+       (res1, errs1) = expr      sw_chkr gnfs ss errs  s1 locn
+       (res2, errs2) = cont res1 sw_chkr gnfs ss errs1 s2 locn
+    in
+    (res2, errs2)
+
 thenRn4_ expr cont sw_chkr gnfs ss errs uniqs locn
   = case (splitUniqSupply uniqs)             of { (s1, s2) ->
     case (expr sw_chkr gnfs ss errs  s1 locn) of { (_,    errs1) ->
 thenRn4_ expr cont sw_chkr gnfs ss errs uniqs locn
   = case (splitUniqSupply uniqs)             of { (s1, s2) ->
     case (expr sw_chkr gnfs ss errs  s1 locn) of { (_,    errs1) ->
@@ -260,7 +270,7 @@ value is not visible to the user (e.g., came out of a pragma).
 
 \begin{code}
 lookupValue v {-Rn4-} sw_chkr gnfs ss errs_so_far us locn
 
 \begin{code}
 lookupValue v {-Rn4-} sw_chkr gnfs ss errs_so_far us locn
-  = (lookup_val v      `thenRn4` \ name ->
+  = (lookup_val v      `thenLazilyRn4` \ name ->
     if invisibleName name
     then failButContinueRn4 (unboundName v) (unknownNameErr "value" v mkUnknownSrcLoc)
     else returnRn4 name
     if invisibleName name
     then failButContinueRn4 (unboundName v) (unknownNameErr "value" v mkUnknownSrcLoc)
     else returnRn4 name
@@ -317,7 +327,7 @@ lookupTyCon, lookupTyConEvenIfInvisible :: ProtoName -> Rn4M Name
 -- The global name funs handle Prel things
 
 lookupTyCon tc {-Rn4-} sw_chkr gnfs ss errs_so_far us locn
 -- The global name funs handle Prel things
 
 lookupTyCon tc {-Rn4-} sw_chkr gnfs ss errs_so_far us locn
-  = (lookup_tycon tc `thenRn4` \ name ->
+  = (lookup_tycon tc `thenLazilyRn4` \ name ->
     if invisibleName name
     then failButContinueRn4 (unboundName tc) (unknownNameErr "type constructor" tc mkUnknownSrcLoc)
     else returnRn4 name
     if invisibleName name
     then failButContinueRn4 (unboundName tc) (unknownNameErr "type constructor" tc mkUnknownSrcLoc)
     else returnRn4 name
index d6fdc36..f610a4e 100644 (file)
@@ -4,5 +4,4 @@ import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreBinding)
 import Id(Id)
 analFBWW :: (GlobalSwitch -> Bool) -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 import CoreSyn(CoreBinding)
 import Id(Id)
 analFBWW :: (GlobalSwitch -> Bool) -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _N_ _N_ _N_ #-}
 
 
index 3bad6eb..52304cf 100644 (file)
@@ -2,38 +2,22 @@
 interface BinderInfo where
 import Outputable(Outputable)
 data BinderInfo   = DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int
 interface BinderInfo where
 import Outputable(Outputable)
 data BinderInfo   = DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int
-data DuplicationDanger         {-# GHC_PRAGMA DupDanger | NoDupDanger #-}
-data FunOrArg  {-# GHC_PRAGMA FunOcc | ArgOcc #-}
-data InsideSCC         {-# GHC_PRAGMA InsideSCC | NotInsideSCC #-}
+data DuplicationDanger 
+data FunOrArg 
+data InsideSCC 
 argOccurrence :: Int -> BinderInfo
 argOccurrence :: Int -> BinderInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 combineAltsBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
 combineAltsBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 combineBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
 combineBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 funOccurrence :: Int -> BinderInfo
 funOccurrence :: Int -> BinderInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 getBinderInfoArity :: BinderInfo -> Int
 getBinderInfoArity :: BinderInfo -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: BinderInfo) -> case u0 of { _ALG_ _ORIG_ BinderInfo DeadCode  -> _!_ I# [] [0#]; _ORIG_ BinderInfo ManyOcc (u1 :: Int) -> u1; _ORIG_ BinderInfo OneOcc (u2 :: FunOrArg) (u3 :: DuplicationDanger) (u4 :: InsideSCC) (u5 :: Int) (u6 :: Int) -> u6; _NO_DEFLT_ } _N_ #-}
 inlineUnconditionally :: Bool -> BinderInfo -> Bool
 inlineUnconditionally :: Bool -> BinderInfo -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 isDupDanger :: DuplicationDanger -> Bool
 isDupDanger :: DuplicationDanger -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: DuplicationDanger) -> case u0 of { _ALG_ _ORIG_ BinderInfo NoDupDanger  -> _!_ False [] []; _ORIG_ BinderInfo DupDanger  -> _!_ True [] []; _NO_DEFLT_ } _N_ #-}
 isFun :: FunOrArg -> Bool
 isFun :: FunOrArg -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FunOrArg) -> case u0 of { _ALG_ _ORIG_ BinderInfo ArgOcc  -> _!_ False [] []; _ORIG_ BinderInfo FunOcc  -> _!_ True [] []; _NO_DEFLT_ } _N_ #-}
 markDangerousToDup :: BinderInfo -> BinderInfo
 markDangerousToDup :: BinderInfo -> BinderInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 markInsideSCC :: BinderInfo -> BinderInfo
 markInsideSCC :: BinderInfo -> BinderInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 markMany :: BinderInfo -> BinderInfo
 markMany :: BinderInfo -> BinderInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 oneSafeOcc :: Bool -> BinderInfo -> Bool
 oneSafeOcc :: Bool -> BinderInfo -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 oneTextualOcc :: Bool -> BinderInfo -> Bool
 oneTextualOcc :: Bool -> BinderInfo -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 instance Outputable BinderInfo
 instance Outputable BinderInfo
-       {-# GHC_PRAGMA _M_ BinderInfo {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BinderInfo) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 789f3b0..f154a44 100644 (file)
@@ -8,5 +8,4 @@ import SimplMonad(SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 completePrim :: SimplEnv -> PrimOp -> [UniType] -> [CoreAtom Id] -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 completePrim :: SimplEnv -> PrimOp -> [UniType] -> [CoreAtom Id] -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 122222 _N_ _S_ "LSLS" _N_ _N_ #-}
 
 
index 19c2a78..1e1a1f0 100644 (file)
@@ -6,7 +6,6 @@
 ToDo:
    check boundaries before folding, e.g. we can fold the Float addition
    (i1 + i2) only if it results        in a valid Float.
 ToDo:
    check boundaries before folding, e.g. we can fold the Float addition
    (i1 + i2) only if it results        in a valid Float.
-   See the @IntDivOp@ below.
 
 \begin{code}
 #include "HsVersions.h"
 
 \begin{code}
 #include "HsVersions.h"
@@ -47,7 +46,16 @@ Now, we know that the seq# primitive will never return 0#, but we
 don't let the simplifier know that.  We also use a special error
 value, parError#, which is *not* a bottoming Id, so as far as the
 simplifier is concerned, we have to evaluate seq# a before we know
 don't let the simplifier know that.  We also use a special error
 value, parError#, which is *not* a bottoming Id, so as far as the
 simplifier is concerned, we have to evaluate seq# a before we know
-whether or not b will be evaluated.
+whether or not y will be evaluated.  
+
+If we didn't have the extra case, then after inlining the compiler might
+see:
+       f p q = case seq# p of { _ -> p+q }
+
+If it sees that, it can see that f is strict in q, and hence it might
+evaluate q before p!  The "0# ->" case prevents this happening.
+By having the parError# branch we make sure that anything in the
+other branch stays there!
   
 This is fine, but we'd like to get rid of the extraneous code.  Hence,
 we *do* let the simplifier know that seq# is strict in its argument.
   
 This is fine, but we'd like to get rid of the extraneous code.  Hence,
 we *do* let the simplifier know that seq# is strict in its argument.
@@ -176,7 +184,6 @@ completePrim env op tys args
     twoIntLits IntSubOp         i1 i2           = return_int (i1-i2)
     twoIntLits IntMulOp         i1 i2           = return_int (i1*i2)
     twoIntLits IntQuotOp i1 i2 | i2 /= 0 = return_int (i1 `quot` i2)
     twoIntLits IntSubOp         i1 i2           = return_int (i1-i2)
     twoIntLits IntMulOp         i1 i2           = return_int (i1*i2)
     twoIntLits IntQuotOp i1 i2 | i2 /= 0 = return_int (i1 `quot` i2)
-    twoIntLits IntDivOp  i1 i2 | i2 /= 0 = return_int (i1 `div` i2)
     twoIntLits IntRemOp  i1 i2 | i2 /= 0 = return_int (i1 `rem` i2)
     twoIntLits IntGtOp  i1 i2           = return_bool (i1 >  i2)
     twoIntLits IntGeOp  i1 i2           = return_bool (i1 >= i2)
     twoIntLits IntRemOp  i1 i2 | i2 /= 0 = return_int (i1 `rem` i2)
     twoIntLits IntGtOp  i1 i2           = return_bool (i1 >  i2)
     twoIntLits IntGeOp  i1 i2           = return_bool (i1 >= i2)
index bca9504..7ff3ada 100644 (file)
@@ -3,18 +3,15 @@ interface FloatIn where
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreExpr(..), PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import TyVar(TyVar)
 import UniType(UniType)
 import PlainCore(PlainCoreExpr(..), PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import TyVar(TyVar)
 import UniType(UniType)
-import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 floatInwards :: [CoreBinding Id Id] -> [CoreBinding Id Id]
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 floatInwards :: [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 5a3d57b..4c72659 100644 (file)
@@ -5,5 +5,4 @@ import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 floatOutwards :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 floatOutwards :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "SLS" _N_ _N_ #-}
 
 
index 9ab7221..046ab3e 100644 (file)
@@ -87,32 +87,37 @@ floatOutwards :: (GlobalSwitch -> Bool)      -- access to all global cmd-line opts
 floatOutwards sw_chker us pgm
   = case (setLevels pgm sw_chker us) of { annotated_w_levels ->
 
 floatOutwards sw_chker us pgm
   = case (setLevels pgm sw_chker us) of { annotated_w_levels ->
 
-    case unzip3 (map (floatTopBind sw_chker) annotated_w_levels)
-               of { (fcs, lcs, final_toplev_binds_s) ->
+    case unzip (map (floatTopBind sw_chker) annotated_w_levels)
+               of { (fss, final_toplev_binds_s) ->
 
     (if sw_chker D_verbose_core2core
      then pprTrace "Levels added:\n" (ppr PprDebug annotated_w_levels)
      else id
     )
 
     (if sw_chker D_verbose_core2core
      then pprTrace "Levels added:\n" (ppr PprDebug annotated_w_levels)
      else id
     )
-    ( if  sw_chker D_simplifier_stats
-      then pprTrace "FloatOut stats: " (ppBesides [
-               ppInt (sum fcs), ppStr " Lets floated out of ",
-               ppInt (sum lcs), ppStr " Lambdas"])
-      else id
+    ( if not (sw_chker D_simplifier_stats) then
+        id
+      else
+        let
+           (tlets, ntlets, lams) = get_stats (sum_stats fss)
+        in
+        pprTrace "FloatOut stats: " (ppBesides [
+               ppInt tlets,  ppStr " Lets floated to top level; ",
+               ppInt ntlets, ppStr " Lets floated elsewhere; from ",
+               ppInt lams,   ppStr " Lambda groups"])
     )
     concat final_toplev_binds_s
     }}
 
 floatTopBind sw bind@(CoNonRec _ _)
     )
     concat final_toplev_binds_s
     }}
 
 floatTopBind sw bind@(CoNonRec _ _)
-  = case (floatBind sw nullIdEnv tOP_LEVEL bind) of { (fc,lc, floats, bind', _) ->
-    (fc,lc, floatsToBinds floats ++ [bind'])
+  = case (floatBind sw nullIdEnv tOP_LEVEL bind) of { (fs, floats, bind', _) ->
+    (fs, floatsToBinds floats ++ [bind'])
     }
 
 floatTopBind sw bind@(CoRec _)
     }
 
 floatTopBind sw bind@(CoRec _)
-  = case (floatBind sw nullIdEnv tOP_LEVEL bind) of { (fc,lc, floats, CoRec pairs', _) ->
+  = case (floatBind sw nullIdEnv tOP_LEVEL bind) of { (fs, floats, CoRec pairs', _) ->
        -- Actually floats will be empty
     --false:ASSERT(null floats)
        -- Actually floats will be empty
     --false:ASSERT(null floats)
-    (fc,lc, [CoRec (floatsToBindPairs floats ++ pairs')])
+    (fs, [CoRec (floatsToBindPairs floats ++ pairs')])
     }
 \end{code}
 
     }
 \end{code}
 
@@ -128,23 +133,23 @@ floatBind :: (GlobalSwitch -> Bool)
          -> IdEnv Level
          -> Level
          -> LevelledBind
          -> IdEnv Level
          -> Level
          -> LevelledBind
-         -> (Int,Int, FloatingBinds, PlainCoreBinding, IdEnv Level)
+         -> (FloatStats, FloatingBinds, PlainCoreBinding, IdEnv Level)
 
 floatBind sw env lvl (CoNonRec (name,level) rhs)
 
 floatBind sw env lvl (CoNonRec (name,level) rhs)
-  = case (floatExpr sw env level rhs) of { (fc,lc, rhs_floats, rhs') ->
+  = case (floatExpr sw env level rhs) of { (fs, rhs_floats, rhs') ->
 
        -- A good dumping point
     case (partitionByMajorLevel level rhs_floats)      of { (rhs_floats', heres) ->
 
 
        -- A good dumping point
     case (partitionByMajorLevel level rhs_floats)      of { (rhs_floats', heres) ->
 
-    (fc,lc, rhs_floats',CoNonRec name (install heres rhs'), addOneToIdEnv env name level)
+    (fs, rhs_floats',CoNonRec name (install heres rhs'), addOneToIdEnv env name level)
     }}
     
 floatBind sw env lvl bind@(CoRec pairs)
     }}
     
 floatBind sw env lvl bind@(CoRec pairs)
-  = case (unzip4 (map do_pair pairs)) of { (fcs,lcs, rhss_floats, new_pairs) ->
+  = case (unzip3 (map do_pair pairs)) of { (fss, rhss_floats, new_pairs) ->
 
     if not (isTopLvl bind_level) then
        -- Standard case
 
     if not (isTopLvl bind_level) then
        -- Standard case
-       (sum fcs,sum lcs, concat rhss_floats, CoRec new_pairs, new_env)
+       (sum_stats fss, concat rhss_floats, CoRec new_pairs, new_env)
     else
        {- In a recursive binding, destined for the top level (only), 
           the rhs floats may contain 
     else
        {- In a recursive binding, destined for the top level (only), 
           the rhs floats may contain 
@@ -161,7 +166,8 @@ floatBind sw env lvl bind@(CoRec pairs)
           with the top binding.  Later dependency analysis will unravel it.
        -}
 
           with the top binding.  Later dependency analysis will unravel it.
        -}
 
-       (sum fcs,sum lcs, [], 
+       (sum_stats fss,
+        [], 
         CoRec (new_pairs ++ floatsToBindPairs (concat rhss_floats)),
         new_env)
 
         CoRec (new_pairs ++ floatsToBindPairs (concat rhss_floats)),
         new_env)
 
@@ -172,12 +178,12 @@ floatBind sw env lvl bind@(CoRec pairs)
     bind_level = getBindLevel bind
 
     do_pair ((name, level), rhs)
     bind_level = getBindLevel bind
 
     do_pair ((name, level), rhs)
-      = case (floatExpr sw new_env level rhs) of { (fc,lc, rhs_floats, rhs') ->
+      = case (floatExpr sw new_env level rhs) of { (fs, rhs_floats, rhs') ->
 
                -- A good dumping point
        case (partitionByMajorLevel level rhs_floats)   of { (rhs_floats', heres) ->
 
 
                -- A good dumping point
        case (partitionByMajorLevel level rhs_floats)   of { (rhs_floats', heres) ->
 
-       (fc,lc, rhs_floats', (name, install heres rhs'))
+       (fs, rhs_floats', (name, install heres rhs'))
        }}
 \end{code}
 
        }}
 \end{code}
 
@@ -192,33 +198,33 @@ floatExpr :: (GlobalSwitch -> Bool)
          -> IdEnv Level
          -> Level 
          -> LevelledExpr
          -> IdEnv Level
          -> Level 
          -> LevelledExpr
-         -> (Int,Int, FloatingBinds, PlainCoreExpr)
+         -> (FloatStats, FloatingBinds, PlainCoreExpr)
 
 
-floatExpr sw env _ (CoVar v)        = (0,0, [], CoVar v)
+floatExpr sw env _ (CoVar v)        = (zero_stats, [], CoVar v)
 
 
-floatExpr sw env _ (CoLit l)     = (0,0, [], CoLit l)
+floatExpr sw env _ (CoLit l)     = (zero_stats, [], CoLit l)
 
 
-floatExpr sw env _ (CoPrim op ty as) = (0,0, [], CoPrim op ty as)
-floatExpr sw env _ (CoCon con ty as) = (0,0, [], CoCon con ty as)
+floatExpr sw env _ (CoPrim op ty as) = (zero_stats, [], CoPrim op ty as)
+floatExpr sw env _ (CoCon con ty as) = (zero_stats, [], CoCon con ty as)
 
 floatExpr sw env lvl (CoApp e a)
 
 floatExpr sw env lvl (CoApp e a)
-  = case (floatExpr sw env lvl e) of { (fc,lc, floating_defns, e') ->
-    (fc,lc, floating_defns, CoApp e' a) }
+  = case (floatExpr sw env lvl e) of { (fs, floating_defns, e') ->
+    (fs, floating_defns, CoApp e' a) }
     
 floatExpr sw env lvl (CoTyApp e ty)
     
 floatExpr sw env lvl (CoTyApp e ty)
-  = case (floatExpr sw env lvl e) of { (fc,lc, floating_defns, e') ->
-    (fc,lc, floating_defns, CoTyApp e' ty) }
+  = case (floatExpr sw env lvl e) of { (fs, floating_defns, e') ->
+    (fs, floating_defns, CoTyApp e' ty) }
 
 floatExpr sw env lvl (CoTyLam tv e)
   = let
        incd_lvl = incMinorLvl lvl
     in
 
 floatExpr sw env lvl (CoTyLam tv e)
   = let
        incd_lvl = incMinorLvl lvl
     in
-    case (floatExpr sw env incd_lvl e) of { (fc,lc, floats, e') ->
+    case (floatExpr sw env incd_lvl e) of { (fs, floats, e') ->
 
        -- Dump any bindings which absolutely cannot go any further
     case (partitionByLevel incd_lvl floats)    of { (floats', heres) ->
 
 
        -- Dump any bindings which absolutely cannot go any further
     case (partitionByLevel incd_lvl floats)    of { (floats', heres) ->
 
-    (fc,lc, floats', CoTyLam tv (install heres e'))
+    (fs, floats', CoTyLam tv (install heres e'))
     }}
 
 floatExpr sw env lvl (CoLam args@((_,incd_lvl):_) rhs)
     }}
 
 floatExpr sw env lvl (CoLam args@((_,incd_lvl):_) rhs)
@@ -226,24 +232,25 @@ floatExpr sw env lvl (CoLam args@((_,incd_lvl):_) rhs)
        args'    = map fst args
        new_env  = growIdEnvList env args
     in
        args'    = map fst args
        new_env  = growIdEnvList env args
     in
-    case (floatExpr sw new_env incd_lvl rhs) of { (fc,lc, floats, rhs') ->
+    case (floatExpr sw new_env incd_lvl rhs) of { (fs, floats, rhs') ->
 
        -- Dump any bindings which absolutely cannot go any further
     case (partitionByLevel incd_lvl floats)    of { (floats', heres) ->
 
 
        -- Dump any bindings which absolutely cannot go any further
     case (partitionByLevel incd_lvl floats)    of { (floats', heres) ->
 
-    (fc +  length floats', lc + 1,
-     floats', mkCoLam args' (install heres rhs'))
+    (add_to_stats fs floats',
+     floats',
+     mkCoLam args' (install heres rhs'))
     }}
 
 floatExpr sw env lvl (CoSCC cc expr)
     }}
 
 floatExpr sw env lvl (CoSCC cc expr)
-  = case (floatExpr sw env lvl expr)    of { (fc,lc, floating_defns, expr') ->
+  = case (floatExpr sw env lvl expr)    of { (fs, floating_defns, expr') ->
     let
        -- annotate bindings floated outwards past an scc expression
        -- with the cc.  We mark that cc as "duplicated", though.
 
        annotated_defns = annotate (dupifyCC cc) floating_defns
     in
     let
        -- annotate bindings floated outwards past an scc expression
        -- with the cc.  We mark that cc as "duplicated", though.
 
        annotated_defns = annotate (dupifyCC cc) floating_defns
     in
-    (fc,lc, annotated_defns, CoSCC cc expr') }
+    (fs, annotated_defns, CoSCC cc expr') }
   where
     annotate :: CostCentre -> FloatingBinds -> FloatingBinds
 
   where
     annotate :: CostCentre -> FloatingBinds -> FloatingBinds
 
@@ -267,16 +274,17 @@ floatExpr sw env lvl (CoSCC cc expr)
        --       cost centre stack profiling (Durham)
 
 floatExpr sw env lvl (CoLet bind body)
        --       cost centre stack profiling (Durham)
 
 floatExpr sw env lvl (CoLet bind body)
-  = case (floatBind sw env     lvl bind) of { (fcb,lcb, rhs_floats, bind', new_env) ->
-    case (floatExpr sw new_env lvl body) of { (fce,lce, body_floats, body') ->
-    (fcb + fce, lcb + lce,
-     rhs_floats ++ [(bind_lvl, LetFloater bind')] ++ body_floats, body')
+  = case (floatBind sw env     lvl bind) of { (fsb, rhs_floats, bind', new_env) ->
+    case (floatExpr sw new_env lvl body) of { (fse, body_floats, body') ->
+    (add_stats fsb fse,
+     rhs_floats ++ [(bind_lvl, LetFloater bind')] ++ body_floats,
+     body')
     }}
   where
     bind_lvl = getBindLevel bind
 
 floatExpr sw env lvl (CoCase scrut alts)
     }}
   where
     bind_lvl = getBindLevel bind
 
 floatExpr sw env lvl (CoCase scrut alts)
-  = case (floatExpr sw env lvl scrut) of { (fce,lce, fde, scrut') ->
+  = case (floatExpr sw env lvl scrut) of { (fse, fde, scrut') ->
 
     case (scrut', float_alts alts) of 
 
 
     case (scrut', float_alts alts) of 
 
@@ -298,9 +306,9 @@ floatExpr sw env lvl (CoCase scrut alts)
 
  END OF CASE FLOATING DROPPED          -}
 
 
  END OF CASE FLOATING DROPPED          -}
 
-       (_, (fca,lca, fda, alts')) -> 
+       (_, (fsa, fda, alts')) -> 
 
 
-               (fce + fca, lce + lca, fda ++ fde, CoCase scrut' alts') 
+               (add_stats fse fsa, fda ++ fde, CoCase scrut' alts') 
     }
   where
       incd_lvl = incMinorLvl lvl
     }
   where
       incd_lvl = incMinorLvl lvl
@@ -328,16 +336,18 @@ floatExpr sw env lvl (CoCase scrut alts)
 -}
 
       float_alts (CoAlgAlts alts deflt)
 -}
 
       float_alts (CoAlgAlts alts deflt)
-       = case (float_deflt  deflt)              of { (fcd,lcd,   fdd,  deflt') ->
-         case (unzip4 (map float_alg_alt alts)) of { (fcas,lcas, fdas, alts') ->
-         (fcd + sum fcas, lcd + sum lcas,
-          concat fdas ++ fdd, CoAlgAlts alts' deflt') }}
+       = case (float_deflt  deflt)              of { (fsd,  fdd,  deflt') ->
+         case (unzip3 (map float_alg_alt alts)) of { (fsas, fdas, alts') ->
+         (foldr add_stats fsd fsas,
+          concat fdas ++ fdd,
+          CoAlgAlts alts' deflt') }}
 
       float_alts (CoPrimAlts alts deflt)
 
       float_alts (CoPrimAlts alts deflt)
-       = case (float_deflt deflt)                of { (fcd,lcd,   fdd, deflt') ->
-         case (unzip4 (map float_prim_alt alts)) of { (fcas,lcas, fdas, alts') ->
-         (fcd + sum fcas, lcd + sum lcas,
-          concat fdas ++ fdd, CoPrimAlts alts' deflt') }}
+       = case (float_deflt deflt)                of { (fsd,   fdd, deflt') ->
+         case (unzip3 (map float_prim_alt alts)) of { (fsas, fdas, alts') ->
+         (foldr add_stats fsd fsas,
+          concat fdas ++ fdd,
+          CoPrimAlts alts' deflt') }}
 
       -------------
       float_alg_alt (con, bs, rhs)
 
       -------------
       float_alg_alt (con, bs, rhs)
@@ -345,33 +355,62 @@ floatExpr sw env lvl (CoCase scrut alts)
              bs' = map fst bs
              new_env = growIdEnvList env bs
          in
              bs' = map fst bs
              new_env = growIdEnvList env bs
          in
-         case (floatExpr sw new_env incd_lvl rhs)      of { (fc,lc, rhs_floats, rhs') ->
+         case (floatExpr sw new_env incd_lvl rhs)      of { (fs, rhs_floats, rhs') ->
          case (partition_fn incd_lvl rhs_floats)       of { (rhs_floats', heres) ->
          case (partition_fn incd_lvl rhs_floats)       of { (rhs_floats', heres) ->
-         (fc, lc, rhs_floats', (con, bs', install heres rhs'))
-         }}
+         (fs, rhs_floats', (con, bs', install heres rhs')) }}
 
       --------------
       float_prim_alt (lit, rhs)
 
       --------------
       float_prim_alt (lit, rhs)
-       = case (floatExpr sw env incd_lvl rhs)          of { (fc,lc, rhs_floats, rhs') ->
+       = case (floatExpr sw env incd_lvl rhs)          of { (fs, rhs_floats, rhs') ->
          case (partition_fn incd_lvl rhs_floats)       of { (rhs_floats', heres) ->
          case (partition_fn incd_lvl rhs_floats)       of { (rhs_floats', heres) ->
-         (fc,lc, rhs_floats', (lit, install heres rhs'))
-         }}
+         (fs, rhs_floats', (lit, install heres rhs')) }}
 
       --------------
 
       --------------
-      float_deflt CoNoDefault = (0,0, [], CoNoDefault)
+      float_deflt CoNoDefault = (zero_stats, [], CoNoDefault)
 
       float_deflt (CoBindDefault (b,lvl) rhs)
 
       float_deflt (CoBindDefault (b,lvl) rhs)
-       = case (floatExpr sw new_env lvl rhs)           of { (fc,lc, rhs_floats, rhs') ->
+       = case (floatExpr sw new_env lvl rhs)           of { (fs, rhs_floats, rhs') ->
          case (partition_fn incd_lvl rhs_floats)       of { (rhs_floats', heres) ->
          case (partition_fn incd_lvl rhs_floats)       of { (rhs_floats', heres) ->
-         (fc,lc, rhs_floats', CoBindDefault b (install heres rhs'))
-         }}
+         (fs, rhs_floats', CoBindDefault b (install heres rhs')) }}
        where
          new_env = addOneToIdEnv env b lvl        
 \end{code}
 
 %************************************************************************
 %*                                                                     *
        where
          new_env = addOneToIdEnv env b lvl        
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[FloatOut-utils]{Utility bits for floating}
+\subsection{Utility bits for floating stats}
+%*                                                                     *
+%************************************************************************
+
+I didn't implement this with unboxed numbers.  I don't want to be too
+strict in this stuff, as it is rarely turned on.  (WDP 95/09)
+
+\begin{code}
+data FloatStats
+  = FlS        Int  -- Number of top-floats * lambda groups they've been past
+       Int  -- Number of non-top-floats * lambda groups they've been past
+       Int  -- Number of lambda (groups) seen
+
+get_stats (FlS a b c) = (a, b, c)
+
+zero_stats = FlS 0 0 0
+
+sum_stats xs = foldr add_stats zero_stats xs
+
+add_stats (FlS a1 b1 c1) (FlS a2 b2 c2)
+  = FlS (a1 + a2) (b1 + b2) (c1 + c2)
+
+add_to_stats (FlS a b c) floats
+  = FlS (a + length top_floats) (b + length other_floats) (c + 1)
+  where
+    (top_floats, other_floats) = partition to_very_top floats
+
+    to_very_top (my_lvl, _) = isTopLvl my_lvl
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Utility bits for floating}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
index 87f1197..4db2b9d 100644 (file)
@@ -5,5 +5,4 @@ import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 mkFoldrBuildWW :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 mkFoldrBuildWW :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(ALA)S" {_A_ 3 _U_ 221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index e2b140b..5646aa0 100644 (file)
@@ -3,5 +3,4 @@ interface LiberateCase where
 import CoreSyn(CoreBinding)
 import Id(Id)
 liberateCase :: Int -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 import CoreSyn(CoreBinding)
 import Id(Id)
 liberateCase :: Int -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index aac448f..daad918 100644 (file)
@@ -1,41 +1,33 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface MagicUFs where
 import BasicLit(BasicLit)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface MagicUFs where
 import BasicLit(BasicLit)
-import Class(Class)
-import CmdLineOpts(SimplifierSwitch, SwitchResult)
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PlainCore(PlainCoreArg(..), PlainCoreAtom(..), PlainCoreExpr(..))
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
 import Maybes(Labda)
 import PlainCore(PlainCoreArg(..), PlainCoreAtom(..), PlainCoreExpr(..))
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
-import SimplEnv(EnclosingCcDetails, IdVal, SimplEnv, UnfoldEnv)
+import SimplEnv(SimplEnv)
 import SimplMonad(SimplCount, SmplM(..), TickType)
 import SplitUniq(SplitUniqSupply)
 import SimplMonad(SimplCount, SmplM(..), TickType)
 import SplitUniq(SplitUniqSupply)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniType(UniType)
-import UniqFM(UniqFM)
-import Unique(Unique)
-data CoreArg a         {-# GHC_PRAGMA TypeArg UniType | ValArg (CoreAtom a) #-}
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data MagicUnfoldingFun         {-# GHC_PRAGMA MUF (SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)) #-}
+data CoreArg a 
+data CoreAtom a 
+data CoreExpr a b 
+data Id 
+data Labda a 
+data MagicUnfoldingFun 
 type PlainCoreArg = CoreArg Id
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreArg = CoreArg Id
 type PlainCoreAtom = CoreAtom Id
 type PlainCoreExpr = CoreExpr Id Id
-data SimplEnv  {-# GHC_PRAGMA SimplEnv (SimplifierSwitch -> SwitchResult) EnclosingCcDetails (UniqFM UniType) (UniqFM IdVal) UnfoldEnv #-}
-data SimplCount        {-# GHC_PRAGMA SimplCount Int# [(TickType, Int)] #-}
+data SimplEnv 
+data SimplCount 
 type SmplM a = SplitUniqSupply -> SimplCount -> (a, SimplCount)
 type SmplM a = SplitUniqSupply -> SimplCount -> (a, SimplCount)
-data TickType  {-# GHC_PRAGMA UnfoldingDone | FoldrBuild | MagicUnfold | ConReused | CaseFloatFromLet | CaseOfCase | LetFloatFromLet | LetFloatFromCase | KnownBranch | Let2Case | CaseMerge | CaseElim | CaseIdentity | AtomicRhs | EtaExpansion | CaseOfError | FoldrConsNil | Foldr_Nil | FoldrFoldr | Foldr_List | FoldrCons | FoldrInline | TyBetaReduction | BetaReduction #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data TickType 
+data SplitUniqSupply 
+data UniType 
 applyMagicUnfoldingFun :: MagicUnfoldingFun -> SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)
 applyMagicUnfoldingFun :: MagicUnfoldingFun -> SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "U(S)LL" {_A_ 3 _U_ 12222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 3 \ (u0 :: SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)) (u1 :: SimplEnv) (u2 :: [CoreArg Id]) -> _APP_  u0 [ u1, u2 ] _N_} _F_ _IF_ARGS_ 0 3 CXX 4 \ (u0 :: MagicUnfoldingFun) (u1 :: SimplEnv) (u2 :: [CoreArg Id]) -> case u0 of { _ALG_ _ORIG_ MagicUFs MUF (u3 :: SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)) -> _APP_  u3 [ u1, u2 ]; _NO_DEFLT_ } _N_ #-}
 mkMagicUnfoldingFun :: _PackedString -> MagicUnfoldingFun
 mkMagicUnfoldingFun :: _PackedString -> MagicUnfoldingFun
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index e98a46d..0589783 100644 (file)
@@ -5,27 +5,22 @@ import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreExpr(..), PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import TaggedCore(SimplifiableCoreBinding(..), SimplifiableCoreExpr(..))
 import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import PlainCore(PlainCoreExpr(..), PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import TaggedCore(SimplifiableCoreBinding(..), SimplifiableCoreExpr(..))
 import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
-import Unique(Unique)
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data BinderInfo 
+data GlobalSwitch 
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 type SimplifiableCoreBinding = CoreBinding (Id, BinderInfo) Id
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
 newOccurAnalyseBinds :: [CoreBinding Id Id] -> (GlobalSwitch -> Bool) -> (SimplifierSwitch -> Bool) -> [CoreBinding (Id, BinderInfo) Id]
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 type SimplifiableCoreBinding = CoreBinding (Id, BinderInfo) Id
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
 newOccurAnalyseBinds :: [CoreBinding Id Id] -> (GlobalSwitch -> Bool) -> (SimplifierSwitch -> Bool) -> [CoreBinding (Id, BinderInfo) Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "LSL" _N_ _N_ #-}
 newOccurAnalyseExpr :: UniqFM Id -> CoreExpr Id Id -> (UniqFM BinderInfo, CoreExpr (Id, BinderInfo) Id)
 newOccurAnalyseExpr :: UniqFM Id -> CoreExpr Id Id -> (UniqFM BinderInfo, CoreExpr (Id, BinderInfo) Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index b1aa258..d0c1fa0 100644 (file)
@@ -5,29 +5,23 @@ import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreExpr(..), PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import TaggedCore(SimplifiableCoreBinding(..), SimplifiableCoreExpr(..))
 import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import PlainCore(PlainCoreExpr(..), PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import TaggedCore(SimplifiableCoreBinding(..), SimplifiableCoreExpr(..))
 import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
-import Unique(Unique)
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data BinderInfo 
+data GlobalSwitch 
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 type SimplifiableCoreBinding = CoreBinding (Id, BinderInfo) Id
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
 occurAnalyseBinds :: [CoreBinding Id Id] -> (GlobalSwitch -> Bool) -> (SimplifierSwitch -> Bool) -> [CoreBinding (Id, BinderInfo) Id]
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreProgram = [CoreBinding Id Id]
 type SimplifiableCoreBinding = CoreBinding (Id, BinderInfo) Id
 type SimplifiableCoreExpr = CoreExpr (Id, BinderInfo) Id
 occurAnalyseBinds :: [CoreBinding Id Id] -> (GlobalSwitch -> Bool) -> (SimplifierSwitch -> Bool) -> [CoreBinding (Id, BinderInfo) Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "LSL" _N_ _N_ #-}
 occurAnalyseExpr :: UniqFM Id -> CoreExpr Id Id -> (UniqFM BinderInfo, CoreExpr (Id, BinderInfo) Id)
 occurAnalyseExpr :: UniqFM Id -> CoreExpr Id Id -> (UniqFM BinderInfo, CoreExpr (Id, BinderInfo) Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 occurAnalyseGlobalExpr :: CoreExpr Id Id -> CoreExpr (Id, BinderInfo) Id
 occurAnalyseGlobalExpr :: CoreExpr Id Id -> CoreExpr (Id, BinderInfo) Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 181cc65..fb1f338 100644 (file)
@@ -3,18 +3,15 @@ interface SAT where
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PlainCore(PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import TyVar(TyVar)
 import UniType(UniType)
 import PlainCore(PlainCoreProgram(..))
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import TyVar(TyVar)
 import UniType(UniType)
-import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
 type PlainCoreProgram = [CoreBinding Id Id]
 doStaticArgs :: [CoreBinding Id Id] -> SplitUniqSupply -> [CoreBinding Id Id]
 type PlainCoreProgram = [CoreBinding Id Id]
 doStaticArgs :: [CoreBinding Id Id] -> SplitUniqSupply -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _S_ "S" _N_ _N_ #-}
 
 
index b0a3ec0..1c24f25 100644 (file)
@@ -1,55 +1,35 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface SATMonad where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface SATMonad where
-import Class(Class)
 import CoreSyn(CoreBinding, CoreExpr)
 import CoreSyn(CoreBinding, CoreExpr)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PlainCore(PlainCoreExpr(..))
 import SplitUniq(SplitUniqSupply)
 import Maybes(Labda)
 import PlainCore(PlainCoreExpr(..))
 import SplitUniq(SplitUniqSupply)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniType(UniType)
 import UniqFM(UniqFM)
-import Unique(Unique)
 infixr 9 `thenSAT`
 infixr 9 `thenSAT_`
 data Arg a   = Static a | NotStatic
 infixr 9 `thenSAT`
 infixr 9 `thenSAT_`
 data Arg a   = Static a | NotStatic
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type PlainCoreExpr = CoreExpr Id Id
 type SATEnv = UniqFM ([Arg UniType], [Arg Id])
 type SATInfo = ([Arg UniType], [Arg Id])
 type SatM a = SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (a, UniqFM ([Arg UniType], [Arg Id]))
 type PlainCoreExpr = CoreExpr Id Id
 type SATEnv = UniqFM ([Arg UniType], [Arg Id])
 type SATInfo = ([Arg UniType], [Arg Id])
 type SatM a = SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (a, UniqFM ([Arg UniType], [Arg Id]))
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data SplitUniqSupply 
+data UniType 
 dropStatics :: [Arg a] -> [b] -> [b]
 dropStatics :: [Arg a] -> [b] -> [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SS" _N_ _N_ #-}
 emptyEnvSAT :: SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> ((), UniqFM ([Arg UniType], [Arg Id]))
 emptyEnvSAT :: SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> ((), UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 2 _U_ 00 _N_ _S_ "AA" {_A_ 0 _N_ _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getArgLists :: CoreExpr Id Id -> ([Arg UniType], [Arg Id])
 getArgLists :: CoreExpr Id Id -> ([Arg UniType], [Arg Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 getSATInfo :: Id -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (Labda ([Arg UniType], [Arg Id]), UniqFM ([Arg UniType], [Arg Id]))
 getSATInfo :: Id -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (Labda ([Arg UniType], [Arg Id]), UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "LAL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 initSAT :: (SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (a, UniqFM ([Arg UniType], [Arg Id]))) -> SplitUniqSupply -> a
 initSAT :: (SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (a, UniqFM ([Arg UniType], [Arg Id]))) -> SplitUniqSupply -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 insSAEnv :: Id -> ([Arg UniType], [Arg Id]) -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> ((), UniqFM ([Arg UniType], [Arg Id]))
 insSAEnv :: Id -> ([Arg UniType], [Arg Id]) -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> ((), UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 4 _U_ 1202 _N_ _S_ "LLAL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isStatic :: Arg a -> Bool
 isStatic :: Arg a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 4 _/\_ u0 -> \ (u1 :: Arg u0) -> case u1 of { _ALG_ _ORIG_ SATMonad Static (u2 :: u0) -> _!_ True [] []; _ORIG_ SATMonad NotStatic  -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 mapSAT :: (a -> SplitUniqSupply -> c -> (b, c)) -> [a] -> SplitUniqSupply -> c -> ([b], c)
 mapSAT :: (a -> SplitUniqSupply -> c -> (b, c)) -> [a] -> SplitUniqSupply -> c -> ([b], c)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 newSATName :: Id -> UniType -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (Id, UniqFM ([Arg UniType], [Arg Id]))
 newSATName :: Id -> UniType -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (Id, UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 4 _U_ 1212 _N_ _N_ _N_ _N_ #-}
 returnSAT :: b -> a -> c -> (b, c)
 returnSAT :: b -> a -> c -> (b, c)
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _S_ "LAL" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 3 2 XX 3 _/\_ u0 u1 u2 -> \ (u3 :: u1) (u4 :: u2) -> _!_ _TUP_2 [u1, u2] [u3, u4] _N_} _F_ _IF_ARGS_ 3 3 XXX 3 _/\_ u0 u1 u2 -> \ (u3 :: u1) (u4 :: u0) (u5 :: u2) -> _!_ _TUP_2 [u1, u2] [u3, u5] _N_ #-}
 saTransform :: Id -> CoreExpr Id Id -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (CoreBinding Id Id, UniqFM ([Arg UniType], [Arg Id]))
 saTransform :: Id -> CoreExpr Id Id -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (CoreBinding Id Id, UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 2 _U_ 2212 _N_ _N_ _N_ _N_ #-}
 thenSAT :: (SplitUniqSupply -> c -> (a, b)) -> (a -> SplitUniqSupply -> b -> d) -> SplitUniqSupply -> c -> d
 thenSAT :: (SplitUniqSupply -> c -> (a, b)) -> (a -> SplitUniqSupply -> b -> d) -> SplitUniqSupply -> c -> d
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "SSU(ALL)L" {_A_ 5 _U_ 11222 _N_ _N_ _F_ _IF_ARGS_ 4 5 XXXXX 8 _/\_ u0 u1 u2 u3 -> \ (u4 :: SplitUniqSupply -> u2 -> (u0, u1)) (u5 :: u0 -> SplitUniqSupply -> u1 -> u3) (u6 :: SplitUniqSupply) (u7 :: SplitUniqSupply) (u8 :: u2) -> case _APP_  u4 [ u6, u8 ] of { _ALG_ _TUP_2 (u9 :: u0) (ua :: u1) -> _APP_  u5 [ u9, u7, ua ]; _NO_DEFLT_ } _N_} _F_ _ALWAYS_ _/\_ u0 u1 u2 u3 -> \ (u4 :: SplitUniqSupply -> u2 -> (u0, u1)) (u5 :: u0 -> SplitUniqSupply -> u1 -> u3) (u6 :: SplitUniqSupply) (u7 :: u2) -> case u6 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u8 :: Int) (u9 :: SplitUniqSupply) (ua :: SplitUniqSupply) -> case _APP_  u4 [ u9, u7 ] of { _ALG_ _TUP_2 (ub :: u0) (uc :: u1) -> _APP_  u5 [ ub, ua, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 thenSAT_ :: (SplitUniqSupply -> c -> (a, b)) -> (SplitUniqSupply -> b -> d) -> SplitUniqSupply -> c -> d
 thenSAT_ :: (SplitUniqSupply -> c -> (a, b)) -> (SplitUniqSupply -> b -> d) -> SplitUniqSupply -> c -> d
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "SSU(ALL)L" {_A_ 5 _U_ 11222 _N_ _N_ _F_ _IF_ARGS_ 4 5 XXXXX 7 _/\_ u0 u1 u2 u3 -> \ (u4 :: SplitUniqSupply -> u2 -> (u0, u1)) (u5 :: SplitUniqSupply -> u1 -> u3) (u6 :: SplitUniqSupply) (u7 :: SplitUniqSupply) (u8 :: u2) -> case _APP_  u4 [ u6, u8 ] of { _ALG_ _TUP_2 (u9 :: u0) (ua :: u1) -> _APP_  u5 [ u7, ua ]; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 4 4 XXCX 8 _/\_ u0 u1 u2 u3 -> \ (u4 :: SplitUniqSupply -> u2 -> (u0, u1)) (u5 :: SplitUniqSupply -> u1 -> u3) (u6 :: SplitUniqSupply) (u7 :: u2) -> case u6 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u8 :: Int) (u9 :: SplitUniqSupply) (ua :: SplitUniqSupply) -> case _APP_  u4 [ u9, u7 ] of { _ALG_ _TUP_2 (ub :: u0) (uc :: u1) -> _APP_  u5 [ ua, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 updSAEnv :: Labda (Id, ([Arg UniType], [Arg Id])) -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> ((), UniqFM ([Arg UniType], [Arg Id]))
 updSAEnv :: Labda (Id, ([Arg UniType], [Arg Id])) -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> ((), UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "S" _N_ _N_ #-}
 instance Eq a => Eq (Arg a)
 instance Eq a => Eq (Arg a)
-       {-# GHC_PRAGMA _M_ SATMonad {-dfun-} _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 
 
index 6a9e8c3..8f09991 100644 (file)
@@ -7,18 +7,10 @@ import Outputable(Outputable)
 import SplitUniq(SplitUniqSupply)
 data Level   = Level Int Int | Top
 incMinorLvl :: Level -> Level
 import SplitUniq(SplitUniqSupply)
 data Level   = Level Int Int | Top
 incMinorLvl :: Level -> Level
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTopLvl :: Level -> Bool
 isTopLvl :: Level -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: Level) -> case u0 of { _ALG_ _ORIG_ SetLevels Level (u1 :: Int) (u2 :: Int) -> _!_ False [] []; _ORIG_ SetLevels Top  -> _!_ True [] []; _NO_DEFLT_ } _N_ #-}
 ltLvl :: Level -> Level -> Bool
 ltLvl :: Level -> Level -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 ltMajLvl :: Level -> Level -> Bool
 ltMajLvl :: Level -> Level -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 setLevels :: [CoreBinding Id Id] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding (Id, Level) Id]
 setLevels :: [CoreBinding Id Id] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding (Id, Level) Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 tOP_LEVEL :: Level
 tOP_LEVEL :: Level
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ SetLevels Top [] [] _N_ #-}
 instance Outputable Level
 instance Outputable Level
-       {-# GHC_PRAGMA _M_ SetLevels {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Level) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 79ec6cd..96c024b 100644 (file)
@@ -8,7 +8,5 @@ import SimplMonad(SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 bindLargeRhs :: SimplEnv -> [(Id, BinderInfo)] -> UniType -> (SimplEnv -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)) -> SplitUniqSupply -> SimplCount -> ((CoreBinding Id Id, CoreExpr (Id, BinderInfo) Id), SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 bindLargeRhs :: SimplEnv -> [(Id, BinderInfo)] -> UniType -> (SimplEnv -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)) -> SplitUniqSupply -> SimplCount -> ((CoreBinding Id Id, CoreExpr (Id, BinderInfo) Id), SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 212222 _N_ _S_ "LSLS" _N_ _N_ #-}
 simplCase :: SimplEnv -> CoreExpr (Id, BinderInfo) Id -> CoreCaseAlternatives (Id, BinderInfo) Id -> (SimplEnv -> CoreExpr (Id, BinderInfo) Id -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)) -> UniType -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
 simplCase :: SimplEnv -> CoreExpr (Id, BinderInfo) Id -> CoreCaseAlternatives (Id, BinderInfo) Id -> (SimplEnv -> CoreExpr (Id, BinderInfo) Id -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)) -> UniType -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _S_ "LSLLL" _N_ _N_ #-}
 
 
index ed57249..e9f76a4 100644 (file)
@@ -54,7 +54,8 @@ simplCase :: SimplEnv
          -> SmplM OutExpr
 
 simplCase env (CoLet bind body) alts rhs_c result_ty
          -> SmplM OutExpr
 
 simplCase env (CoLet bind body) alts rhs_c result_ty
-  =    -- Float the let outside the case scrutinee
+  | not (switchIsSet env SimplNoLetFromCase)
+  =    -- Float the let outside the case scrutinee (if not disabled by flag)
     tick LetFloatFromCase              `thenSmpl_`
     simplBind env bind (\env -> simplCase env body alts rhs_c result_ty) result_ty
 \end{code}
     tick LetFloatFromCase              `thenSmpl_`
     simplBind env bind (\env -> simplCase env body alts rhs_c result_ty) result_ty
 \end{code}
index 2dadf40..d5f0e2b 100644 (file)
@@ -19,12 +19,11 @@ import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Bag a 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data UnfoldingDetails  {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-}
+data UnfoldingDetails 
 data SpecialiseData   = SpecData Bool Bool [TyCon] [TyCon] (FiniteMap TyCon [[Labda UniType]]) (Bag (Id, [Labda UniType])) (Bag (Id, [Labda UniType])) (Bag (TyCon, [Labda UniType]))
 data SpecialiseData   = SpecData Bool Bool [TyCon] [TyCon] (FiniteMap TyCon [[Labda UniType]]) (Bag (Id, [Labda UniType])) (Bag (Id, [Labda UniType])) (Bag (TyCon, [Labda UniType]))
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniqFM a 
+data Unique 
 core2core :: [CoreToDo] -> (GlobalSwitch -> SwitchResult) -> _PackedString -> PprStyle -> SplitUniqSupply -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> [CoreBinding Id Id] -> _State _RealWorld -> (([CoreBinding Id Id], UniqFM UnfoldingDetails, SpecialiseData), _State _RealWorld)
 core2core :: [CoreToDo] -> (GlobalSwitch -> SwitchResult) -> _PackedString -> PprStyle -> SplitUniqSupply -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> [CoreBinding Id Id] -> _State _RealWorld -> (([CoreBinding Id Id], UniqFM UnfoldingDetails, SpecialiseData), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 222222222 _N_ _S_ "SLLLLLLLL" _N_ _N_ #-}
 
 
index f97c5ba..7349c50 100644 (file)
@@ -2,46 +2,39 @@
 interface SimplEnv where
 import BasicLit(BasicLit)
 import BinderInfo(BinderInfo(..), DuplicationDanger, FunOrArg, InsideSCC)
 interface SimplEnv where
 import BasicLit(BasicLit)
 import BinderInfo(BinderInfo(..), DuplicationDanger, FunOrArg, InsideSCC)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch, SwitchResult)
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr)
 import CostCentre(CostCentre)
 import FiniteMap(FiniteMap)
 import CmdLineOpts(GlobalSwitch, SimplifierSwitch, SwitchResult)
 import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr)
 import CostCentre(CostCentre)
 import FiniteMap(FiniteMap)
-import Id(Id, IdDetails, applyTypeEnvToId)
-import IdEnv(IdEnv(..), lookupIdEnv)
-import IdInfo(IdInfo, StrictnessInfo)
+import Id(Id)
+import IdEnv(IdEnv(..))
+import IdInfo(StrictnessInfo)
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
-import NameTypes(ShortName)
-import Outputable(NamedThing, Outputable)
+import Outputable(Outputable)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(PrettyRep)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(PrettyRep)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
-import SimplMonad(SimplCount)
-import SplitUniq(SplitUniqSupply)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import TyVarEnv(TyVarEnv(..), nullTyVarEnv)
 import TyVarEnv(TyVarEnv(..), nullTyVarEnv)
-import UniTyFuns(applyTypeEnvToTy)
 import UniType(UniType)
 import UniType(UniType)
-import UniqFM(UniqFM, emptyUFM, lookupUFM)
+import UniqFM(UniqFM)
 import Unique(Unique)
 import Unique(Unique)
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
+data BasicLit 
 data BinderInfo   = DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int
 data BinderInfo   = DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int
-data DuplicationDanger         {-# GHC_PRAGMA DupDanger | NoDupDanger #-}
-data FunOrArg  {-# GHC_PRAGMA FunOcc | ArgOcc #-}
-data InsideSCC         {-# GHC_PRAGMA InsideSCC | NotInsideSCC #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data SimplifierSwitch  {-# GHC_PRAGMA SimplOkToDupCode | SimplFloatLetsExposingWHNF | SimplOkToFloatPrimOps | SimplAlwaysFloatLetsFromLets | SimplDoCaseElim | SimplReuseCon | SimplCaseOfCase | SimplLetToCase | SimplMayDeleteConjurableIds | SimplPedanticBottoms | SimplDoArityExpand | SimplDoFoldrBuild | SimplDoNewOccurAnal | SimplDoInlineFoldrBuild | IgnoreINLINEPragma | SimplDoLambdaEtaExpansion | SimplDoEtaReduction | EssentialUnfoldingsOnly | ShowSimplifierProgress | MaxSimplifierIterations Int | SimplUnfoldingUseThreshold Int | SimplUnfoldingCreationThreshold Int | KeepSpecPragmaIds | KeepUnusedBindings #-}
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreCaseAlternatives a b  {-# GHC_PRAGMA CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b) #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
+data DuplicationDanger 
+data FunOrArg 
+data InsideSCC 
+data GlobalSwitch 
+data SimplifierSwitch 
+data CoreAtom a 
+data CoreCaseAlternatives a b 
+data CoreExpr a b 
 data EnclosingCcDetails   = NoEnclosingCcDetails | EnclosingCC CostCentre
 data FormSummary   = WhnfForm | BottomForm | OtherForm
 data EnclosingCcDetails   = NoEnclosingCcDetails | EnclosingCC CostCentre
 data FormSummary   = WhnfForm | BottomForm | OtherForm
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
 data IdVal   = InlineIt (UniqFM IdVal) (UniqFM UniType) (CoreExpr (Id, BinderInfo) Id) | ItsAnAtom (CoreAtom Id)
 type InAlts = CoreCaseAlternatives (Id, BinderInfo) Id
 type IdEnv a = UniqFM a
 data IdVal   = InlineIt (UniqFM IdVal) (UniqFM UniType) (CoreExpr (Id, BinderInfo) Id) | ItsAnAtom (CoreAtom Id)
 type InAlts = CoreCaseAlternatives (Id, BinderInfo) Id
@@ -56,8 +49,8 @@ type InIdEnv = UniqFM IdVal
 type InType = UniType
 type InTypeEnv = UniqFM UniType
 type InUniType = UniType
 type InType = UniType
 type InTypeEnv = UniqFM UniType
 type InUniType = UniType
-data MagicUnfoldingFun         {-# GHC_PRAGMA MUF (SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)) #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data MagicUnfoldingFun 
+data Labda a 
 type OutAlts = CoreCaseAlternatives Id Id
 type OutArg = CoreArg Id
 type OutAtom = CoreAtom Id
 type OutAlts = CoreCaseAlternatives Id Id
 type OutArg = CoreArg Id
 type OutAtom = CoreAtom Id
@@ -68,96 +61,46 @@ type OutExpr = CoreExpr Id Id
 type OutId = Id
 type OutType = UniType
 type OutUniType = UniType
 type OutId = Id
 type OutType = UniType
 type OutUniType = UniType
-data SimplEnv  {-# GHC_PRAGMA SimplEnv (SimplifierSwitch -> SwitchResult) EnclosingCcDetails (UniqFM UniType) (UniqFM IdVal) UnfoldEnv #-}
+data SimplEnv 
 type SwitchChecker a = a -> SwitchResult
 type SwitchChecker a = a -> SwitchResult
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
+data SwitchResult 
+data TyVar 
 type TyVarEnv a = UniqFM a
 type TyVarEnv a = UniqFM a
-data UnfoldConApp      {-# GHC_PRAGMA UCA Id [UniType] [CoreAtom Id] #-}
-data UnfoldEnv         {-# GHC_PRAGMA UFE (UniqFM UnfoldItem) (UniqFM Id) (FiniteMap UnfoldConApp Id) #-}
-data UnfoldItem        {-# GHC_PRAGMA UnfoldItem Id UnfoldingDetails EnclosingCcDetails #-}
+data UnfoldConApp 
+data UnfoldEnv 
+data UnfoldItem 
 data UnfoldingDetails   = NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance
 data UnfoldingGuidance   = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int
 data UnfoldingDetails   = NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance
 data UnfoldingGuidance   = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-applyTypeEnvToId :: UniqFM UniType -> Id -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LLLS)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-applyTypeEnvToTy :: UniqFM UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
+data UniType 
+data UniqFM a 
+data Unique 
 extendIdEnvWithAtom :: SimplEnv -> (Id, BinderInfo) -> CoreAtom Id -> SimplEnv
 extendIdEnvWithAtom :: SimplEnv -> (Id, BinderInfo) -> CoreAtom Id -> SimplEnv
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(LLLLL)U(LL)S" {_A_ 4 _U_ 1122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 extendIdEnvWithAtomList :: SimplEnv -> [((Id, BinderInfo), CoreAtom Id)] -> SimplEnv
 extendIdEnvWithAtomList :: SimplEnv -> [((Id, BinderInfo), CoreAtom Id)] -> SimplEnv
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 extendIdEnvWithClone :: SimplEnv -> (Id, BinderInfo) -> Id -> SimplEnv
 extendIdEnvWithClone :: SimplEnv -> (Id, BinderInfo) -> Id -> SimplEnv
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(LLLLL)U(LA)L" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 extendIdEnvWithClones :: SimplEnv -> [(Id, BinderInfo)] -> [Id] -> SimplEnv
 extendIdEnvWithClones :: SimplEnv -> [(Id, BinderInfo)] -> [Id] -> SimplEnv
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "U(LLLLL)LL" _N_ _N_ #-}
 extendIdEnvWithInlining :: SimplEnv -> SimplEnv -> (Id, BinderInfo) -> CoreExpr (Id, BinderInfo) Id -> SimplEnv
 extendIdEnvWithInlining :: SimplEnv -> SimplEnv -> (Id, BinderInfo) -> CoreExpr (Id, BinderInfo) Id -> SimplEnv
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "U(LLLLL)LU(LA)L" {_A_ 4 _U_ 1112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 extendTyEnv :: SimplEnv -> TyVar -> UniType -> SimplEnv
 extendTyEnv :: SimplEnv -> TyVar -> UniType -> SimplEnv
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(LLLLL)LL" _N_ _N_ #-}
 extendTyEnvList :: SimplEnv -> [(TyVar, UniType)] -> SimplEnv
 extendTyEnvList :: SimplEnv -> [(TyVar, UniType)] -> SimplEnv
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LLLLL)L" _N_ _N_ #-}
 extendUnfoldEnvGivenConstructor :: SimplEnv -> Id -> Id -> [Id] -> SimplEnv
 extendUnfoldEnvGivenConstructor :: SimplEnv -> Id -> Id -> [Id] -> SimplEnv
-       {-# GHC_PRAGMA _A_ 4 _U_ 1221 _N_ _S_ "U(LLLLL)LLL" _N_ _N_ #-}
 extendUnfoldEnvGivenFormDetails :: SimplEnv -> Id -> UnfoldingDetails -> SimplEnv
 extendUnfoldEnvGivenFormDetails :: SimplEnv -> Id -> UnfoldingDetails -> SimplEnv
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(LLLLL)LS" _N_ _N_ #-}
 extendUnfoldEnvGivenRhs :: SimplEnv -> (Id, BinderInfo) -> Id -> CoreExpr Id Id -> SimplEnv
 extendUnfoldEnvGivenRhs :: SimplEnv -> (Id, BinderInfo) -> Id -> CoreExpr Id Id -> SimplEnv
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "U(LLLLL)U(AL)LL" {_A_ 4 _U_ 1122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 filterUnfoldEnvForInlines :: SimplEnv -> SimplEnv
 filterUnfoldEnvForInlines :: SimplEnv -> SimplEnv
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLLLA)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSwitchChecker :: SimplEnv -> SimplifierSwitch -> SwitchResult
 getSwitchChecker :: SimplEnv -> SimplifierSwitch -> SwitchResult
-       {-# GHC_PRAGMA _A_ 1 _U_ 12 _N_ _S_ "U(SAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SimplifierSwitch -> SwitchResult) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: SimplEnv) -> case u0 of { _ALG_ _ORIG_ SimplEnv SimplEnv (u1 :: SimplifierSwitch -> SwitchResult) (u2 :: EnclosingCcDetails) (u3 :: UniqFM UniType) (u4 :: UniqFM IdVal) (u5 :: UnfoldEnv) -> u1; _NO_DEFLT_ } _N_ #-}
 lookForConstructor :: SimplEnv -> Id -> [UniType] -> [CoreAtom Id] -> Labda Id
 lookForConstructor :: SimplEnv -> Id -> [UniType] -> [CoreAtom Id] -> Labda Id
-       {-# GHC_PRAGMA _A_ 4 _U_ 1222 _N_ _S_ "U(AAAAU(AAL))LLL" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupId :: SimplEnv -> Id -> Labda IdVal
 lookupId :: SimplEnv -> Id -> Labda IdVal
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AAASA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-lookupIdEnv :: UniqFM a -> Id -> Labda a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-lookupUFM :: NamedThing a => UniqFM b -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 lookupUnfolding :: SimplEnv -> Id -> UnfoldingDetails
 lookupUnfolding :: SimplEnv -> Id -> UnfoldingDetails
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AAAAL)U(LALS)" {_A_ 4 _U_ 1112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkFormSummary :: StrictnessInfo -> CoreExpr a Id -> FormSummary
 mkFormSummary :: StrictnessInfo -> CoreExpr a Id -> FormSummary
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "LS" _N_ _N_ #-}
 nullInEnvs :: (UniqFM UniType, UniqFM IdVal)
 nullInEnvs :: (UniqFM UniType, UniqFM IdVal)
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 nullSimplEnv :: (SimplifierSwitch -> SwitchResult) -> SimplEnv
 nullSimplEnv :: (SimplifierSwitch -> SwitchResult) -> SimplEnv
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 nullTyVarEnv :: UniqFM a
 nullTyVarEnv :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
 pprSimplEnv :: SimplEnv -> Int -> Bool -> PrettyRep
 pprSimplEnv :: SimplEnv -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(AAAAU(LAA))" {_A_ 1 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 replaceInEnvs :: SimplEnv -> (UniqFM UniType, UniqFM IdVal) -> SimplEnv
 replaceInEnvs :: SimplEnv -> (UniqFM UniType, UniqFM IdVal) -> SimplEnv
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(LLAAL)U(LL)" {_A_ 5 _U_ 22222 _N_ _N_ _F_ _IF_ARGS_ 0 5 XXXXX 6 \ (u0 :: SimplifierSwitch -> SwitchResult) (u1 :: EnclosingCcDetails) (u2 :: UnfoldEnv) (u3 :: UniqFM UniType) (u4 :: UniqFM IdVal) -> _!_ _ORIG_ SimplEnv SimplEnv [] [u0, u1, u3, u4, u2] _N_} _F_ _ALWAYS_ \ (u0 :: SimplEnv) (u1 :: (UniqFM UniType, UniqFM IdVal)) -> case u0 of { _ALG_ _ORIG_ SimplEnv SimplEnv (u2 :: SimplifierSwitch -> SwitchResult) (u3 :: EnclosingCcDetails) (u4 :: UniqFM UniType) (u5 :: UniqFM IdVal) (u6 :: UnfoldEnv) -> case u1 of { _ALG_ _TUP_2 (u7 :: UniqFM UniType) (u8 :: UniqFM IdVal) -> _!_ _ORIG_ SimplEnv SimplEnv [] [u2, u3, u7, u8, u6]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 setEnclosingCC :: SimplEnv -> EnclosingCcDetails -> SimplEnv
 setEnclosingCC :: SimplEnv -> EnclosingCcDetails -> SimplEnv
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LALLL)L" {_A_ 5 _U_ 22222 _N_ _N_ _F_ _IF_ARGS_ 0 5 XXXXX 6 \ (u0 :: SimplifierSwitch -> SwitchResult) (u1 :: UniqFM UniType) (u2 :: UniqFM IdVal) (u3 :: UnfoldEnv) (u4 :: EnclosingCcDetails) -> _!_ _ORIG_ SimplEnv SimplEnv [] [u0, u4, u1, u2, u3] _N_} _F_ _ALWAYS_ \ (u0 :: SimplEnv) (u1 :: EnclosingCcDetails) -> case u0 of { _ALG_ _ORIG_ SimplEnv SimplEnv (u2 :: SimplifierSwitch -> SwitchResult) (u3 :: EnclosingCcDetails) (u4 :: UniqFM UniType) (u5 :: UniqFM IdVal) (u6 :: UnfoldEnv) -> _!_ _ORIG_ SimplEnv SimplEnv [] [u2, u1, u4, u5, u6]; _NO_DEFLT_ } _N_ #-}
 simplTy :: SimplEnv -> UniType -> UniType
 simplTy :: SimplEnv -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AALAA)S" {_A_ 2 _U_ 21 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns applyTypeEnvToTy _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: SimplEnv) (u1 :: UniType) -> case u0 of { _ALG_ _ORIG_ SimplEnv SimplEnv (u2 :: SimplifierSwitch -> SwitchResult) (u3 :: EnclosingCcDetails) (u4 :: UniqFM UniType) (u5 :: UniqFM IdVal) (u6 :: UnfoldEnv) -> _APP_  _ORIG_ UniTyFuns applyTypeEnvToTy [ u4, u1 ]; _NO_DEFLT_ } _N_ #-}
 simplTyInId :: SimplEnv -> Id -> Id
 simplTyInId :: SimplEnv -> Id -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AALAA)U(LLLS)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 switchIsSet :: SimplEnv -> SimplifierSwitch -> Bool
 switchIsSet :: SimplEnv -> SimplifierSwitch -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(SAAAA)L" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _TYAPP_  _ORIG_ CmdLineOpts switchIsOn { SimplifierSwitch } _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: SimplEnv) (u1 :: SimplifierSwitch) -> case u0 of { _ALG_ _ORIG_ SimplEnv SimplEnv (u2 :: SimplifierSwitch -> SwitchResult) (u3 :: EnclosingCcDetails) (u4 :: UniqFM UniType) (u5 :: UniqFM IdVal) (u6 :: UnfoldEnv) -> _APP_  _TYAPP_  _ORIG_ CmdLineOpts switchIsOn { SimplifierSwitch } [ u2, u1 ]; _NO_DEFLT_ } _N_ #-}
 instance Eq UnfoldConApp
 instance Eq UnfoldConApp
-       {-# GHC_PRAGMA _M_ SimplEnv {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UnfoldConApp -> UnfoldConApp -> Bool), (UnfoldConApp -> UnfoldConApp -> Bool)] [_CONSTM_ Eq (==) (UnfoldConApp), _CONSTM_ Eq (/=) (UnfoldConApp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord UnfoldConApp
 instance Ord UnfoldConApp
-       {-# GHC_PRAGMA _M_ SimplEnv {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq UnfoldConApp}}, (UnfoldConApp -> UnfoldConApp -> Bool), (UnfoldConApp -> UnfoldConApp -> Bool), (UnfoldConApp -> UnfoldConApp -> Bool), (UnfoldConApp -> UnfoldConApp -> Bool), (UnfoldConApp -> UnfoldConApp -> UnfoldConApp), (UnfoldConApp -> UnfoldConApp -> UnfoldConApp), (UnfoldConApp -> UnfoldConApp -> _CMP_TAG)] [_DFUN_ Eq (UnfoldConApp), _CONSTM_ Ord (<) (UnfoldConApp), _CONSTM_ Ord (<=) (UnfoldConApp), _CONSTM_ Ord (>=) (UnfoldConApp), _CONSTM_ Ord (>) (UnfoldConApp), _CONSTM_ Ord max (UnfoldConApp), _CONSTM_ Ord min (UnfoldConApp), _CONSTM_ Ord _tagCmp (UnfoldConApp)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)AAA)LL)U(U(U(P)AAA)LL)" {_A_ 4 _U_ 2111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable FormSummary
 instance Outputable FormSummary
-       {-# GHC_PRAGMA _M_ SimplEnv {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FormSummary) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable UnfoldingGuidance
 instance Outputable UnfoldingGuidance
-       {-# GHC_PRAGMA _M_ SimplEnv {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (UnfoldingGuidance) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 4e523f9..015d2f8 100644 (file)
@@ -2,94 +2,46 @@
 interface SimplMonad where
 import BasicLit(BasicLit)
 import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
 interface SimplMonad where
 import BasicLit(BasicLit)
 import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
-import Class(Class)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import NameTypes(ShortName)
-import PreludePS(_PackedString)
-import PrimKind(PrimKind)
+import Id(Id)
 import PrimOps(PrimOp)
 import SimplEnv(SimplEnv)
 import PrimOps(PrimOp)
 import SimplEnv(SimplEnv)
-import SplitUniq(SplitUniqSupply, splitUniqSupply)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import SplitUniq(SplitUniqSupply)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniType(UniType)
-import Unique(Unique)
 infixr 9 `thenSmpl`
 infixr 9 `thenSmpl_`
 infixr 9 `thenSmpl`
 infixr 9 `thenSmpl_`
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data SimplCount        {-# GHC_PRAGMA SimplCount Int# [(TickType, Int)] #-}
+data BinderInfo 
+data CoreExpr a b 
+data Id 
+data PrimOp 
+data SimplCount 
 type SmplM a = SplitUniqSupply -> SimplCount -> (a, SimplCount)
 type SmplM a = SplitUniqSupply -> SimplCount -> (a, SimplCount)
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data SplitUniqSupply 
 data TickType   = UnfoldingDone | FoldrBuild | MagicUnfold | ConReused | CaseFloatFromLet | CaseOfCase | LetFloatFromLet | LetFloatFromCase | KnownBranch | Let2Case | CaseMerge | CaseElim | CaseIdentity | AtomicRhs | EtaExpansion | CaseOfError | FoldrConsNil | Foldr_Nil | FoldrFoldr | Foldr_List | FoldrCons | FoldrInline | TyBetaReduction | BetaReduction
 data TickType   = UnfoldingDone | FoldrBuild | MagicUnfold | ConReused | CaseFloatFromLet | CaseOfCase | LetFloatFromLet | LetFloatFromCase | KnownBranch | Let2Case | CaseMerge | CaseElim | CaseIdentity | AtomicRhs | EtaExpansion | CaseOfError | FoldrConsNil | Foldr_Nil | FoldrFoldr | Foldr_List | FoldrCons | FoldrInline | TyBetaReduction | BetaReduction
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data TyVar 
+data UniType 
 cloneId :: SimplEnv -> (Id, BinderInfo) -> SplitUniqSupply -> SimplCount -> (Id, SimplCount)
 cloneId :: SimplEnv -> (Id, BinderInfo) -> SplitUniqSupply -> SimplCount -> (Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "LU(LA)LL" {_A_ 4 _U_ 1112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 cloneIds :: SimplEnv -> [(Id, BinderInfo)] -> SplitUniqSupply -> SimplCount -> ([Id], SimplCount)
 cloneIds :: SimplEnv -> [(Id, BinderInfo)] -> SplitUniqSupply -> SimplCount -> ([Id], SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 cloneTyVarSmpl :: TyVar -> SplitUniqSupply -> SimplCount -> (TyVar, SimplCount)
 cloneTyVarSmpl :: TyVar -> SplitUniqSupply -> SimplCount -> (TyVar, SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _N_ _N_ _N_ #-}
 combineSimplCounts :: SimplCount -> SimplCount -> SimplCount
 combineSimplCounts :: SimplCount -> SimplCount -> SimplCount
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(PL)U(PA)" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: Int#) (u1 :: [(TickType, Int)]) (u2 :: Int#) -> case _#_ plusInt# [] [u0, u2] of { _PRIM_ (u3 :: Int#) -> _!_ _ORIG_ SimplMonad SimplCount [] [u3, u1] } _N_} _F_ _IF_ARGS_ 0 2 CC 6 \ (u0 :: SimplCount) (u1 :: SimplCount) -> case u0 of { _ALG_ _ORIG_ SimplMonad SimplCount (u2 :: Int#) (u3 :: [(TickType, Int)]) -> case u1 of { _ALG_ _ORIG_ SimplMonad SimplCount (u4 :: Int#) (u5 :: [(TickType, Int)]) -> case _#_ plusInt# [] [u2, u4] of { _PRIM_ (u6 :: Int#) -> _!_ _ORIG_ SimplMonad SimplCount [] [u6, u3] }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 detailedSimplCount :: SplitUniqSupply -> SimplCount -> (SimplCount, SimplCount)
 detailedSimplCount :: SplitUniqSupply -> SimplCount -> (SimplCount, SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: SimplCount) -> _!_ _TUP_2 [SimplCount, SimplCount] [u0, u0] _N_} _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: SplitUniqSupply) (u1 :: SimplCount) -> _!_ _TUP_2 [SimplCount, SimplCount] [u1, u1] _N_ #-}
 initSmpl :: SplitUniqSupply -> (SplitUniqSupply -> SimplCount -> (a, SimplCount)) -> (a, SimplCount)
 initSmpl :: SplitUniqSupply -> (SplitUniqSupply -> SimplCount -> (a, SimplCount)) -> (a, SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: SplitUniqSupply) (u2 :: SplitUniqSupply -> SimplCount -> (u0, SimplCount)) -> _APP_  u2 [ u1, _ORIG_ SimplMonad zeroSimplCount ] _N_ #-}
 mapAndUnzipSmpl :: (a -> SplitUniqSupply -> SimplCount -> ((b, c), SimplCount)) -> [a] -> SplitUniqSupply -> SimplCount -> (([b], [c]), SimplCount)
 mapAndUnzipSmpl :: (a -> SplitUniqSupply -> SimplCount -> ((b, c), SimplCount)) -> [a] -> SplitUniqSupply -> SimplCount -> (([b], [c]), SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 mapSmpl :: (a -> SplitUniqSupply -> SimplCount -> (b, SimplCount)) -> [a] -> SplitUniqSupply -> SimplCount -> ([b], SimplCount)
 mapSmpl :: (a -> SplitUniqSupply -> SimplCount -> (b, SimplCount)) -> [a] -> SplitUniqSupply -> SimplCount -> ([b], SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 newId :: UniType -> SplitUniqSupply -> SimplCount -> (Id, SimplCount)
 newId :: UniType -> SplitUniqSupply -> SimplCount -> (Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _N_ _N_ _N_ #-}
 newIds :: [UniType] -> SplitUniqSupply -> SimplCount -> ([Id], SimplCount)
 newIds :: [UniType] -> SplitUniqSupply -> SimplCount -> ([Id], SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 returnSmpl :: a -> SplitUniqSupply -> SimplCount -> (a, SimplCount)
 returnSmpl :: a -> SplitUniqSupply -> SimplCount -> (a, SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: SplitUniqSupply) (u3 :: SimplCount) -> _!_ _TUP_2 [u0, SimplCount] [u1, u3] _N_ #-}
 showSimplCount :: SimplCount -> [Char]
 showSimplCount :: SimplCount -> [Char]
-       {-# GHC_PRAGMA _A_ 0 _U_ 1 _N_ _N_ _N_ _N_ #-}
 simplCount :: SplitUniqSupply -> SimplCount -> (Int, SimplCount)
 simplCount :: SplitUniqSupply -> SimplCount -> (Int, SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(PL)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
 thenSmpl :: (SplitUniqSupply -> SimplCount -> (a, SimplCount)) -> (a -> SplitUniqSupply -> SimplCount -> (b, SimplCount)) -> SplitUniqSupply -> SimplCount -> (b, SimplCount)
 thenSmpl :: (SplitUniqSupply -> SimplCount -> (a, SimplCount)) -> (a -> SplitUniqSupply -> SimplCount -> (b, SimplCount)) -> SplitUniqSupply -> SimplCount -> (b, SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "SSSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: SplitUniqSupply -> SimplCount -> (u0, SimplCount)) (u3 :: u0 -> SplitUniqSupply -> SimplCount -> (u1, SimplCount)) (u4 :: SplitUniqSupply) (u5 :: SimplCount) -> case u4 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u6 :: Int) (u7 :: SplitUniqSupply) (u8 :: SplitUniqSupply) -> case _APP_  u2 [ u7, u5 ] of { _ALG_ _TUP_2 (u9 :: u0) (ua :: SimplCount) -> _APP_  u3 [ u9, u8, ua ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 thenSmpl_ :: (SplitUniqSupply -> SimplCount -> (a, SimplCount)) -> (SplitUniqSupply -> SimplCount -> (b, SimplCount)) -> SplitUniqSupply -> SimplCount -> (b, SimplCount)
 thenSmpl_ :: (SplitUniqSupply -> SimplCount -> (a, SimplCount)) -> (SplitUniqSupply -> SimplCount -> (b, SimplCount)) -> SplitUniqSupply -> SimplCount -> (b, SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "SSSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: SplitUniqSupply -> SimplCount -> (u0, SimplCount)) (u3 :: SplitUniqSupply -> SimplCount -> (u1, SimplCount)) (u4 :: SplitUniqSupply) (u5 :: SimplCount) -> case u4 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u6 :: Int) (u7 :: SplitUniqSupply) (u8 :: SplitUniqSupply) -> case _APP_  u2 [ u7, u5 ] of { _ALG_ _TUP_2 (u9 :: u0) (ua :: SimplCount) -> _APP_  u3 [ u8, ua ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 tick :: TickType -> SplitUniqSupply -> SimplCount -> ((), SimplCount)
 tick :: TickType -> SplitUniqSupply -> SimplCount -> ((), SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 001 _N_ _S_ "AAU(PL)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 tickN :: TickType -> Int -> SplitUniqSupply -> SimplCount -> ((), SimplCount)
 tickN :: TickType -> Int -> SplitUniqSupply -> SimplCount -> ((), SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 0101 _N_ _S_ "AU(P)AU(PL)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 zeroSimplCount :: SimplCount
 zeroSimplCount :: SimplCount
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instance Eq TickType
 instance Eq TickType
-       {-# GHC_PRAGMA _M_ SimplMonad {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TickType -> TickType -> Bool), (TickType -> TickType -> Bool)] [_CONSTM_ Eq (==) (TickType), _CONSTM_ Eq (/=) (TickType)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Ix TickType
 instance Ix TickType
-       {-# GHC_PRAGMA _M_ SimplMonad {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [{{Ord TickType}}, ((TickType, TickType) -> [TickType]), ((TickType, TickType) -> TickType -> Int), ((TickType, TickType) -> TickType -> Bool)] [_DFUN_ Ord (TickType), _CONSTM_ Ix range (TickType), _CONSTM_ Ix index (TickType), _CONSTM_ Ix inRange (TickType)] _N_
-        range = _A_ 1 _U_ 1 _N_ _S_ "U(EE)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        index = _A_ 2 _U_ 12 _N_ _S_ "U(EE)E" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _N_ _N_,
-        inRange = _A_ 2 _U_ 11 _N_ _S_ "U(EE)E" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord TickType
 instance Ord TickType
-       {-# GHC_PRAGMA _M_ SimplMonad {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TickType}}, (TickType -> TickType -> Bool), (TickType -> TickType -> Bool), (TickType -> TickType -> Bool), (TickType -> TickType -> Bool), (TickType -> TickType -> TickType), (TickType -> TickType -> TickType), (TickType -> TickType -> _CMP_TAG)] [_DFUN_ Eq (TickType), _CONSTM_ Ord (<) (TickType), _CONSTM_ Ord (<=) (TickType), _CONSTM_ Ord (>=) (TickType), _CONSTM_ Ord (>) (TickType), _CONSTM_ Ord max (TickType), _CONSTM_ Ord min (TickType), _CONSTM_ Ord _tagCmp (TickType)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text TickType
 instance Text TickType
-       {-# GHC_PRAGMA _M_ SimplMonad {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(TickType, [Char])]), (Int -> TickType -> [Char] -> [Char]), ([Char] -> [([TickType], [Char])]), ([TickType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (TickType), _CONSTM_ Text showsPrec (TickType), _CONSTM_ Text readList (TickType), _CONSTM_ Text showList (TickType)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(TickType, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 047e784..a330759 100644 (file)
@@ -6,5 +6,4 @@ import Id(Id)
 import SimplMonad(SimplCount)
 import SplitUniq(SplitUniqSupply)
 simplifyPgm :: [CoreBinding Id Id] -> (GlobalSwitch -> SwitchResult) -> (SimplifierSwitch -> SwitchResult) -> SimplCount -> SplitUniqSupply -> ([CoreBinding Id Id], Int, SimplCount)
 import SimplMonad(SimplCount)
 import SplitUniq(SplitUniqSupply)
 simplifyPgm :: [CoreBinding Id Id] -> (GlobalSwitch -> SwitchResult) -> (SimplifierSwitch -> SwitchResult) -> SimplCount -> SplitUniqSupply -> ([CoreBinding Id Id], Int, SimplCount)
-       {-# GHC_PRAGMA _A_ 5 _U_ 12211 _N_ _S_ "LSSLU(ALL)" _N_ _N_ #-}
 
 
index e908c64..138f518 100644 (file)
@@ -9,17 +9,10 @@ import SplitUniq(SplitUniqSupply)
 import TyVar(TyVar)
 import UniType(UniType)
 etaExpandCount :: CoreExpr a Id -> Int
 import TyVar(TyVar)
 import UniType(UniType)
 etaExpandCount :: CoreExpr a Id -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 floatExposesHNF :: Bool -> Bool -> Bool -> CoreExpr a Id -> Bool
 floatExposesHNF :: Bool -> Bool -> Bool -> CoreExpr a Id -> Bool
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "LLLS" _N_ _N_ #-}
 mkCoLamTryingEta :: [Id] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoLamTryingEta :: [Id] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 mkCoTyLamTryingEta :: [TyVar] -> CoreExpr Id Id -> CoreExpr Id Id
 mkCoTyLamTryingEta :: [TyVar] -> CoreExpr Id Id -> CoreExpr Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 mkIdentityAlts :: UniType -> SplitUniqSupply -> SimplCount -> (CoreCaseAlternatives (Id, BinderInfo) Id, SimplCount)
 mkIdentityAlts :: UniType -> SplitUniqSupply -> SimplCount -> (CoreCaseAlternatives (Id, BinderInfo) Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 simplIdWantsToBeINLINEd :: Id -> SimplEnv -> Bool
 simplIdWantsToBeINLINEd :: Id -> SimplEnv -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LU(SAAAA)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 type_ok_for_let_to_case :: UniType -> Bool
 type_ok_for_let_to_case :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 3edcc2e..36b0352 100644 (file)
@@ -7,7 +7,5 @@ import SimplMonad(SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 completeVar :: SimplEnv -> Id -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 completeVar :: SimplEnv -> Id -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "U(LLLLL)U(LLLS)L" _N_ _N_ #-}
 leastItCouldCost :: Int -> Int -> Int -> [Bool] -> [UniType] -> Int
 leastItCouldCost :: Int -> Int -> Int -> [Bool] -> [UniType] -> Int
-       {-# GHC_PRAGMA _A_ 5 _U_ 21111 _N_ _S_ "LLLSL" _N_ _N_ #-}
 
 
index 5e8effe..c612525 100644 (file)
@@ -8,9 +8,6 @@ import SimplMonad(SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 simplBind :: SimplEnv -> CoreBinding (Id, BinderInfo) Id -> (SimplEnv -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)) -> UniType -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
 import SplitUniq(SplitUniqSupply)
 import UniType(UniType)
 simplBind :: SimplEnv -> CoreBinding (Id, BinderInfo) Id -> (SimplEnv -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)) -> UniType -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 4 _U_ 212222 _N_ _S_ "LSLL" _N_ _N_ #-}
 simplExpr :: SimplEnv -> CoreExpr (Id, BinderInfo) Id -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
 simplExpr :: SimplEnv -> CoreExpr (Id, BinderInfo) Id -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (CoreExpr Id Id, SimplCount)
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "LSL" _N_ _N_ #-}
 simplTopBinds :: SimplEnv -> [CoreBinding (Id, BinderInfo) Id] -> SplitUniqSupply -> SimplCount -> ([CoreBinding Id Id], SimplCount)
 simplTopBinds :: SimplEnv -> [CoreBinding (Id, BinderInfo) Id] -> SplitUniqSupply -> SimplCount -> ([CoreBinding Id Id], SimplCount)
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 7c21e22..26d4e5a 100644 (file)
@@ -455,7 +455,14 @@ Let expressions
 
 \begin{code}   
 simplExpr env (CoLet bind body) args
 
 \begin{code}   
 simplExpr env (CoLet bind body) args
-  = simplBind env bind (\env -> simplExpr env body args) (computeResultType env body args)
+  | not (switchIsSet env SimplNoLetFromApp)            -- The common case
+  = simplBind env bind (\env -> simplExpr env body args) 
+                      (computeResultType env body args)
+
+  | otherwise          -- No float from application
+  = simplBind env bind (\env -> simplExpr env body []) 
+                      (computeResultType env body [])  `thenSmpl` \ let_expr' ->
+    returnSmpl (applyToArgs let_expr' args)
 \end{code}
 
 Case expressions 
 \end{code}
 
 Case expressions 
@@ -779,7 +786,7 @@ simplBind env (CoNonRec binder@(id,occ_info) rhs) body_c body_ty
          its body (obviously).
        -}
 
          its body (obviously).
        -}
 
-  | will_be_demanded ||
+  | (will_be_demanded && not no_float) ||
     always_float_let_from_let || 
     floatExposesHNF float_lets float_primops ok_to_dup rhs
   = try_float env rhs body_c
     always_float_let_from_let || 
     floatExposesHNF float_lets float_primops ok_to_dup rhs
   = try_float env rhs body_c
@@ -796,6 +803,7 @@ simplBind env (CoNonRec binder@(id,occ_info) rhs) body_c body_ty
     ok_to_dup                = switchIsSet env SimplOkToDupCode
     always_float_let_from_let = switchIsSet env SimplAlwaysFloatLetsFromLets
     try_let_to_case           = switchIsSet env SimplLetToCase
     ok_to_dup                = switchIsSet env SimplOkToDupCode
     always_float_let_from_let = switchIsSet env SimplAlwaysFloatLetsFromLets
     try_let_to_case           = switchIsSet env SimplLetToCase
+    no_float                 = switchIsSet env SimplNoLetFromStrictLet
 
     -------------------------------------------
     done_float env rhs body_c
 
     -------------------------------------------
     done_float env rhs body_c
index 1ea1a64..3366824 100644 (file)
@@ -4,5 +4,4 @@ import Id(Id)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 liftProgram :: SplitUniqSupply -> [StgBinding Id Id] -> [StgBinding Id Id]
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 liftProgram :: SplitUniqSupply -> [StgBinding Id Id] -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index de10f7c..899ff8e 100644 (file)
@@ -4,5 +4,4 @@ import Id(Id)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 satStgRhs :: [StgBinding Id Id] -> SplitUniqSupply -> [StgBinding Id Id]
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 satStgRhs :: [StgBinding Id Id] -> SplitUniqSupply -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 08f6c91..e70e2fe 100644 (file)
@@ -8,5 +8,4 @@ import Pretty(PprStyle)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 stg2stg :: [StgToDo] -> (GlobalSwitch -> SwitchResult) -> _PackedString -> PprStyle -> SplitUniqSupply -> [StgBinding Id Id] -> _State _RealWorld -> (([StgBinding Id Id], ([CostCentre], [CostCentre])), _State _RealWorld)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgBinding)
 stg2stg :: [StgToDo] -> (GlobalSwitch -> SwitchResult) -> _PackedString -> PprStyle -> SplitUniqSupply -> [StgBinding Id Id] -> _State _RealWorld -> (([StgBinding Id Id], ([CostCentre], [CostCentre])), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 7 _U_ 1222122 _N_ _S_ "SSLLU(ALL)LL" _N_ _N_ #-}
 
 
index 91f7a35..b3e732e 100644 (file)
@@ -1,18 +1,16 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgSAT where
 import CostCentre(CostCentre)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgSAT where
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(PlainStgProgram(..), StgAtom, StgBinding, StgCaseAlternatives, StgExpr, StgRhs)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(PlainStgProgram(..), StgAtom, StgBinding, StgCaseAlternatives, StgExpr, StgRhs)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type PlainStgProgram = [StgBinding Id Id]
 type PlainStgProgram = [StgBinding Id Id]
-data StgBinding a b    {-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data StgBinding a b 
+data StgExpr a b 
 doStaticArgs :: [StgBinding Id Id] -> SplitUniqSupply -> [StgBinding Id Id]
 doStaticArgs :: [StgBinding Id Id] -> SplitUniqSupply -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _S_ "S" _N_ _N_ #-}
 
 
index a6940eb..1e443af 100644 (file)
@@ -1,22 +1,15 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgSATMonad where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgSATMonad where
-import Class(Class)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import SATMonad(Arg)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(PlainStgExpr(..), StgBinding, StgExpr, StgRhs)
 import SATMonad(Arg)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(PlainStgExpr(..), StgBinding, StgExpr, StgRhs)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniType(UniType)
 import UniqFM(UniqFM)
-import Unique(Unique)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
+data Id 
+data SplitUniqSupply 
 type PlainStgExpr = StgExpr Id Id
 type PlainStgExpr = StgExpr Id Id
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data UniType 
 getArgLists :: StgRhs Id Id -> ([Arg UniType], [Arg Id])
 getArgLists :: StgRhs Id Id -> ([Arg UniType], [Arg Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 saTransform :: Id -> StgRhs Id Id -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (StgBinding Id Id, UniqFM ([Arg UniType], [Arg Id]))
 saTransform :: Id -> StgRhs Id Id -> SplitUniqSupply -> UniqFM ([Arg UniType], [Arg Id]) -> (StgBinding Id Id, UniqFM ([Arg UniType], [Arg Id]))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2212 _N_ _S_ "LLU(LLL)L" _N_ _N_ #-}
 
 
index 7dc9282..73aecd7 100644 (file)
@@ -3,5 +3,4 @@ interface StgStats where
 import Id(Id)
 import StgSyn(StgBinding)
 showStgStats :: [StgBinding Id Id] -> [Char]
 import Id(Id)
 import StgSyn(StgBinding)
 showStgStats :: [StgBinding Id Id] -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 2b16fc0..bfe00f3 100644 (file)
@@ -34,19 +34,19 @@ import Util
 
 \begin{code}
 data CounterType
 
 \begin{code}
 data CounterType
-  = AlgCases
-  | PrimCases
-  | LetNoEscapes
-  | NonUpdatableLets
-  | UpdatableLets
+  = Literals
   | Applications
   | Applications
+  | ConstructorApps
   | PrimitiveApps
   | PrimitiveApps
+  | LetNoEscapes
+  | AlgCases
+  | PrimCases
   | FreeVariables
   | FreeVariables
-  | Closures   -- does not include lets bound to constructors
---| UpdatableTopLevelDefs
---| NonUpdatableTopLevelDefs
-  | Constructors
-  deriving (Eq, Ord, Text)
+  | ConstructorBinds Bool{-True<=>top-level-}
+  | ReEntrantBinds   Bool{-ditto-}
+  | SingleEntryBinds Bool{-ditto-}
+  | UpdatableBinds   Bool{-ditto-}
+  deriving (Eq, Ord)
 
 type Count     = Int
 type StatEnv   = FiniteMap CounterType Count
 
 type Count     = Int
 type StatEnv   = FiniteMap CounterType Count
@@ -77,23 +77,34 @@ countN = singletonFM
 
 \begin{code}
 showStgStats :: PlainStgProgram -> String
 
 \begin{code}
 showStgStats :: PlainStgProgram -> String
-showStgStats prog = concat (map showc (fmToList (gatherStgStats prog)))
+
+showStgStats prog
+  = "STG Statistics:\n\n"
+    ++ concat (map showc (fmToList (gatherStgStats prog)))
   where
   where
-    showc (AlgCases,n)         = "AlgCases               " ++ show n ++ "\n"
-    showc (PrimCases,n)        = "PrimCases              " ++ show n ++ "\n"
-    showc (LetNoEscapes,n)     = "LetNoEscapes           " ++ show n ++ "\n"
-    showc (NonUpdatableLets,n) = "NonUpdatableLets       " ++ show n ++ "\n"
-    showc (UpdatableLets,n)    = "UpdatableLets          " ++ show n ++ "\n"
-    showc (Applications,n)     = "Applications           " ++ show n ++ "\n"
-    showc (PrimitiveApps,n)    = "PrimitiveApps          " ++ show n ++ "\n"
-    showc (Closures,n)         = "Closures               " ++ show n ++ "\n"
-    showc (FreeVariables,n)    = "Free Vars in Closures  " ++ show n ++ "\n"
-    showc (Constructors,n)     = "Constructors           " ++ show n ++ "\n"
+    showc (x,n) = (showString (s x) . shows n) "\n"
+
+    s Literals               = "Literals                   "
+    s Applications           = "Applications               "
+    s ConstructorApps        = "ConstructorApps            "
+    s PrimitiveApps          = "PrimitiveApps              "
+    s LetNoEscapes           = "LetNoEscapes               "
+    s AlgCases               = "AlgCases                   "
+    s PrimCases                      = "PrimCases                  "
+    s FreeVariables          = "FreeVariables              "
+    s (ConstructorBinds True) = "ConstructorBinds_Top       "
+    s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
+    s (SingleEntryBinds True) = "SingleEntryBinds_Top       "
+    s (UpdatableBinds True)   = "UpdatableBinds_Top         "
+    s (ConstructorBinds _)    = "ConstructorBinds_Nested    "
+    s (ReEntrantBinds _)      = "ReEntrantBindsBinds_Nested "
+    s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
+    s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
 
 gatherStgStats :: PlainStgProgram -> StatEnv
 
 gatherStgStats binds 
 
 gatherStgStats :: PlainStgProgram -> StatEnv
 
 gatherStgStats binds 
-  = combineSEs (map statBinding binds)
+  = combineSEs (map (statBinding True{-top-level-}) binds)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -103,28 +114,30 @@ gatherStgStats binds
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-statBinding :: PlainStgBinding -> StatEnv
+statBinding :: Bool -- True <=> top-level; False <=> nested
+           -> PlainStgBinding
+           -> StatEnv
 
 
-statBinding (StgNonRec b rhs)
-  = statRhs (b, rhs)
+statBinding top (StgNonRec b rhs)
+  = statRhs top (b, rhs)
 
 
-statBinding (StgRec pairs)
-  = combineSEs (map statRhs pairs)
+statBinding top (StgRec pairs)
+  = combineSEs (map (statRhs top) pairs)
 
 
-statRhs :: (Id, PlainStgRhs) -> StatEnv
+statRhs :: Bool -> (Id, PlainStgRhs) -> StatEnv
 
 
-statRhs (b, StgRhsCon cc con args)
-  = countOne Constructors              `combineSE` 
-    countOne NonUpdatableLets
+statRhs top (b, StgRhsCon cc con args)
+  = countOne (ConstructorBinds top)
 
 
-statRhs (b, StgRhsClosure cc bi fv u args body)
+statRhs top (b, StgRhsClosure cc bi fv u args body)
   = statExpr body                      `combineSE` 
     countN FreeVariables (length fv)   `combineSE`
   = statExpr body                      `combineSE` 
     countN FreeVariables (length fv)   `combineSE`
-    countOne Closures                  `combineSE` 
-    (case u of
-       Updatable -> countOne UpdatableLets
-       _         -> countOne NonUpdatableLets)
-
+    countOne (
+      case u of
+       ReEntrant   -> ReEntrantBinds   top
+       Updatable   -> UpdatableBinds   top
+       SingleEntry -> SingleEntryBinds top
+    )
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -137,12 +150,12 @@ statRhs (b, StgRhsClosure cc bi fv u args body)
 statExpr :: PlainStgExpr -> StatEnv
 
 statExpr (StgApp _ [] lvs) 
 statExpr :: PlainStgExpr -> StatEnv
 
 statExpr (StgApp _ [] lvs) 
-  = emptySE
+  = countOne Literals
 statExpr (StgApp _ _ lvs) 
   = countOne Applications
 
 statExpr (StgConApp con as lvs)
 statExpr (StgApp _ _ lvs) 
   = countOne Applications
 
 statExpr (StgConApp con as lvs)
-  = countOne Constructors
+  = countOne ConstructorApps
 
 statExpr (StgPrimApp op as lvs)
   = countOne PrimitiveApps
 
 statExpr (StgPrimApp op as lvs)
   = countOne PrimitiveApps
@@ -151,12 +164,12 @@ statExpr (StgSCC ty l e)
   = statExpr e
 
 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
   = statExpr e
 
 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
-  = statBinding binds  `combineSE`
-    statExpr body      `combineSE` 
+  = statBinding False{-not top-level-} binds   `combineSE`
+    statExpr body                              `combineSE` 
     countOne LetNoEscapes
 
 statExpr (StgLet binds body)
     countOne LetNoEscapes
 
 statExpr (StgLet binds body)
-  = statBinding binds  `combineSE` 
+  = statBinding False{-not top-level-} binds   `combineSE` 
     statExpr body
 
 statExpr (StgCase expr lve lva uniq alts)
     statExpr body
 
 statExpr (StgCase expr lve lva uniq alts)
@@ -164,25 +177,19 @@ statExpr (StgCase expr lve lva uniq alts)
     stat_alts alts
     where
       stat_alts (StgAlgAlts ty alts def)
     stat_alts alts
     where
       stat_alts (StgAlgAlts ty alts def)
-       = combineSEs (map stat_alg_alt alts)    `combineSE` 
-         stat_deflt def                        `combineSE`
+       = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
+                                       `combineSE` 
+         stat_deflt def                `combineSE`
          countOne AlgCases
          countOne AlgCases
-       where
-         stat_alg_alt (id, bs, use_mask, e)
-           = statExpr e
 
       stat_alts (StgPrimAlts ty alts def)
 
       stat_alts (StgPrimAlts ty alts def)
-       = combineSEs (map stat_prim_alt alts)   `combineSE`
-         stat_deflt def                        `combineSE`
+       = combineSEs (map statExpr [ e | (_,e) <- alts ])
+                                       `combineSE`
+         stat_deflt def                `combineSE`
          countOne PrimCases
          countOne PrimCases
-       where
-         stat_prim_alt (l, e)
-           = statExpr e
 
 
-      stat_deflt StgNoDefault
-       = emptySE
+      stat_deflt StgNoDefault = emptySE
 
 
-      stat_deflt (StgBindDefault b u expr)
-       = statExpr expr 
+      stat_deflt (StgBindDefault b u expr) = statExpr expr     
 \end{code}
 
 \end{code}
 
index 52f36e0..e4ef0ef 100644 (file)
@@ -3,5 +3,4 @@ interface StgVarInfo where
 import Id(Id)
 import StgSyn(StgBinding)
 setStgVarInfo :: Bool -> [StgBinding Id Id] -> [StgBinding Id Id]
 import Id(Id)
 import StgSyn(StgBinding)
 setStgVarInfo :: Bool -> [StgBinding Id Id] -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index c45043e..f26ca4a 100644 (file)
@@ -3,5 +3,4 @@ interface UpdAnal where
 import Id(Id)
 import StgSyn(StgBinding)
 updateAnalyse :: [StgBinding Id Id] -> [StgBinding Id Id]
 import Id(Id)
 import StgSyn(StgBinding)
 updateAnalyse :: [StgBinding Id Id] -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 44f6c54..f491bef 100644 (file)
@@ -6,24 +6,17 @@ import Id(Id)
 import Maybes(Labda(..))
 import Pretty(PprStyle, Pretty(..), PrettyRep)
 import TyCon(TyCon)
 import Maybes(Labda(..))
 import Pretty(PprStyle, Pretty(..), PrettyRep)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVarTemplate)
 import UniType(UniType)
 type ConstraintVector = [Bool]
 data Labda a   = Hamna | Ni a
 type Pretty = Int -> Bool -> PrettyRep
 import UniType(UniType)
 type ConstraintVector = [Bool]
 data Labda a   = Hamna | Ni a
 type Pretty = Int -> Bool -> PrettyRep
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data UniType 
 argTysMatchSpecTys_error :: [Labda UniType] -> [UniType] -> Labda (Int -> Bool -> PrettyRep)
 argTysMatchSpecTys_error :: [Labda UniType] -> [UniType] -> Labda (Int -> Bool -> PrettyRep)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 isUnboxedSpecialisation :: [Labda UniType] -> Bool
 isUnboxedSpecialisation :: [Labda UniType] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkConstraintVector :: [TyVarTemplate] -> [(Class, TyVarTemplate)] -> [Bool]
 mkConstraintVector :: [TyVarTemplate] -> [(Class, TyVarTemplate)] -> [Bool]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 mkSpecialisedCon :: Id -> [UniType] -> Id
 mkSpecialisedCon :: Id -> [UniType] -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(LLLL)S" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 pprSpecErrs :: PprStyle -> Bag (Id, [Labda UniType]) -> Bag (Id, [Labda UniType]) -> Bag (TyCon, [Labda UniType]) -> Int -> Bool -> PrettyRep
 pprSpecErrs :: PprStyle -> Bag (Id, [Labda UniType]) -> Bag (Id, [Labda UniType]) -> Bag (TyCon, [Labda UniType]) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222222 _N_ _S_ "LSLL" _N_ _N_ #-}
 specialiseCallTys :: Bool -> Bool -> Bool -> [Bool] -> [UniType] -> [Labda UniType]
 specialiseCallTys :: Bool -> Bool -> Bool -> [Bool] -> [UniType] -> [Labda UniType]
-       {-# GHC_PRAGMA _A_ 5 _U_ 12211 _N_ _S_ "ELLLL" _N_ _N_ #-}
 specialiseConstrTys :: [UniType] -> [Labda UniType]
 specialiseConstrTys :: [UniType] -> [Labda UniType]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 4c3a5df..74c4288 100644 (file)
@@ -9,11 +9,9 @@ import Maybes(Labda)
 import SplitUniq(SplitUniqSupply)
 import TyCon(TyCon)
 import UniType(UniType)
 import SplitUniq(SplitUniqSupply)
 import TyCon(TyCon)
 import UniType(UniType)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
+data Bag a 
+data FiniteMap a b 
 data SpecialiseData   = SpecData Bool Bool [TyCon] [TyCon] (FiniteMap TyCon [[Labda UniType]]) (Bag (Id, [Labda UniType])) (Bag (Id, [Labda UniType])) (Bag (TyCon, [Labda UniType]))
 initSpecData :: [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> SpecialiseData
 data SpecialiseData   = SpecData Bool Bool [TyCon] [TyCon] (FiniteMap TyCon [[Labda UniType]]) (Bag (Id, [Labda UniType])) (Bag (Id, [Labda UniType])) (Bag (TyCon, [Labda UniType]))
 initSpecData :: [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> SpecialiseData
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 specProgram :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding Id Id] -> SpecialiseData -> ([CoreBinding Id Id], SpecialiseData)
 specProgram :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> [CoreBinding Id Id] -> SpecialiseData -> ([CoreBinding Id Id], SpecialiseData)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2121 _N_ _S_ "LU(ALL)LU(EALALLLL)" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 2aace5e..3348074 100644 (file)
@@ -3,21 +3,18 @@ interface CoreToStg where
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgAtom, StgBinderInfo, StgBinding, StgExpr, StgRhs, UpdateFlag)
 import TyVar(TyVar)
 import UniType(UniType)
 import PrimOps(PrimOp)
 import SplitUniq(SplitUniqSupply)
 import StgSyn(StgAtom, StgBinderInfo, StgBinding, StgExpr, StgRhs, UpdateFlag)
 import TyVar(TyVar)
 import UniType(UniType)
-import Unique(Unique)
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data StgBinderInfo     {-# GHC_PRAGMA NoStgBinderInfo | StgBinderInfo Bool Bool Bool Bool Bool #-}
-data StgBinding a b    {-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
-data StgRhs a b        {-# GHC_PRAGMA StgRhsClosure CostCentre StgBinderInfo [b] UpdateFlag [a] (StgExpr a b) | StgRhsCon CostCentre Id [StgAtom b] #-}
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
+data SplitUniqSupply 
+data StgBinderInfo 
+data StgBinding a b 
+data StgRhs a b 
 topCoreBindsToStg :: SplitUniqSupply -> [CoreBinding Id Id] -> [StgBinding Id Id]
 topCoreBindsToStg :: SplitUniqSupply -> [CoreBinding Id Id] -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(ALA)S" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 4b21fb3..cb3975c 100644 (file)
@@ -27,7 +27,7 @@ import StgSyn         -- output
 import SplitUniq
 import Unique          -- the UniqueSupply monadery used herein
 
 import SplitUniq
 import Unique          -- the UniqueSupply monadery used herein
 
-import AbsPrel         ( unpackCStringId, stringTy,
+import AbsPrel         ( unpackCStringId, unpackCString2Id, stringTy,
                          integerTy, rationalTy, ratioDataCon,
                          PrimOp(..),           -- For Int2IntegerOp etc
                          integerZeroId, integerPlusOneId, integerMinusOneId
                          integerTy, rationalTy, ratioDataCon,
                          PrimOp(..),           -- For Int2IntegerOp etc
                          integerZeroId, integerPlusOneId, integerMinusOneId
@@ -97,10 +97,10 @@ we use @bOGUS_LVs@ and @bOGUS_FVs@ as placeholders.
 
 \begin{code}
 bOGUS_LVs :: PlainStgLiveVars
 
 \begin{code}
 bOGUS_LVs :: PlainStgLiveVars
-bOGUS_LVs = panic "bOGUS_LVs"
+bOGUS_LVs = panic "bOGUS_LVs" -- emptyUniqSet (used when pprTracing)
 
 bOGUS_FVs :: [Id]
 
 bOGUS_FVs :: [Id]
-bOGUS_FVs = panic "bOGUS_FVs"
+bOGUS_FVs = panic "bOGUS_FVs" -- [] (ditto)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
@@ -127,7 +127,13 @@ topCoreBindsToStg us core_binds
 
     do_top_bind env bind@(CoNonRec var rhs)
       = coreBindToStg env bind         `thenSUs` \ (stg_binds, new_env, float_binds) ->
 
     do_top_bind env bind@(CoNonRec var rhs)
       = coreBindToStg env bind         `thenSUs` \ (stg_binds, new_env, float_binds) ->
-
+{- TESTING:
+       let
+           ppr_blah xs = ppInterleave ppComma (map pp_x xs)
+           pp_x (u,x) = ppBesides [pprUnique u, ppStr ": ", ppr PprDebug x]
+       in
+       pprTrace "do_top_bind:" (ppAbove (ppr PprDebug stg_binds) (ppr_blah (ufmToList new_env))) $
+-}
        case stg_binds of
           [StgNonRec var (StgRhsClosure cc bi fvs u [] rhs_body)] -> 
                -- Mega-special case; there's still a binding there
        case stg_binds of
           [StgNonRec var (StgRhsClosure cc bi fvs u [] rhs_body)] -> 
                -- Mega-special case; there's still a binding there
@@ -291,11 +297,19 @@ litToStgAtom (NoRepStr s)
 -- but instead be unpacked each time.  But on some programs that costs a lot 
 -- [eg hpg], so now we update them.
 
 -- but instead be unpacked each time.  But on some programs that costs a lot 
 -- [eg hpg], so now we update them.
 
-       val = StgApp (StgVarAtom unpackCStringId) 
-                    [StgLitAtom (MachStr s)] 
+       val = if (any is_NUL (_UNPK_ s)) then -- must cater for NULs in literal string
+               StgApp (StgVarAtom unpackCString2Id) 
+                    [StgLitAtom (MachStr s),
+                     StgLitAtom (mkMachInt (toInteger (_LENGTH_ s)))]
+                    bOGUS_LVs
+             else
+               StgApp (StgVarAtom unpackCStringId) 
+                    [StgLitAtom (MachStr s)]
                     bOGUS_LVs
     in
     returnSUs (StgVarAtom var, unitBag (StgNonRec var rhs))
                     bOGUS_LVs
     in
     returnSUs (StgVarAtom var, unitBag (StgNonRec var rhs))
+  where
+    is_NUL c = c == '\0'
 
 litToStgAtom (NoRepInteger i)
   -- extremely convenient to look out for a few very common
 
 litToStgAtom (NoRepInteger i)
   -- extremely convenient to look out for a few very common
@@ -593,8 +607,7 @@ coreExprToStg env (CoCase discrim alts)
        returnSUs (StgBindDefault binder True{-used? no it is lying-} stg_rhs,
                  rhs_binds)
       where
        returnSUs (StgBindDefault binder True{-used? no it is lying-} stg_rhs,
                  rhs_binds)
       where
-
-
+       --
        -- We convert   case x of {...; x' -> ...x'...} 
        --      to
        --              case x of {...; _  -> ...x... }
        -- We convert   case x of {...; x' -> ...x'...} 
        --      to
        --              case x of {...; _  -> ...x... }
@@ -604,7 +617,7 @@ coreExprToStg env (CoCase discrim alts)
        -- default binder to the scrutinee.
        --
        new_env = case discrim of
        -- default binder to the scrutinee.
        --
        new_env = case discrim of
-                   CoVar v -> addOneToIdEnv env binder (StgVarAtom v)
+                   CoVar v -> addOneToIdEnv env binder (stgLookup env v)
                    other   -> env
 \end{code}
 
                    other   -> env
 \end{code}
 
@@ -670,7 +683,9 @@ coreExprToStg env (_,AnnCoParComm ctxt expr comm)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
+#ifdef DEBUG
 coreExprToStg env other = panic "coreExprToStg: it really failed here"
 coreExprToStg env other = panic "coreExprToStg: it really failed here"
+#endif
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index 83ce7be..01b2999 100644 (file)
@@ -3,5 +3,4 @@ interface StgFuns where
 import Id(Id)
 import StgSyn(StgRhs)
 mapStgBindeesRhs :: (Id -> Id) -> StgRhs Id Id -> StgRhs Id Id
 import Id(Id)
 import StgSyn(StgRhs)
 mapStgBindeesRhs :: (Id -> Id) -> StgRhs Id Id -> StgRhs Id Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 0bf1754..3587a1e 100644 (file)
@@ -1,16 +1,12 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgLint where
 import CmdLineOpts(GlobalSwitch)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgLint where
 import CmdLineOpts(GlobalSwitch)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Pretty(PprStyle)
 import StgSyn(PlainStgBinding(..), StgBinding, StgRhs)
 import Pretty(PprStyle)
 import StgSyn(PlainStgBinding(..), StgBinding, StgRhs)
-import UniType(UniType)
-import Unique(Unique)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Id 
+data PprStyle 
 type PlainStgBinding = StgBinding Id Id
 type PlainStgBinding = StgBinding Id Id
-data StgBinding a b    {-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
+data StgBinding a b 
 lintStgBindings :: PprStyle -> [Char] -> [StgBinding Id Id] -> [StgBinding Id Id]
 lintStgBindings :: PprStyle -> [Char] -> [StgBinding Id Id] -> [StgBinding Id Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LLS" _N_ _N_ #-}
 
 
index 31c584e..215db4c 100644 (file)
@@ -1,93 +1,66 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgSyn where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface StgSyn where
 import Bag(Bag)
-import BasicLit(BasicLit, isLitLitLit)
+import BasicLit(BasicLit)
 import CharSeq(CSeq)
 import CharSeq(CSeq)
-import Class(Class, ClassOp, cmpClass)
+import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CmdLineOpts(GlobalSwitch)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
-import HsBinds(Bind, Binds, Sig)
-import HsExpr(ArithSeqInfo, Expr, Qual)
-import HsLit(Literal)
-import HsMatches(GRHS, GRHSsAndBinds, Match)
+import CostCentre(CostCentre)
+import HsBinds(Binds)
+import HsExpr(Expr)
+import HsMatches(GRHS, GRHSsAndBinds)
 import HsPat(InPat)
 import HsPat(InPat)
-import HsTypes(PolyType)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(ArgUsageInfo, ArityInfo, DeforestInfo, DemandInfo, FBTypeInfo, IdInfo, SpecEnv, StrictnessInfo, UpdateInfo)
-import Inst(Inst)
-import InstEnv(InstTemplate)
+import IdInfo(IdInfo)
 import Maybes(Labda)
 import Name(Name)
 import Maybes(Labda)
 import Name(Name)
-import NameTypes(FullName, Provenance, ShortName)
+import NameTypes(FullName, ShortName)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
-import SimplEnv(UnfoldingDetails)
 import SrcLoc(SrcLoc)
 import SrcLoc(SrcLoc)
-import TyCon(TyCon, cmpTyCon)
-import TyVar(TyVar, TyVarTemplate, cmpTyVar)
+import TyCon(TyCon)
+import TyVar(TyVar, TyVarTemplate)
 import TyVarEnv(TyVarEnv(..))
 import TyVarEnv(TyVarEnv(..))
-import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType, cmpUniType)
+import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
-data GRHS a b  {-# GHC_PRAGMA GRHS (Expr a b) (Expr a b) SrcLoc | OtherwiseGRHS (Expr a b) SrcLoc #-}
-data GRHSsAndBinds a b         {-# GHC_PRAGMA GRHSsAndBindsIn [GRHS a b] (Binds a b) | GRHSsAndBindsOut [GRHS a b] (Binds a b) UniType #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Bag a 
+data BasicLit 
+data Class 
+data ClassOp 
+data CostCentre 
+data Binds a b 
+data Expr a b 
+data GRHS a b 
+data GRHSsAndBinds a b 
+data InPat a 
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
+data IdInfo 
+data Labda a 
+data Name 
+data FullName 
+data ShortName 
+data ExportFlag 
 type PlainStgAtom = StgAtom Id
 type PlainStgBinding = StgBinding Id Id
 type PlainStgCaseAlternatives = StgCaseAlternatives Id Id
 type PlainStgAtom = StgAtom Id
 type PlainStgBinding = StgBinding Id Id
 type PlainStgCaseAlternatives = StgCaseAlternatives Id Id
@@ -96,13 +69,12 @@ type PlainStgExpr = StgExpr Id Id
 type PlainStgLiveVars = UniqFM Id
 type PlainStgProgram = [StgBinding Id Id]
 type PlainStgRhs = StgRhs Id Id
 type PlainStgLiveVars = UniqFM Id
 type PlainStgProgram = [StgBinding Id Id]
 type PlainStgRhs = StgRhs Id Id
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
+data PrettyRep 
+data PrimKind 
+data PrimOp 
+data SrcLoc 
 data StgAtom a   = StgVarAtom a | StgLitAtom BasicLit
 data StgBinderInfo   = NoStgBinderInfo | StgBinderInfo Bool Bool Bool Bool Bool
 data StgBinding a b   = StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)]
 data StgAtom a   = StgVarAtom a | StgLitAtom BasicLit
 data StgBinderInfo   = NoStgBinderInfo | StgBinderInfo Bool Bool Bool Bool Bool
 data StgBinding a b   = StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)]
@@ -111,333 +83,83 @@ data StgCaseDefault a b   = StgNoDefault | StgBindDefault a Bool (StgExpr a b)
 data StgExpr a b   = StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b)
 type StgLiveVars a = UniqFM a
 data StgRhs a b   = StgRhsClosure CostCentre StgBinderInfo [b] UpdateFlag [a] (StgExpr a b) | StgRhsCon CostCentre Id [StgAtom b]
 data StgExpr a b   = StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b)
 type StgLiveVars a = UniqFM a
 data StgRhs a b   = StgRhsClosure CostCentre StgBinderInfo [b] UpdateFlag [a] (StgExpr a b) | StgRhsCon CostCentre Id [StgAtom b]
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type TyVarEnv a = UniqFM a
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type TyVarEnv a = UniqFM a
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniType 
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 data UpdateFlag   = ReEntrant | Updatable | SingleEntry
 data UpdateFlag   = ReEntrant | Updatable | SingleEntry
-isLitLitLit :: BasicLit -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 12 \ (u0 :: BasicLit) -> case u0 of { _ALG_ _ORIG_ BasicLit MachLitLit (u1 :: _PackedString) (u2 :: PrimKind) -> _!_ True [] []; (u3 :: BasicLit) -> _!_ False [] [] } _N_ #-}
-cmpClass :: Class -> Class -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-cmpTyCon :: TyCon -> TyCon -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpTyVar :: TyVar -> TyVar -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpUniType :: Bool -> UniType -> UniType -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 collectExportedStgBinders :: [StgBinding Id Id] -> [Id]
 collectExportedStgBinders :: [StgBinding Id Id] -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 getAtomKind :: StgAtom Id -> PrimKind
 getAtomKind :: StgAtom Id -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: StgAtom Id) -> case u0 of { _ALG_ _ORIG_ StgSyn StgVarAtom (u1 :: Id) -> _APP_  _ORIG_ Id getIdKind [ u1 ]; _ORIG_ StgSyn StgLitAtom (u2 :: BasicLit) -> _APP_  _ORIG_ BasicLit kindOfBasicLit [ u2 ]; _NO_DEFLT_ } _N_ #-}
 isLitLitStgAtom :: StgAtom a -> Bool
 isLitLitStgAtom :: StgAtom a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 5 _/\_ u0 -> \ (u1 :: StgAtom u0) -> case u1 of { _ALG_ _ORIG_ StgSyn StgVarAtom (u2 :: u0) -> _!_ False [] []; _ORIG_ StgSyn StgLitAtom (u3 :: BasicLit) -> _APP_  _ORIG_ BasicLit isLitLitLit [ u3 ]; _NO_DEFLT_ } _N_ #-}
 pprPlainStgBinding :: PprStyle -> StgBinding Id Id -> Int -> Bool -> PrettyRep
 pprPlainStgBinding :: PprStyle -> StgBinding Id Id -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 stgArgOcc :: StgBinderInfo
 stgArgOcc :: StgBinderInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgArity :: StgRhs Id Id -> Int
 stgArity :: StgRhs Id Id -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: StgRhs Id Id) -> case u0 of { _ALG_ _ORIG_ StgSyn StgRhsCon (u1 :: CostCentre) (u2 :: Id) (u3 :: [StgAtom Id]) -> _!_ I# [] [0#]; _ORIG_ StgSyn StgRhsClosure (u4 :: CostCentre) (u5 :: StgBinderInfo) (u6 :: [Id]) (u7 :: UpdateFlag) (u8 :: [Id]) (u9 :: StgExpr Id Id) -> _APP_  _TYAPP_  _ORIG_ PreludeList length { Id } [ u8 ]; _NO_DEFLT_ } _N_ #-}
 stgFakeFunAppOcc :: StgBinderInfo
 stgFakeFunAppOcc :: StgBinderInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgNoUpdHeapOcc :: StgBinderInfo
 stgNoUpdHeapOcc :: StgBinderInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgNormalOcc :: StgBinderInfo
 stgNormalOcc :: StgBinderInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgStdHeapOcc :: StgBinderInfo
 stgStdHeapOcc :: StgBinderInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 stgUnsatOcc :: StgBinderInfo
 stgUnsatOcc :: StgBinderInfo
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instance Eq BasicLit
 instance Eq BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool)] [_CONSTM_ Eq (==) (BasicLit), _CONSTM_ Eq (/=) (BasicLit)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq Class
 instance Eq Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Class -> Class -> Bool), (Class -> Class -> Bool)] [_CONSTM_ Eq (==) (Class), _CONSTM_ Eq (/=) (Class)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ eqInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Eq (/=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq ClassOp
 instance Eq ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool)] [_CONSTM_ Eq (==) (ClassOp), _CONSTM_ Eq (/=) (ClassOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq Id
 instance Eq Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq PrimKind
 instance Eq PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool)] [_CONSTM_ Eq (==) (PrimKind), _CONSTM_ Eq (/=) (PrimKind)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Eq PrimOp
 instance Eq PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_  _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq TyCon
 instance Eq TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVar
 instance Eq TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool)] [_CONSTM_ Eq (==) (TyVar), _CONSTM_ Eq (/=) (TyVar)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVarTemplate
 instance Eq TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool)] [_CONSTM_ Eq (==) (TyVarTemplate), _CONSTM_ Eq (/=) (TyVarTemplate)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq UniType
 instance Eq UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UniType -> UniType -> Bool), (UniType -> UniType -> Bool)] [_CONSTM_ Eq (==) (UniType), _CONSTM_ Eq (/=) (UniType)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord BasicLit
 instance Ord BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq BasicLit}}, (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> _CMP_TAG)] [_DFUN_ Eq (BasicLit), _CONSTM_ Ord (<) (BasicLit), _CONSTM_ Ord (<=) (BasicLit), _CONSTM_ Ord (>=) (BasicLit), _CONSTM_ Ord (>) (BasicLit), _CONSTM_ Ord max (BasicLit), _CONSTM_ Ord min (BasicLit), _CONSTM_ Ord _tagCmp (BasicLit)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Class
 instance Ord Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Class}}, (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Class), (Class -> Class -> Class), (Class -> Class -> _CMP_TAG)] [_DFUN_ Eq (Class), _CONSTM_ Ord (<) (Class), _CONSTM_ Ord (<=) (Class), _CONSTM_ Ord (>=) (Class), _CONSTM_ Ord (>) (Class), _CONSTM_ Ord max (Class), _CONSTM_ Ord min (Class), _CONSTM_ Ord _tagCmp (Class)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ ltInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ leInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord ClassOp
 instance Ord ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq ClassOp}}, (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> _CMP_TAG)] [_DFUN_ Eq (ClassOp), _CONSTM_ Ord (<) (ClassOp), _CONSTM_ Ord (<=) (ClassOp), _CONSTM_ Ord (>=) (ClassOp), _CONSTM_ Ord (>) (ClassOp), _CONSTM_ Ord max (ClassOp), _CONSTM_ Ord min (ClassOp), _CONSTM_ Ord _tagCmp (ClassOp)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ ltInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ leInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ geInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ geInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ gtInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ gtInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord Id
 instance Ord Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord PrimKind
 instance Ord PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq PrimKind}}, (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> _CMP_TAG)] [_DFUN_ Eq (PrimKind), _CONSTM_ Ord (<) (PrimKind), _CONSTM_ Ord (<=) (PrimKind), _CONSTM_ Ord (>=) (PrimKind), _CONSTM_ Ord (>) (PrimKind), _CONSTM_ Ord max (PrimKind), _CONSTM_ Ord min (PrimKind), _CONSTM_ Ord _tagCmp (PrimKind)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Ord TyCon
 instance Ord TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVar
 instance Ord TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVar}}, (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> _CMP_TAG)] [_DFUN_ Eq (TyVar), _CONSTM_ Ord (<) (TyVar), _CONSTM_ Ord (<=) (TyVar), _CONSTM_ Ord (>=) (TyVar), _CONSTM_ Ord (>) (TyVar), _CONSTM_ Ord max (TyVar), _CONSTM_ Ord min (TyVar), _CONSTM_ Ord _tagCmp (TyVar)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVarTemplate
 instance Ord TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVarTemplate}}, (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> TyVarTemplate), (TyVarTemplate -> TyVarTemplate -> TyVarTemplate), (TyVarTemplate -> TyVarTemplate -> _CMP_TAG)] [_DFUN_ Eq (TyVarTemplate), _CONSTM_ Ord (<) (TyVarTemplate), _CONSTM_ Ord (<=) (TyVarTemplate), _CONSTM_ Ord (>=) (TyVarTemplate), _CONSTM_ Ord (>) (TyVarTemplate), _CONSTM_ Ord max (TyVarTemplate), _CONSTM_ Ord min (TyVarTemplate), _CONSTM_ Ord _tagCmp (TyVarTemplate)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Class
 instance NamedThing Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Class -> ExportFlag), (Class -> Bool), (Class -> (_PackedString, _PackedString)), (Class -> _PackedString), (Class -> [_PackedString]), (Class -> SrcLoc), (Class -> Unique), (Class -> Bool), (Class -> UniType), (Class -> Bool)] [_CONSTM_ NamedThing getExportFlag (Class), _CONSTM_ NamedThing isLocallyDefined (Class), _CONSTM_ NamedThing getOrigName (Class), _CONSTM_ NamedThing getOccurrenceName (Class), _CONSTM_ NamedThing getInformingModules (Class), _CONSTM_ NamedThing getSrcLoc (Class), _CONSTM_ NamedThing getTheUnique (Class), _CONSTM_ NamedThing hasType (Class), _CONSTM_ NamedThing getType (Class), _CONSTM_ NamedThing fromPreludeCore (Class)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(LLAAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [ub, uc]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(ALSAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAAAS)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ug; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Unique) } [ _NOREP_S_ "NamedThing.Class.getTheUnique", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Bool) } [ _NOREP_S_ "NamedThing.Class.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> UniType) } [ _NOREP_S_ "NamedThing.Class.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing a => NamedThing (InPat a)
 instance NamedThing a => NamedThing (InPat a)
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 0 _N_ _N_ _N_ _N_ #-}
 instance NamedThing Id
 instance NamedThing Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-        getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing FullName
 instance NamedThing FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(FullName -> ExportFlag), (FullName -> Bool), (FullName -> (_PackedString, _PackedString)), (FullName -> _PackedString), (FullName -> [_PackedString]), (FullName -> SrcLoc), (FullName -> Unique), (FullName -> Bool), (FullName -> UniType), (FullName -> Bool)] [_CONSTM_ NamedThing getExportFlag (FullName), _CONSTM_ NamedThing isLocallyDefined (FullName), _CONSTM_ NamedThing getOrigName (FullName), _CONSTM_ NamedThing getOccurrenceName (FullName), _CONSTM_ NamedThing getInformingModules (FullName), _CONSTM_ NamedThing getSrcLoc (FullName), _CONSTM_ NamedThing getTheUnique (FullName), _CONSTM_ NamedThing hasType (FullName), _CONSTM_ NamedThing getType (FullName), _CONSTM_ NamedThing fromPreludeCore (FullName)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAEAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ThisModule  -> _!_ True [] []; _ORIG_ NameTypes InventedInThisModule  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LLAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [u1, u2]; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(ALSAAA)" {_A_ 2 _U_ 11 _N_ _N_ _F_ _IF_ARGS_ 0 2 XC 10 \ (u0 :: _PackedString) (u1 :: Provenance) -> case u1 of { _ALG_ _ORIG_ NameTypes OtherPrelude (u2 :: _PackedString) -> u2; _ORIG_ NameTypes OtherModule (u3 :: _PackedString) (u4 :: [_PackedString]) -> u3; (u5 :: Provenance) -> u0 } _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ExportedByPreludeCore  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 instance NamedThing ShortName
 instance NamedThing ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ShortName -> ExportFlag), (ShortName -> Bool), (ShortName -> (_PackedString, _PackedString)), (ShortName -> _PackedString), (ShortName -> [_PackedString]), (ShortName -> SrcLoc), (ShortName -> Unique), (ShortName -> Bool), (ShortName -> UniType), (ShortName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ShortName), _CONSTM_ NamedThing isLocallyDefined (ShortName), _CONSTM_ NamedThing getOrigName (ShortName), _CONSTM_ NamedThing getOccurrenceName (ShortName), _CONSTM_ NamedThing getInformingModules (ShortName), _CONSTM_ NamedThing getSrcLoc (ShortName), _CONSTM_ NamedThing getTheUnique (ShortName), _CONSTM_ NamedThing hasType (ShortName), _CONSTM_ NamedThing getType (ShortName), _CONSTM_ NamedThing fromPreludeCore (ShortName)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(SA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u1; _NO_DEFLT_ } _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u2; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AA)" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 instance NamedThing TyCon
 instance NamedThing TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance NamedThing TyVar
 instance NamedThing TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVar -> ExportFlag), (TyVar -> Bool), (TyVar -> (_PackedString, _PackedString)), (TyVar -> _PackedString), (TyVar -> [_PackedString]), (TyVar -> SrcLoc), (TyVar -> Unique), (TyVar -> Bool), (TyVar -> UniType), (TyVar -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVar), _CONSTM_ NamedThing isLocallyDefined (TyVar), _CONSTM_ NamedThing getOrigName (TyVar), _CONSTM_ NamedThing getOccurrenceName (TyVar), _CONSTM_ NamedThing getInformingModules (TyVar), _CONSTM_ NamedThing getSrcLoc (TyVar), _CONSTM_ NamedThing getTheUnique (TyVar), _CONSTM_ NamedThing hasType (TyVar), _CONSTM_ NamedThing getType (TyVar), _CONSTM_ NamedThing fromPreludeCore (TyVar)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVar" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar UserTyVar (u1 :: Unique) (u2 :: ShortName) -> case u2 of { _ALG_ _ORIG_ NameTypes ShortName (u3 :: _PackedString) (u4 :: SrcLoc) -> u4; _NO_DEFLT_ }; (u5 :: TyVar) -> _ORIG_ SrcLoc mkUnknownSrcLoc } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar PolySysTyVar (u1 :: Unique) -> u1; _ORIG_ TyVar PrimSysTyVar (u2 :: Unique) -> u2; _ORIG_ TyVar OpenSysTyVar (u3 :: Unique) -> u3; _ORIG_ TyVar UserTyVar (u4 :: Unique) (u5 :: ShortName) -> u4; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ False [] [] _N_ #-}
 instance NamedThing TyVarTemplate
 instance NamedThing TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVarTemplate -> ExportFlag), (TyVarTemplate -> Bool), (TyVarTemplate -> (_PackedString, _PackedString)), (TyVarTemplate -> _PackedString), (TyVarTemplate -> [_PackedString]), (TyVarTemplate -> SrcLoc), (TyVarTemplate -> Unique), (TyVarTemplate -> Bool), (TyVarTemplate -> UniType), (TyVarTemplate -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVarTemplate), _CONSTM_ NamedThing isLocallyDefined (TyVarTemplate), _CONSTM_ NamedThing getOrigName (TyVarTemplate), _CONSTM_ NamedThing getOccurrenceName (TyVarTemplate), _CONSTM_ NamedThing getInformingModules (TyVarTemplate), _CONSTM_ NamedThing getSrcLoc (TyVarTemplate), _CONSTM_ NamedThing getTheUnique (TyVarTemplate), _CONSTM_ NamedThing hasType (TyVarTemplate), _CONSTM_ NamedThing getType (TyVarTemplate), _CONSTM_ NamedThing fromPreludeCore (TyVarTemplate)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVarTemplate" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: TyVarTemplate) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u1 :: Unique) (u2 :: _PackedString) -> _ORIG_ SrcLoc mkUnknownSrcLoc; _ORIG_ TyVar UserTyVarTemplate (u3 :: Unique) (u4 :: ShortName) -> case u4 of { _ALG_ _ORIG_ NameTypes ShortName (u5 :: _PackedString) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: TyVarTemplate) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u1 :: Unique) (u2 :: _PackedString) -> u1; _ORIG_ TyVar UserTyVarTemplate (u3 :: Unique) (u4 :: ShortName) -> u3; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  patError# { (TyVarTemplate -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  patError# { (TyVarTemplate -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ False [] [] _N_ #-}
 instance (Outputable a, Outputable b) => Outputable (a, b)
 instance (Outputable a, Outputable b) => Outputable (a, b)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-}
 instance Outputable BasicLit
 instance Outputable BasicLit
-       {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BasicLit) _N_
-        ppr = _A_ 0 _U_ 2122 _N_ _N_ _N_ _N_ #-}
 instance Outputable Bool
 instance Outputable Bool
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Class
 instance Outputable Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Class) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(AU(LLLLAA)AAAAAAAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ClassOp
 instance Outputable ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b)
-       {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b)
-       {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHS u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: GRHSs", u8, u9 ] _N_ #-}
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b)
 instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b)
-       {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHSsAndBinds u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr:GRHSsAndBinds", u8, u9 ] _N_ #-}
 instance Outputable a => Outputable (InPat a)
 instance Outputable a => Outputable (InPat a)
-       {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Outputable Id
 instance Outputable Id
-       {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Outputable FullName
 instance Outputable FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FullName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LLLLAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ShortName
 instance Outputable ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ShortName) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AU(LA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable PrimKind
 instance Outputable PrimKind
-       {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (PrimKind) _N_
-        ppr = _A_ 2 _U_ 0120 _N_ _S_ "AL" {_A_ 1 _U_ 120 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable PrimOp
 instance Outputable PrimOp
-       {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-}
 instance Outputable a => Outputable (StgAtom a)
 instance Outputable a => Outputable (StgAtom a)
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _F_ _IF_ARGS_ 1 3 XXC 8 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: StgAtom u0) -> case u3 of { _ALG_ _ORIG_ StgSyn StgVarAtom (u4 :: u0) -> _APP_  u1 [ u2, u4 ]; _ORIG_ StgSyn StgLitAtom (u5 :: BasicLit) -> _APP_  _CONSTM_ Outputable ppr (BasicLit) [ u2, u5 ]; _NO_DEFLT_ } _N_ #-}
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgBinding a b)
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgBinding a b)
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgExpr a b)
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgExpr a b)
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgRhs a b)
 instance (Outputable a, Outputable b, Ord b) => Outputable (StgRhs a b)
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLS" _N_ _N_ #-}
 instance Outputable UpdateFlag
 instance Outputable UpdateFlag
-       {-# GHC_PRAGMA _M_ StgSyn {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (UpdateFlag) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "ALLA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable TyCon
 instance Outputable TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVar
 instance Outputable TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVar) _N_
-        ppr = _A_ 2 _U_ 1122 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVarTemplate
 instance Outputable TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVarTemplate) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable UniType
 instance Outputable UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_ #-}
 instance Outputable a => Outputable [a]
 instance Outputable a => Outputable [a]
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index e250613..c243aee 100644 (file)
@@ -6,15 +6,9 @@ import IdInfo(Demand)
 import SaLib(AbsVal, AbsValEnv, AnalysisKind)
 import UniType(UniType)
 absEval :: AnalysisKind -> CoreExpr Id Id -> AbsValEnv -> AbsVal
 import SaLib(AbsVal, AbsValEnv, AnalysisKind)
 import UniType(UniType)
 absEval :: AnalysisKind -> CoreExpr Id Id -> AbsValEnv -> AbsVal
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSL" _N_ _N_ #-}
 findDemand :: AbsValEnv -> AbsValEnv -> CoreExpr Id Id -> Id -> Demand
 findDemand :: AbsValEnv -> AbsValEnv -> CoreExpr Id Id -> Id -> Demand
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "LLLU(LSLL)" _N_ _N_ #-}
-findStrictness :: [UniType] -> AbsVal -> AbsVal -> [Demand]
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
+findStrictness :: (Bool, Bool) -> [UniType] -> AbsVal -> AbsVal -> [Demand]
 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr Id Id] -> AbsValEnv -> [AbsVal]
 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr Id Id] -> AbsValEnv -> [AbsVal]
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "LSLL" _N_ _N_ #-}
 isBot :: AbsVal -> Bool
 isBot :: AbsVal -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 widen :: AnalysisKind -> AbsVal -> AbsVal
 widen :: AnalysisKind -> AbsVal -> AbsVal
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "ES" _N_ _N_ #-}
 
 
index 9cdb3d4..809a802 100644 (file)
@@ -20,7 +20,11 @@ import Pretty
 --import FiniteMap
 import Outputable
 
 --import FiniteMap
 import Outputable
 
-import AbsPrel         ( PrimOp(..), PrimKind )
+import AbsPrel         ( PrimOp(..),
+                         intTyCon, integerTyCon, doubleTyCon,
+                         floatTyCon, wordTyCon, addrTyCon,
+                         PrimKind
+                       )
 import AbsUniType      ( isPrimType, getUniDataTyCon_maybe,
                          maybeSingleConstructorTyCon,
                          returnsRealWorld,
 import AbsUniType      ( isPrimType, getUniDataTyCon_maybe,
                          maybeSingleConstructorTyCon,
                          returnsRealWorld,
@@ -736,51 +740,53 @@ unbound variables in an @AbsValEnv@ are implicitly mapped to that.
 See notes on @addStrictnessInfoToId@.
 
 \begin{code}
 See notes on @addStrictnessInfoToId@.
 
 \begin{code}
-findStrictness :: [UniType]    -- Types of args in which strictness is wanted
+findStrictness :: StrAnalFlags
+              -> [UniType]     -- Types of args in which strictness is wanted
               -> AbsVal        -- Abstract strictness value of function 
               -> AbsVal        -- Abstract absence value of function
               -> [Demand]      -- Resulting strictness annotation
 
               -> AbsVal        -- Abstract strictness value of function 
               -> AbsVal        -- Abstract absence value of function
               -> [Demand]      -- Resulting strictness annotation
 
-findStrictness [] str_val abs_val = []
+findStrictness strflags [] str_val abs_val = []
 
 
-findStrictness (ty:tys) str_val abs_val
+findStrictness strflags (ty:tys) str_val abs_val
   = let
   = let
-       demand       = findRecDemand [] str_fn abs_fn ty
+       demand       = findRecDemand strflags [] str_fn abs_fn ty
        str_fn val   = absApply StrAnal str_val val
        abs_fn val   = absApply AbsAnal abs_val val
 
        str_fn val   = absApply StrAnal str_val val
        abs_fn val   = absApply AbsAnal abs_val val
 
-       demands = findStrictness tys (absApply StrAnal str_val AbsTop)
-                                    (absApply AbsAnal abs_val AbsTop)
+       demands = findStrictness strflags tys
+                       (absApply StrAnal str_val AbsTop)
+                       (absApply AbsAnal abs_val AbsTop)
     in
     in
-    -- pprTrace "findRecDemand:" (ppCat [ppr PprDebug demand, ppr PprDebug ty]) (
     demand : demands
     demand : demands
-    -- )
 \end{code}
 
 
 \begin{code}
 findDemandStrOnly str_env expr binder  -- Only strictness environment available
 \end{code}
 
 
 \begin{code}
 findDemandStrOnly str_env expr binder  -- Only strictness environment available
-  = findRecDemand [] str_fn abs_fn (getIdUniType binder)
+  = findRecDemand strflags [] str_fn abs_fn (getIdUniType binder)
   where
     str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
     abs_fn val = AbsBot                -- Always says poison; so it looks as if
                                -- nothing is absent; safe
   where
     str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
     abs_fn val = AbsBot                -- Always says poison; so it looks as if
                                -- nothing is absent; safe
-  
+    strflags   = getStrAnalFlags str_env
 
 findDemandAbsOnly abs_env expr binder  -- Only absence environment available
 
 findDemandAbsOnly abs_env expr binder  -- Only absence environment available
-  = findRecDemand [] str_fn abs_fn (getIdUniType binder)
+  = findRecDemand strflags [] str_fn abs_fn (getIdUniType binder)
   where
     str_fn val = AbsBot                -- Always says non-termination;
                                -- that'll make findRecDemand peer into the
                                -- structure of the value.
     abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
   where
     str_fn val = AbsBot                -- Always says non-termination;
                                -- that'll make findRecDemand peer into the
                                -- structure of the value.
     abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
+    strflags   = getStrAnalFlags abs_env
   
 
 findDemand str_env abs_env expr binder
   
 
 findDemand str_env abs_env expr binder
-  = findRecDemand [] str_fn abs_fn (getIdUniType binder)
+  = findRecDemand strflags [] str_fn abs_fn (getIdUniType binder)
   where
     str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
     abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
   where
     str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
     abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
+    strflags   = getStrAnalFlags str_env
 \end{code}
 
 @findRecDemand@ is where we finally convert strictness/absence info
 \end{code}
 
 @findRecDemand@ is where we finally convert strictness/absence info
@@ -816,14 +822,15 @@ then we'd let-to-case it:
 Ho hum.
 
 \begin{code}
 Ho hum.
 
 \begin{code}
-findRecDemand :: [TyCon]           -- TyCons already seen; used to avoid
+findRecDemand :: StrAnalFlags
+             -> [TyCon]            -- TyCons already seen; used to avoid
                                    -- zooming into recursive types
              -> (AbsVal -> AbsVal) -- The strictness function
              -> (AbsVal -> AbsVal) -- The absence function
              -> UniType            -- The type of the argument
              -> Demand
 
                                    -- zooming into recursive types
              -> (AbsVal -> AbsVal) -- The strictness function
              -> (AbsVal -> AbsVal) -- The absence function
              -> UniType            -- The type of the argument
              -> Demand
 
-findRecDemand seen str_fn abs_fn ty
+findRecDemand strflags seen str_fn abs_fn ty
   = if isPrimType ty then -- It's a primitive type!
        wwPrim
 
   = if isPrimType ty then -- It's a primitive type!
        wwPrim
 
@@ -831,10 +838,12 @@ findRecDemand seen str_fn abs_fn ty
        -- We prefer absence over strictness: see NOTE above.
        WwLazy True
 
        -- We prefer absence over strictness: see NOTE above.
        WwLazy True
 
-    else if not (isBot (str_fn AbsBot)) then -- It's not strict
-       WwLazy False
+    else if not (all_strict ||
+                (num_strict && is_numeric_type ty) ||
+                (isBot (str_fn AbsBot))) then
+       WwLazy False -- It's not strict and we're not pretending
 
 
-    else -- It's strict!
+    else -- It's strict (or we're pretending it is)!
 
        case getUniDataTyCon_maybe ty of
 
 
        case getUniDataTyCon_maybe ty of
 
@@ -847,7 +856,7 @@ findRecDemand seen str_fn abs_fn ty
              prod_len = length cmpnt_tys
 
              compt_strict_infos
              prod_len = length cmpnt_tys
 
              compt_strict_infos
-               = [ findRecDemand (tycon:seen)
+               = [ findRecDemand strflags (tycon:seen)
                         (\ cmpnt_val ->
                               str_fn (mkMainlyTopProd prod_len i cmpnt_val)
                         )
                         (\ cmpnt_val ->
                               str_fn (mkMainlyTopProd prod_len i cmpnt_val)
                         )
@@ -874,6 +883,21 @@ findRecDemand seen str_fn abs_fn ty
            else
                wwStrict
   where
            else
                wwStrict
   where
+    (all_strict, num_strict) = strflags
+
+    is_numeric_type ty
+      = case (getUniDataTyCon_maybe ty) of -- NB: duplicates stuff done above
+         Nothing -> False
+         Just (tycon, _, _)
+           | tycon `is_elem`
+             [intTyCon, integerTyCon,
+              doubleTyCon, floatTyCon,
+              wordTyCon, addrTyCon]
+           -> True
+         _{-something else-} -> False
+      where
+       is_elem = isIn "is_numeric_type"
+
     -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
     -- them) except for a given value in the "i"th position.
 
     -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
     -- them) except for a given value in the "i"th position.
 
index a8fab1a..88303bc 100644 (file)
@@ -3,9 +3,9 @@ interface SaLib where
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import BasicLit(BasicLit)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(Demand, IdInfo, StrictnessInfo)
+import IdInfo(Demand, StrictnessInfo)
 import Maybes(Labda)
 import Outputable(Outputable)
 import PlainCore(PlainCoreExpr(..))
 import Maybes(Labda)
 import Outputable(Outputable)
 import PlainCore(PlainCoreExpr(..))
@@ -15,34 +15,24 @@ import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 data AbsVal   = AbsTop | AbsBot | AbsProd [AbsVal] | AbsFun [Id] (CoreExpr Id Id) AbsValEnv | AbsApproxFun [Demand]
 import UniqFM(UniqFM)
 import Unique(Unique)
 data AbsVal   = AbsTop | AbsBot | AbsProd [AbsVal] | AbsFun [Id] (CoreExpr Id Id) AbsValEnv | AbsApproxFun [Demand]
-data AbsValEnv         {-# GHC_PRAGMA AbsValEnv Bool (UniqFM AbsVal) #-}
+data AbsValEnv 
 type AbsenceEnv = AbsValEnv
 data AnalysisKind   = StrAnal | AbsAnal
 type AbsenceEnv = AbsValEnv
 data AnalysisKind   = StrAnal | AbsAnal
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data CoreExpr a b 
+data Id 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data Demand    {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-}
+data Demand 
 type PlainCoreExpr = CoreExpr Id Id
 type PlainCoreExpr = CoreExpr Id Id
+type StrAnalFlags = (Bool, Bool)
 type StrictEnv = AbsValEnv
 type StrictEnv = AbsValEnv
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniqFM a 
+data Unique 
 absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
 absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "LS" _N_ _N_ #-}
 addOneToAbsValEnv :: AbsValEnv -> Id -> AbsVal -> AbsValEnv
 addOneToAbsValEnv :: AbsValEnv -> Id -> AbsVal -> AbsValEnv
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(LL)LL" {_A_ 4 _U_ 2212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+getStrAnalFlags :: AbsValEnv -> (Bool, Bool)
 growAbsValEnvList :: AbsValEnv -> [(Id, AbsVal)] -> AbsValEnv
 growAbsValEnvList :: AbsValEnv -> [(Id, AbsVal)] -> AbsValEnv
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(LL)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupAbsValEnv :: AbsValEnv -> Id -> Labda AbsVal
 lookupAbsValEnv :: AbsValEnv -> Id -> Labda AbsVal
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(EL)L" {_A_ 3 _U_ 121 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-nullAbsValEnv :: Bool -> AbsValEnv
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
+nullAbsValEnv :: (Bool, Bool) -> AbsValEnv
 instance Outputable AbsVal
 instance Outputable AbsVal
-       {-# GHC_PRAGMA _M_ SaLib {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 instance Text AnalysisKind
 instance Text AnalysisKind
-       {-# GHC_PRAGMA _M_ SaLib {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(AnalysisKind, [Char])]), (Int -> AnalysisKind -> [Char] -> [Char]), ([Char] -> [([AnalysisKind], [Char])]), ([AnalysisKind] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (AnalysisKind), _CONSTM_ Text showsPrec (AnalysisKind), _CONSTM_ Text readList (AnalysisKind), _CONSTM_ Text showList (AnalysisKind)] _N_
-        readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(AnalysisKind, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 873bfbe..52f6650 100644 (file)
@@ -12,6 +12,7 @@ module SaLib (
        AbsVal(..),
        AnalysisKind(..),
        AbsValEnv{-abstract-}, StrictEnv(..), AbsenceEnv(..),
        AbsVal(..),
        AnalysisKind(..),
        AbsValEnv{-abstract-}, StrictEnv(..), AbsenceEnv(..),
+       StrAnalFlags(..), getStrAnalFlags,
        nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
        lookupAbsValEnv,
        absValFromStrictness,
        nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
        lookupAbsValEnv,
        absValFromStrictness,
@@ -94,19 +95,24 @@ pessimistic value---see @absEval@ of a @CoVar@.
 
 \begin{code}
 data AbsValEnv = AbsValEnv StrAnalFlags (IdEnv AbsVal)
 
 \begin{code}
 data AbsValEnv = AbsValEnv StrAnalFlags (IdEnv AbsVal)
-type StrAnalFlags = Bool       -- True <=> make everything strict
+
+type StrAnalFlags
+  = (Bool,     -- True <=> AllStrict flag is set
+     Bool)     -- True <=> NumbersStrict flag is set
 
 type StrictEnv  = AbsValEnv    -- Environment for strictness analysis
 type AbsenceEnv = AbsValEnv    -- Environment for absence analysis
 
 
 type StrictEnv  = AbsValEnv    -- Environment for strictness analysis
 type AbsenceEnv = AbsValEnv    -- Environment for absence analysis
 
-nullAbsValEnv x = AbsValEnv x nullIdEnv
+nullAbsValEnv flags -- this is the one and only way to create AbsValEnvs
+  = AbsValEnv flags nullIdEnv
+
 addOneToAbsValEnv (AbsValEnv x idenv) y z = AbsValEnv x (addOneToIdEnv idenv y z)
 growAbsValEnvList (AbsValEnv x idenv) ys  = AbsValEnv x (growIdEnvList idenv ys)
 
 addOneToAbsValEnv (AbsValEnv x idenv) y z = AbsValEnv x (addOneToIdEnv idenv y z)
 growAbsValEnvList (AbsValEnv x idenv) ys  = AbsValEnv x (growIdEnvList idenv ys)
 
-lookupAbsValEnv (AbsValEnv do_all_strict idenv) y
-  = if do_all_strict
-    then Just AbsBot
-    else lookupIdEnv idenv y
+lookupAbsValEnv (AbsValEnv _ idenv) y
+  = lookupIdEnv idenv y
+
+getStrAnalFlags (AbsValEnv flags _) = flags
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
index a3304ac..6ba8ea2 100644 (file)
@@ -4,8 +4,6 @@ import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
-saTopBinds :: Bool -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
+saTopBinds :: (Bool, Bool) -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 saWwTopBinds :: SplitUniqSupply -> (GlobalSwitch -> Bool) -> [CoreBinding Id Id] -> [CoreBinding Id Id]
 saWwTopBinds :: SplitUniqSupply -> (GlobalSwitch -> Bool) -> [CoreBinding Id Id] -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "LSL" _N_ _N_ #-}
 
 
index d51908a..5e83966 100644 (file)
@@ -88,15 +88,15 @@ saWwTopBinds :: SplitUniqSupply
 
 saWwTopBinds us switch_chker binds
   = let
 
 saWwTopBinds us switch_chker binds
   = let
-       do_all_strict = switch_chker AllStrict
+       strflags = (switch_chker AllStrict, switch_chker NumbersStrict)
 
        -- mark each binder with its strictness
 #ifndef OMIT_STRANAL_STATS
        (binds_w_strictness, sa_stats)
 
        -- mark each binder with its strictness
 #ifndef OMIT_STRANAL_STATS
        (binds_w_strictness, sa_stats)
-         = sa_top_binds do_all_strict binds nullSaStats
+         = sa_top_binds strflags binds nullSaStats
 #else
        binds_w_strictness
 #else
        binds_w_strictness
-         = sa_top_binds do_all_strict binds
+         = sa_top_binds strflags binds
 #endif
     in
     -- possibly show what we decided about strictness...
 #endif
     in
     -- possibly show what we decided about strictness...
@@ -151,18 +151,21 @@ environment which maps @Id@s to their abstract values (i.e., an
 @AbsValEnv@ maps an @Id@ to its @AbsVal@).
 
 \begin{code}
 @AbsValEnv@ maps an @Id@ to its @AbsVal@).
 
 \begin{code}
-saTopBinds   :: Bool -> [PlainCoreBinding] -> [PlainCoreBinding]     -- exported
-sa_top_binds :: Bool -> [PlainCoreBinding] -> SaM [PlainCoreBinding] -- not exported
+saTopBinds   :: StrAnalFlags -> [PlainCoreBinding] -> [PlainCoreBinding]     -- exported
+sa_top_binds :: StrAnalFlags -> [PlainCoreBinding] -> SaM [PlainCoreBinding] -- not exported
 
 
-saTopBinds do_all_strict binds
+saTopBinds strflags binds
 #ifndef OMIT_STRANAL_STATS
 #ifndef OMIT_STRANAL_STATS
-  = fst (sa_top_binds do_all_strict binds nullSaStats)
+  = fst (sa_top_binds strflags binds nullSaStats)
 #else
 #else
-  = sa_top_binds do_all_strict binds
+  = sa_top_binds strflags binds
 #endif
 
 #endif
 
-sa_top_binds do_all_strict binds
-  = do_it (nullAbsValEnv do_all_strict) (nullAbsValEnv False) binds
+sa_top_binds strflags binds
+  = let
+       starting_abs_env = nullAbsValEnv strflags
+    in
+    do_it starting_abs_env starting_abs_env binds
   where
     do_it _    _    [] = returnSa []
     do_it senv aenv (b:bs)
   where
     do_it _    _    [] = returnSa []
     do_it senv aenv (b:bs)
@@ -184,17 +187,22 @@ saTopBind :: StrictEnv -> AbsenceEnv
 saTopBind str_env abs_env (CoNonRec binder rhs)
   = saExpr str_env abs_env rhs         `thenSa` \ new_rhs ->
     let
 saTopBind str_env abs_env (CoNonRec binder rhs)
   = saExpr str_env abs_env rhs         `thenSa` \ new_rhs ->
     let
-       str_rhs    = absEval StrAnal rhs str_env
-       abs_rhs    = absEval AbsAnal rhs abs_env
+       strflags = getStrAnalFlags str_env
+
+       str_rhs = absEval StrAnal rhs str_env
+       abs_rhs = absEval AbsAnal rhs abs_env
 
        widened_str_rhs = widen StrAnal str_rhs
        widened_abs_rhs = widen AbsAnal abs_rhs
                -- The widening above is done for efficiency reasons.
                -- See notes on CoLet case in SaAbsInt.lhs
 
 
        widened_str_rhs = widen StrAnal str_rhs
        widened_abs_rhs = widen AbsAnal abs_rhs
                -- The widening above is done for efficiency reasons.
                -- See notes on CoLet case in SaAbsInt.lhs
 
-       new_binder = addStrictnessInfoToId widened_str_rhs widened_abs_rhs
-                       binder
-                       rhs
+       new_binder
+         = addStrictnessInfoToId
+               strflags
+               widened_str_rhs widened_abs_rhs
+               binder
+               rhs
 
          -- Augment environments with a mapping of the
          -- binder to its abstract values, computed by absEval
 
          -- Augment environments with a mapping of the
          -- binder to its abstract values, computed by absEval
@@ -205,13 +213,15 @@ saTopBind str_env abs_env (CoNonRec binder rhs)
 
 saTopBind str_env abs_env (CoRec pairs)
   = let
 
 saTopBind str_env abs_env (CoRec pairs)
   = let
+       strflags    = getStrAnalFlags str_env
        (binders,rhss) = unzip pairs
        str_rhss    = fixpoint StrAnal binders rhss str_env
        abs_rhss    = fixpoint AbsAnal binders rhss abs_env
                      -- fixpoint returns widened values
        new_str_env = growAbsValEnvList str_env (binders `zip` str_rhss)
        new_abs_env = growAbsValEnvList abs_env (binders `zip` abs_rhss)
        (binders,rhss) = unzip pairs
        str_rhss    = fixpoint StrAnal binders rhss str_env
        abs_rhss    = fixpoint AbsAnal binders rhss abs_env
                      -- fixpoint returns widened values
        new_str_env = growAbsValEnvList str_env (binders `zip` str_rhss)
        new_abs_env = growAbsValEnvList abs_env (binders `zip` abs_rhss)
-       new_binders = zipWith4 addStrictnessInfoToId str_rhss abs_rhss binders rhss
+       new_binders = zipWith4 (addStrictnessInfoToId strflags)
+                               str_rhss abs_rhss binders rhss
     in
     mapSa (saExpr new_str_env new_abs_env) rhss        `thenSa` \ new_rhss ->
     let
     in
     mapSa (saExpr new_str_env new_abs_env) rhss        `thenSa` \ new_rhss ->
     let
@@ -289,6 +299,8 @@ saExpr str_env abs_env (CoLet (CoNonRec binder rhs) body)
   =    -- Analyse the RHS in the environment at hand
     saExpr str_env abs_env rhs  `thenSa` \ new_rhs  ->
     let
   =    -- Analyse the RHS in the environment at hand
     saExpr str_env abs_env rhs  `thenSa` \ new_rhs  ->
     let
+       strflags = getStrAnalFlags str_env
+
        -- Bind this binder to the abstract value of the RHS; analyse
        -- the body of the `let' in the extended environment.
        str_rhs_val     = absEval StrAnal rhs str_env
        -- Bind this binder to the abstract value of the RHS; analyse
        -- the body of the `let' in the extended environment.
        str_rhs_val     = absEval StrAnal rhs str_env
@@ -304,7 +316,8 @@ saExpr str_env abs_env (CoLet (CoNonRec binder rhs) body)
 
        -- Now determine the strictness of this binder; use that info
        -- to record DemandInfo/StrictnessInfo in the binder.
 
        -- Now determine the strictness of this binder; use that info
        -- to record DemandInfo/StrictnessInfo in the binder.
-       new_binder = addStrictnessInfoToId widened_str_rhs widened_abs_rhs
+       new_binder = addStrictnessInfoToId strflags
+                       widened_str_rhs widened_abs_rhs
                        (addDemandInfoToId str_env abs_env body binder)
                        rhs
     in
                        (addDemandInfoToId str_env abs_env body binder)
                        rhs
     in
@@ -314,6 +327,7 @@ saExpr str_env abs_env (CoLet (CoNonRec binder rhs) body)
 
 saExpr str_env abs_env (CoLet (CoRec pairs) body)
   = let
 
 saExpr str_env abs_env (CoLet (CoRec pairs) body)
   = let
+       strflags       = getStrAnalFlags str_env
        (binders,rhss) = unzip pairs
        str_vals       = fixpoint StrAnal binders rhss str_env
        abs_vals       = fixpoint AbsAnal binders rhss abs_env
        (binders,rhss) = unzip pairs
        str_vals       = fixpoint StrAnal binders rhss str_env
        abs_vals       = fixpoint AbsAnal binders rhss abs_env
@@ -336,7 +350,9 @@ saExpr str_env abs_env (CoLet (CoRec pairs) body)
 --                deciding that y is absent, which is plain wrong!
 --             It's much easier simply not to do this.
 
 --                deciding that y is absent, which is plain wrong!
 --             It's much easier simply not to do this.
 
-       improved_binders = zipWith4 addStrictnessInfoToId str_vals abs_vals binders rhss
+       improved_binders = zipWith4 (addStrictnessInfoToId strflags)
+                                   str_vals abs_vals binders rhss
+
        whiter_than_white_binders = launder improved_binders
 
        new_pairs   = whiter_than_white_binders `zip` new_rhss
        whiter_than_white_binders = launder improved_binders
 
        new_pairs   = whiter_than_white_binders `zip` new_rhss
@@ -365,25 +381,27 @@ saDefault str_env abs_env (CoBindDefault bdr rhs)
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-Important note (Sept 93).  @addStrictnessInfoToId@ is used only for let(rec) 
-bound variables, and is use to attach the strictness (not demand) info
-to the binder.  We are careful to restrict this strictness info to the
-lambda-bound arguments which are actually visible, at the top level,
-lest we accidentally lose laziness by eagerly looking for an "extra" argument.
-So we "dig for lambdas" in a rather syntactic way.
+Important note (Sept 93).  @addStrictnessInfoToId@ is used only for
+let(rec) bound variables, and is use to attach the strictness (not
+demand) info to the binder.  We are careful to restrict this
+strictness info to the lambda-bound arguments which are actually
+visible, at the top level, lest we accidentally lose laziness by
+eagerly looking for an "extra" argument.  So we "dig for lambdas" in a
+rather syntactic way.
 
 A better idea might be to have some kind of arity analysis to
 tell how many args could safely be grabbed.
 
 \begin{code}
 addStrictnessInfoToId 
 
 A better idea might be to have some kind of arity analysis to
 tell how many args could safely be grabbed.
 
 \begin{code}
 addStrictnessInfoToId 
-       :: AbsVal               -- Abstract strictness value
+       :: StrAnalFlags
+       -> AbsVal               -- Abstract strictness value
        -> AbsVal               -- Ditto absence
        -> Id                   -- The id
        -> PlainCoreExpr        -- Its RHS
        -> Id                   -- Augmented with strictness
 
        -> AbsVal               -- Ditto absence
        -> Id                   -- The id
        -> PlainCoreExpr        -- Its RHS
        -> Id                   -- Augmented with strictness
 
-addStrictnessInfoToId str_val abs_val binder body
+addStrictnessInfoToId strflags str_val abs_val binder body
   = if isWrapperId binder then
        binder  -- Avoid clobbering existing strictness info 
                -- (and, more importantly, worker info).
   = if isWrapperId binder then
        binder  -- Avoid clobbering existing strictness info 
                -- (and, more importantly, worker info).
@@ -395,7 +413,7 @@ addStrictnessInfoToId str_val abs_val binder body
        case (digForLambdas body) of { (_, lambda_bounds, rhs) ->
         let
                tys        = map getIdUniType lambda_bounds
        case (digForLambdas body) of { (_, lambda_bounds, rhs) ->
         let
                tys        = map getIdUniType lambda_bounds
-               strictness = findStrictness tys str_val abs_val
+               strictness = findStrictness strflags tys str_val abs_val
        in
        binder `addIdStrictness` mkStrictnessInfo strictness Nothing
        }
        in
        binder `addIdStrictness` mkStrictnessInfo strictness Nothing
        }
index 645f9b4..96bbdb6 100644 (file)
@@ -5,5 +5,4 @@ import CoreSyn(CoreBinding)
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 workersAndWrappers :: [CoreBinding Id Id] -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> [CoreBinding Id Id]
 import Id(Id)
 import SplitUniq(SplitUniqSupply)
 workersAndWrappers :: [CoreBinding Id Id] -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> [CoreBinding Id Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 112 _N_ _N_ _N_ _N_ #-}
 
 
index eeca5cb..e56b3cf 100644 (file)
@@ -1,56 +1,39 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface WwLib where
 import BasicLit(BasicLit)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface WwLib where
 import BasicLit(BasicLit)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
 import CmdLineOpts(GlobalSwitch)
 import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr)
 import CostCentre(CostCentre)
-import Id(Id, IdDetails)
-import IdInfo(Demand, IdInfo, StrictnessInfo)
+import Id(Id)
+import IdInfo(Demand, StrictnessInfo)
 import Maybes(Labda, MaybeErr)
 import Maybes(Labda, MaybeErr)
-import NameTypes(ShortName)
 import PlainCore(PlainCoreBinding(..), PlainCoreExpr(..))
 import PrimOps(PrimOp)
 import PlainCore(PlainCoreBinding(..), PlainCoreExpr(..))
 import PrimOps(PrimOp)
-import SplitUniq(SUniqSM(..), SplitUniqSupply, getSUnique, splitUniqSupply)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import SplitUniq(SUniqSM(..), SplitUniqSupply)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniType(UniType)
-import Unique(Unique, mkUniqueGrimily)
+import Unique(Unique)
 infixr 9 `thenWw`
 infixr 9 `thenWw`
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Demand    {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-}
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
+data GlobalSwitch 
+data CoreBinding a b 
+data CoreExpr a b 
+data Id 
+data Demand 
+data MaybeErr a b 
 type PlainCoreBinding = CoreBinding Id Id
 type PlainCoreExpr = CoreExpr Id Id
 type SUniqSM a = SplitUniqSupply -> a
 type PlainCoreBinding = CoreBinding Id Id
 type PlainCoreExpr = CoreExpr Id Id
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data SplitUniqSupply 
+data TyVar 
+data UniType 
+data Unique 
 data WwBinding   = WwLet [CoreBinding Id Id] | WwCase (CoreExpr Id Id -> CoreExpr Id Id)
 type WwM a = SplitUniqSupply -> (GlobalSwitch -> Bool) -> a
 data WwBinding   = WwLet [CoreBinding Id Id] | WwCase (CoreExpr Id Id -> CoreExpr Id Id)
 type WwM a = SplitUniqSupply -> (GlobalSwitch -> Bool) -> a
-getSUnique :: SplitUniqSupply -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> case u1 of { _ALG_ I# (u4 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u4]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getUniqueWw :: SplitUniqSupply -> (GlobalSwitch -> Bool) -> Unique
 getUniqueWw :: SplitUniqSupply -> (GlobalSwitch -> Bool) -> Unique
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _S_ "U(U(P)AA)A" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: SplitUniqSupply) (u1 :: GlobalSwitch -> Bool) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u2 :: Int) (u3 :: SplitUniqSupply) (u4 :: SplitUniqSupply) -> case u2 of { _ALG_ I# (u5 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u5]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 mAX_WORKER_ARGS :: Int
 mAX_WORKER_ARGS :: Int
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [6#] _N_ #-}
 mapWw :: (a -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> b) -> [a] -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> [b]
 mapWw :: (a -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> b) -> [a] -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
-mkUniqueGrimily :: Int# -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_ #-}
 mkWwBodies :: UniType -> [TyVar] -> [Id] -> [Demand] -> SplitUniqSupply -> Labda (Id -> CoreExpr Id Id, CoreExpr Id Id -> CoreExpr Id Id, StrictnessInfo, UniType -> UniType)
 mkWwBodies :: UniType -> [TyVar] -> [Id] -> [Demand] -> SplitUniqSupply -> Labda (Id -> CoreExpr Id Id, CoreExpr Id Id -> CoreExpr Id Id, StrictnessInfo, UniType -> UniType)
-       {-# GHC_PRAGMA _A_ 4 _U_ 12222 _N_ _S_ "LLLS" _N_ _N_ #-}
 returnWw :: a -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> a
 returnWw :: a -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> a
-       {-# GHC_PRAGMA _A_ 3 _U_ 100 _N_ _S_ "SLL" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: SplitUniqSupply) (u3 :: GlobalSwitch -> Bool) -> u1 _N_ #-}
-splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
 thenWw :: (SplitUniqSupply -> (GlobalSwitch -> Bool) -> a) -> (a -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> b) -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> b
 thenWw :: (SplitUniqSupply -> (GlobalSwitch -> Bool) -> a) -> (a -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> b) -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> b
-       {-# GHC_PRAGMA _A_ 4 _U_ 1112 _N_ _S_ "LSSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: SplitUniqSupply -> (GlobalSwitch -> Bool) -> u0) (u3 :: u0 -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> u1) (u4 :: SplitUniqSupply) (u5 :: GlobalSwitch -> Bool) -> case u4 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u6 :: Int) (u7 :: SplitUniqSupply) (u8 :: SplitUniqSupply) -> let {(u9 :: u0) = _APP_  u2 [ u7, u5 ]} in _APP_  u3 [ u9, u8, u5 ]; _NO_DEFLT_ } _N_ #-}
 uniqSMtoWwM :: (SplitUniqSupply -> a) -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> a
 uniqSMtoWwM :: (SplitUniqSupply -> a) -> SplitUniqSupply -> (GlobalSwitch -> Bool) -> a
-       {-# GHC_PRAGMA _A_ 3 _U_ 120 _N_ _S_ "SLA" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: SplitUniqSupply -> u0) (u2 :: SplitUniqSupply) -> _APP_  u1 [ u2 ] _N_} _F_ _IF_ARGS_ 1 3 XXX 2 _/\_ u0 -> \ (u1 :: SplitUniqSupply -> u0) (u2 :: SplitUniqSupply) (u3 :: GlobalSwitch -> Bool) -> _APP_  u1 [ u2 ] _N_ #-}
 
 
index 85802bc..e631036 100644 (file)
@@ -7,23 +7,18 @@ import HsExpr(Expr)
 import HsLit(Literal)
 import HsMatches(GRHSsAndBinds, Match)
 import HsPat(TypecheckedPat)
 import HsLit(Literal)
 import HsMatches(GRHSsAndBinds, Match)
 import HsPat(TypecheckedPat)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Inst(Inst)
 import Inst(Inst)
-import Maybes(Labda)
-import PreludeGlaST(_MutableArray)
 import Pretty(PprStyle, PrettyRep)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TyVar(TyVar)
 import UniType(UniType)
 import Pretty(PprStyle, PrettyRep)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TyVar(TyVar)
 import UniType(UniType)
-import Unique(Unique)
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data MonoBinds a b     {-# GHC_PRAGMA EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc #-}
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
+data Binds a b 
+data MonoBinds a b 
+data TypecheckedPat 
+data Id 
+data Subst 
 applyTcSubstToBinds :: Binds Id TypecheckedPat -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Binds Id TypecheckedPat, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToBinds :: Binds Id TypecheckedPat -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Binds Id TypecheckedPat, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2222222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index bf1fdf4..737bb61 100644 (file)
@@ -1,32 +1,27 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Disambig where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Disambig where
 import Bag(Bag)
-import CharSeq(CSeq)
 import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import Id(Id)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import Id(Id)
 import Inst(Inst, InstOrigin, OverloadedLit)
-import Maybes(Labda)
-import PreludeGlaST(_MutableArray)
-import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 import Unique(Unique, UniqueSupply)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 import Unique(Unique, UniqueSupply)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Bag a 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Inst 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
-data TcResult a        {-# GHC_PRAGMA TcSucceeded a Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) | TcFailed Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data PrettyRep 
+data SrcLoc 
+data Subst 
+data TcResult a 
+data UniqueSupply 
 disambiguateDicts :: [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 disambiguateDicts :: [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 
 
index ce21175..6d6f8b3 100644 (file)
@@ -11,14 +11,12 @@ import HsBinds(Bind, Binds, MonoBinds, Sig)
 import HsExpr(Expr)
 import HsLit(Literal)
 import HsPat(TypecheckedPat)
 import HsExpr(Expr)
 import HsLit(Literal)
 import HsPat(TypecheckedPat)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import LIE(LIE)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import LIE(LIE)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
-import PreludeGlaST(_MutableArray)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import SimplEnv(UnfoldingGuidance)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import SimplEnv(UnfoldingGuidance)
@@ -27,32 +25,29 @@ import SrcLoc(SrcLoc)
 import Subst(Subst)
 import TcMonad(TcResult)
 import TyCon(TyCon)
 import Subst(Subst)
 import TcMonad(TcResult)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniType(UniType)
-import UniqFM(UniqFM)
 import Unique(Unique, UniqueSupply)
 import Unique(Unique, UniqueSupply)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data E         {-# GHC_PRAGMA MkE (UniqFM TyCon) (UniqFM Id) (UniqFM Id) (UniqFM Class) #-}
+data Bag a 
+data E 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data Bind a b  {-# GHC_PRAGMA EmptyBind | NonRecBind (MonoBinds a b) | RecBind (MonoBinds a b) #-}
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data LIE       {-# GHC_PRAGMA MkLIE [Inst] #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Bind a b 
+data Binds a b 
+data TypecheckedPat 
+data Id 
+data Inst 
+data LIE 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
+data PrettyRep 
 data SignatureInfo   = TySigInfo Id [TyVar] [Inst] UniType SrcLoc | ValSpecInfo Name UniType (Labda Name) SrcLoc | ValInlineInfo Name UnfoldingGuidance SrcLoc | ValDeforestInfo Name SrcLoc | ValMagicUnfoldingInfo Name _PackedString SrcLoc
 data SignatureInfo   = TySigInfo Id [TyVar] [Inst] UniType SrcLoc | ValSpecInfo Name UniType (Labda Name) SrcLoc | ValInlineInfo Name UnfoldingGuidance SrcLoc | ValDeforestInfo Name SrcLoc | ValMagicUnfoldingInfo Name _PackedString SrcLoc
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
-data TcResult a        {-# GHC_PRAGMA TcSucceeded a Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) | TcFailed Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data SrcLoc 
+data Subst 
+data TcResult a 
+data TyVar 
+data UniType 
+data UniqueSupply 
 checkSigTyVars :: [TyVar] -> [TyVar] -> UniType -> UniType -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [TyVar]
 checkSigTyVars :: [TyVar] -> [TyVar] -> UniType -> UniType -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [TyVar]
-       {-# GHC_PRAGMA _A_ 11 _U_ 22222222122 _N_ _S_ "LSLSLLLLU(AAS)LL" _N_ _N_ #-}
 genBinds :: Bool -> E -> Bind Id TypecheckedPat -> LIE -> [(Name, Id)] -> [SignatureInfo] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Binds Id TypecheckedPat, LIE, [(Name, Id)])
 genBinds :: Bool -> E -> Bind Id TypecheckedPat -> LIE -> [(Name, Id)] -> [SignatureInfo] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Binds Id TypecheckedPat, LIE, [(Name, Id)])
-       {-# GHC_PRAGMA _A_ 12 _U_ 212112222122 _N_ _S_ "LU(AASA)LLLSLLLU(AAS)LL" _N_ _N_ #-}
 
 
index 6f67f4b..121b12f 100644 (file)
@@ -14,7 +14,5 @@ import Subst(Subst)
 import TyVar(TyVar)
 import UniType(UniType)
 specId :: Id -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((Expr Id TypecheckedPat, LIE, UniType), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 import TyVar(TyVar)
 import UniType(UniType)
 specId :: Id -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((Expr Id TypecheckedPat, LIE, UniType), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002222 _N_ _S_ "U(LSLL)AALLLL" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 specTy :: InstOrigin -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (([TyVar], [Inst], UniType), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 specTy :: InstOrigin -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (([TyVar], [Inst], UniType), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 22002120 _N_ _N_ _N_ _N_ #-}
 
 
index d83f503..137452c 100644 (file)
@@ -3,34 +3,23 @@ interface Subst where
 import Bag(Bag)
 import Class(Class)
 import Maybes(Labda)
 import Bag(Bag)
 import Class(Class)
 import Maybes(Labda)
-import NameTypes(ShortName)
 import PreludeGlaST(_MutableArray)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
 import PreludeGlaST(_MutableArray)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
+data Subst 
 data SubstResult   = SubstOK | OccursCheck TyVar UniType | AlreadyBound UniType
 data SubstResult   = SubstOK | OccursCheck TyVar UniType | AlreadyBound UniType
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
+data TyVar 
+data UniType 
 applySubstToThetaTy :: Subst -> [(Class, UniType)] -> (Subst, [(Class, UniType)])
 applySubstToThetaTy :: Subst -> [(Class, UniType)] -> (Subst, [(Class, UniType)])
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 applySubstToTy :: Subst -> UniType -> (Subst, UniType)
 applySubstToTy :: Subst -> UniType -> (Subst, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 applySubstToTyVar :: Subst -> TyVar -> (Subst, UniType)
 applySubstToTyVar :: Subst -> TyVar -> (Subst, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 combineSubstUndos :: Subst -> Subst
 combineSubstUndos :: Subst -> Subst
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSLL)" {_A_ 4 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 extendSubst :: TyVar -> UniType -> Subst -> (Subst, SubstResult)
 extendSubst :: TyVar -> UniType -> Subst -> (Subst, SubstResult)
-       {-# GHC_PRAGMA _A_ 2 _U_ 221 _N_ _N_ _N_ _N_ #-}
 getSubstTyVarUnique :: Subst -> (Subst, Unique)
 getSubstTyVarUnique :: Subst -> (Subst, Unique)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(U(LU(P))P)LLU(P))" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSubstTyVarUniques :: Int -> Subst -> (Subst, [Unique])
 getSubstTyVarUniques :: Int -> Subst -> (Subst, [Unique])
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(U(U(LU(P))P)LLU(P))" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkEmptySubst :: Int -> Subst
 mkEmptySubst :: Int -> Subst
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 pushSubstUndos :: Subst -> Subst
 pushSubstUndos :: Subst -> Subst
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLLL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 undoSubstUndos :: Subst -> Subst
 undoSubstUndos :: Subst -> Subst
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSLL)" {_A_ 4 _U_ 2112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index a17da4f..aac9670 100644 (file)
@@ -15,7 +15,5 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcLocalBindsAndThen :: E -> (Binds Id TypecheckedPat -> a -> a) -> Binds Name (InPat Name) -> (E -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcLocalBindsAndThen :: E -> (Binds Id TypecheckedPat -> a -> a) -> Binds Name (InPat Name) -> (E -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2212222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 tcTopBindsAndThen :: E -> (Binds Id TypecheckedPat -> a -> a) -> Binds Name (InPat Name) -> (E -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)
 tcTopBindsAndThen :: E -> (Binds Id TypecheckedPat -> a -> a) -> Binds Name (InPat Name) -> (E -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (a, LIE, b)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2212222222 _N_ _S_ "LLSL" _N_ _N_ #-}
 
 
index dcf17a5..7fd45d6 100644 (file)
@@ -19,9 +19,7 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import TcMonad(TcResult)
 import UniType(UniType)
 import UniqFM(UniqFM)
-data ClassInfo         {-# GHC_PRAGMA ClassInfo Class (MonoBinds Name (InPat Name)) #-}
+data ClassInfo 
 tcClassDecls1 :: E -> (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) -> [ClassDecl Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([ClassInfo], UniqFM Class, [(Name, Id)])
 tcClassDecls1 :: E -> (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) -> [ClassDecl Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([ClassInfo], UniqFM Class, [(Name, Id)])
-       {-# GHC_PRAGMA _A_ 9 _U_ 221222122 _N_ _S_ "LLSLLLLLL" _N_ _N_ #-}
 tcClassDecls2 :: E -> [ClassInfo] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((LIE, Binds Id TypecheckedPat), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 tcClassDecls2 :: E -> [ClassInfo] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((LIE, Binds Id TypecheckedPat), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 0452110..93d490c 100644 (file)
@@ -16,5 +16,4 @@ import TyVar(TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcClassSigs :: E -> UniqFM UniType -> Class -> (ClassOp -> SpecEnv) -> TyVarTemplate -> [Sig Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult ([ClassOp], [(Name, Id)], [Id], [Id])
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcClassSigs :: E -> UniqFM UniType -> Class -> (ClassOp -> SpecEnv) -> TyVarTemplate -> [Sig Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult ([ClassOp], [(Name, Id)], [Id], [Id])
-       {-# GHC_PRAGMA _A_ 6 _U_ 2222212122 _N_ _S_ "LLLLLS" _N_ _N_ #-}
 
 
index 83a170c..fe83277 100644 (file)
@@ -15,5 +15,4 @@ import TyVar(TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcConDecls :: UniqFM TyCon -> UniqFM UniType -> TyCon -> [TyVarTemplate] -> SpecEnv -> [ConDecl Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [(Name, Id)]
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcConDecls :: UniqFM TyCon -> UniqFM UniType -> TyCon -> [TyVarTemplate] -> SpecEnv -> [ConDecl Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [(Name, Id)]
-       {-# GHC_PRAGMA _A_ 10 _U_ 2222212122 _N_ _S_ "LLLLLSLLLL" _N_ _N_ #-}
 
 
index 34f6b50..32583bd 100644 (file)
@@ -12,5 +12,4 @@ import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcContext :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> [(Name, Name)] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [(Class, UniType)]
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcContext :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> [(Name, Name)] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [(Class, UniType)]
-       {-# GHC_PRAGMA _A_ 4 _U_ 22212222 _N_ _S_ "LLLS" _N_ _N_ #-}
 
 
index 03fe2bb..5566ab7 100644 (file)
@@ -12,5 +12,4 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcDefaults :: E -> [DefaultDecl Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [UniType]
 import TcMonad(TcResult)
 import UniType(UniType)
 tcDefaults :: E -> [DefaultDecl Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [UniType]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index f37c444..e194406 100644 (file)
@@ -23,11 +23,7 @@ import UniqFM(UniqFM)
 type DerivEqn = (Class, TyCon, [TyVar], [(Class, UniType)])
 data TagThingWanted   = GenCon2Tag | GenTag2Con | GenMaxTag
 con2tag_PN :: TyCon -> ProtoName
 type DerivEqn = (Class, TyCon, [TyVar], [(Class, UniType)])
 data TagThingWanted   = GenCon2Tag | GenTag2Con | GenMaxTag
 con2tag_PN :: TyCon -> ProtoName
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 maxtag_PN :: TyCon -> ProtoName
 maxtag_PN :: TyCon -> ProtoName
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 tag2con_PN :: TyCon -> ProtoName
 tag2con_PN :: TyCon -> ProtoName
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 tcDeriving :: _PackedString -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> Bag InstInfo -> UniqFM TyCon -> [FixityDecl Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Bag InstInfo, Binds Name (InPat Name), PprStyle -> Int -> Bool -> PrettyRep)
 tcDeriving :: _PackedString -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> Bag InstInfo -> UniqFM TyCon -> [FixityDecl Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Bag InstInfo, Binds Name (InPat Name), PprStyle -> Int -> Bool -> PrettyRep)
-       {-# GHC_PRAGMA _A_ 5 _U_ 22220222222 _N_ _S_ "LLLSA" {_A_ 4 _U_ 2222222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 40007d9..37e72fe 100644 (file)
@@ -588,7 +588,7 @@ gen_inst_info modname fixities deriver_name_funs
     if not (isEmptyBag errs) then
        pprPanic "gen_inst_info:renamer errs!\n" (ppAbove (pprBagOfErrors PprDebug errs) (ppr PprDebug proto_mbinds))
     else
     if not (isEmptyBag errs) then
        pprPanic "gen_inst_info:renamer errs!\n" (ppAbove (pprBagOfErrors PprDebug errs) (ppr PprDebug proto_mbinds))
     else
-    --pprTrace "derived binds:" (ppr PprDebug proto_mbinds) (
+--  pprTrace "derived binds:" (ppr PprDebug proto_mbinds) $
 
        -- All done
     let 
 
        -- All done
     let 
@@ -599,7 +599,6 @@ gen_inst_info modname fixities deriver_name_funs
                       -- and here comes the main point...
                       (if from_here then mbinds else EmptyMonoBinds)
                       from_here modname locn [])
                       -- and here comes the main point...
                       (if from_here then mbinds else EmptyMonoBinds)
                       from_here modname locn [])
-    --)
   where
     clas_key = getClassKey clas
     clas_Name
   where
     clas_key = getClassKey clas
     clas_Name
index 46fe724..cdef026 100644 (file)
@@ -15,5 +15,4 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcExpr :: E -> Expr Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Expr Id TypecheckedPat, LIE, UniType)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcExpr :: E -> Expr Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Expr Id TypecheckedPat, LIE, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 6b73340..15b6729 100644 (file)
@@ -35,12 +35,7 @@ import AbsUniType
 import E
 import CE              ( lookupCE )
 
 import E
 import CE              ( lookupCE )
 
-#ifndef DPH
-import Errors          ( badMatchErr, UnifyErrContext(..) )
-#else
-import Errors          ( badMatchErr, podCompLhsError, UnifyErrContext(..) )
-#endif {- Data Parallel Haskell -}
-
+import Errors
 import GenSpecEtc      ( checkSigTyVars )
 import Id              ( mkInstId, getIdUniType, Id )
 import Inst
 import GenSpecEtc      ( checkSigTyVars )
 import Id              ( mkInstId, getIdUniType, Id )
 import Inst
@@ -79,8 +74,8 @@ tcExpr e (Var name)
        -- isTauTy is over-paranoid, because we don't expect
        -- any submerged polymorphism other than rank-2 polymorphism
 
        -- isTauTy is over-paranoid, because we don't expect
        -- any submerged polymorphism other than rank-2 polymorphism
 
-    checkTc (not (isTauTy ty)) (error "tcExpr Var: MISSING ERROR MESSAGE") -- ToDo:
-                                       `thenTc_`
+    getSrcLocTc                          `thenNF_Tc` \ loc ->
+    checkTc (not (isTauTy ty)) (lurkingRank2Err name ty loc) `thenTc_`
  
     returnTc stuff
 \end{code}
  
     returnTc stuff
 \end{code}
@@ -563,14 +558,15 @@ tcApp build_result_expression e orig_fun arg_exprs
        unify_args (arg_no+1) (App fun arg'') (lie `plusLIE` lie_arg') args arg_tys fun_res_ty
 
     unify_args arg_no fun lie [] arg_tys fun_res_ty
        unify_args (arg_no+1) (App fun arg'') (lie `plusLIE` lie_arg') args arg_tys fun_res_ty
 
     unify_args arg_no fun lie [] arg_tys fun_res_ty
-      = -- We've run out of actual arguments Check that none of
-       -- arg_tys has a for-all at the top For example, "build" on
+      = -- We've run out of actual arguments.  Check that none of
+       -- arg_tys has a for-all at the top. For example, "build" on
        -- its own is no good; it must be applied to something.
        let
           result_ty = glueTyArgs arg_tys fun_res_ty
        in
        -- its own is no good; it must be applied to something.
        let
           result_ty = glueTyArgs arg_tys fun_res_ty
        in
+       getSrcLocTc     `thenNF_Tc` \ loc ->
        checkTc (not (isTauTy result_ty))
        checkTc (not (isTauTy result_ty))
-               (error "ERROR: 2 rank failure (NEED ERROR MSG [ToDo])") `thenTc_` 
+               (underAppliedTyErr result_ty loc) `thenTc_`
        returnTc (fun, lie, result_ty)
 
     -- When we run out of arg_tys we go back to unify_fun in the hope
        returnTc (fun, lie, result_ty)
 
     -- When we run out of arg_tys we go back to unify_fun in the hope
index 09a63e8..35dc01d 100644 (file)
@@ -15,5 +15,4 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcGRHSsAndBinds :: E -> GRHSsAndBinds Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (GRHSsAndBinds Id TypecheckedPat, LIE, UniType)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcGRHSsAndBinds :: E -> GRHSsAndBinds Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (GRHSsAndBinds Id TypecheckedPat, LIE, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 5ff491f..ea99ed7 100644 (file)
@@ -9,87 +9,45 @@ import ProtoName(ProtoName)
 import TcDeriv(TagThingWanted)
 import TyCon(TyCon)
 a_Expr :: Expr ProtoName a
 import TcDeriv(TagThingWanted)
 import TyCon(TyCon)
 a_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv a_PN] _N_ #-}
 a_PN :: ProtoName
 a_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 a_Pat :: InPat ProtoName
 a_Pat :: InPat ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ HsPat VarPatIn [ProtoName] [_ORIG_ TcGenDeriv a_PN] _N_ #-}
 ah_PN :: ProtoName
 ah_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 b_Expr :: Expr ProtoName a
 b_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv b_PN] _N_ #-}
 b_PN :: ProtoName
 b_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 b_Pat :: InPat ProtoName
 b_Pat :: InPat ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ HsPat VarPatIn [ProtoName] [_ORIG_ TcGenDeriv b_PN] _N_ #-}
 bh_PN :: ProtoName
 bh_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 c_Expr :: Expr ProtoName a
 c_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv c_PN] _N_ #-}
 c_PN :: ProtoName
 c_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 c_Pat :: InPat ProtoName
 c_Pat :: InPat ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ HsPat VarPatIn [ProtoName] [_ORIG_ TcGenDeriv c_PN] _N_ #-}
 ch_PN :: ProtoName
 ch_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cmp_eq_PN :: ProtoName
 cmp_eq_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 d_Expr :: Expr ProtoName a
 d_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv d_PN] _N_ #-}
 d_PN :: ProtoName
 d_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 d_Pat :: InPat ProtoName
 d_Pat :: InPat ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ HsPat VarPatIn [ProtoName] [_ORIG_ TcGenDeriv d_PN] _N_ #-}
 dh_PN :: ProtoName
 dh_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqH_PN :: ProtoName
 eqH_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eq_TAG_Expr :: Expr ProtoName a
 eq_TAG_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv eq_TAG_PN] _N_ #-}
 eq_TAG_PN :: ProtoName
 eq_TAG_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 error_PN :: ProtoName
 error_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 false_Expr :: Expr ProtoName a
 false_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv false_PN] _N_ #-}
 false_PN :: ProtoName
 false_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 geH_PN :: ProtoName
 geH_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gen_Binary_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
 gen_Binary_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (MonoBinds ProtoName (InPat ProtoName)) } [ _NOREP_S_ "gen_Binary_binds" ] _N_ #-}
 gen_Enum_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
 gen_Enum_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 gen_Eq_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
 gen_Eq_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-}
 gen_Ix_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
 gen_Ix_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-}
 gen_Ord_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
 gen_Ord_binds :: TyCon -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-}
 gen_Text_binds :: [FixityDecl Name] -> Bool -> TyCon -> MonoBinds ProtoName (InPat ProtoName)
 gen_Text_binds :: [FixityDecl Name] -> Bool -> TyCon -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 gen_tag_n_con_monobind :: (ProtoName, Name, TyCon, TagThingWanted) -> MonoBinds ProtoName (InPat ProtoName)
 gen_tag_n_con_monobind :: (ProtoName, Name, TyCon, TagThingWanted) -> MonoBinds ProtoName (InPat ProtoName)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LALE)" {_A_ 3 _U_ 211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 gt_TAG_Expr :: Expr ProtoName a
 gt_TAG_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv gt_TAG_PN] _N_ #-}
 gt_TAG_PN :: ProtoName
 gt_TAG_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 leH_PN :: ProtoName
 leH_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 ltH_PN :: ProtoName
 ltH_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 lt_TAG_Expr :: Expr ProtoName a
 lt_TAG_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv lt_TAG_PN] _N_ #-}
 lt_TAG_PN :: ProtoName
 lt_TAG_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 minusH_PN :: ProtoName
 minusH_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mkInt_PN :: ProtoName
 mkInt_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 rangeSize_PN :: ProtoName
 rangeSize_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 true_Expr :: Expr ProtoName a
 true_Expr :: Expr ProtoName a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _!_ _ORIG_ HsExpr Var [ProtoName, u0] [_ORIG_ TcGenDeriv true_PN] _N_ #-}
 true_PN :: ProtoName
 true_PN :: ProtoName
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 
 
index c1f9b64..63641d8 100644 (file)
@@ -665,10 +665,11 @@ gen_Text_binds fixities omit_derived_read tycon
                data_con_PN = Prel (WiredInVal data_con)
                bs_needed   = take (getDataConArity data_con) bs_PNs
                con_pat     = ConPatIn data_con_PN (map VarPatIn bs_needed)
                data_con_PN = Prel (WiredInVal data_con)
                bs_needed   = take (getDataConArity data_con) bs_PNs
                con_pat     = ConPatIn data_con_PN (map VarPatIn bs_needed)
+               is_nullary_con = isNullaryDataCon data_con
 
                show_con
                  = let (mod, nm)   = getOrigName data_con
 
                show_con
                  = let (mod, nm)   = getOrigName data_con
-                       space_maybe = if isNullaryDataCon data_con then _NIL_ else SLIT(" ")
+                       space_maybe = if is_nullary_con then _NIL_ else SLIT(" ")
                    in
                        App (Var showString_PN) (Lit (StringLit (nm _APPEND_ space_maybe)))
 
                    in
                        App (Var showString_PN) (Lit (StringLit (nm _APPEND_ space_maybe)))
 
@@ -678,9 +679,13 @@ gen_Text_binds fixities omit_derived_read tycon
                  = [ App (App (Var showsPrec_PN) (Lit (IntLit 10))) (Var b)
                  | b <- bs_needed ]
            in
                  = [ App (App (Var showsPrec_PN) (Lit (IntLit 10))) (Var b)
                  | b <- bs_needed ]
            in
-           ([a_Pat, con_pat],
-               showParen_Expr (OpApp a_Expr (Var ge_PN) (Lit (IntLit 10)))
-                              (nested_compose_Expr show_thingies))
+           if is_nullary_con then  -- skip the showParen junk...
+               ASSERT(null bs_needed)
+               ([a_Pat, con_pat], show_con)
+           else
+               ([a_Pat, con_pat],
+                   showParen_Expr (OpApp a_Expr (Var ge_PN) (Lit (IntLit 10)))
+                                  (nested_compose_Expr show_thingies))
          where
            spacified []     = []
            spacified [x]    = [x]
          where
            spacified []     = []
            spacified [x]    = [x]
@@ -692,11 +697,9 @@ gen_Text_binds fixities omit_derived_read tycon
            read_con_comprehensions
              = map read_con (getTyConDataCons tycon)
        in
            read_con_comprehensions
              = map read_con (getTyConDataCons tycon)
        in
-       mk_easy_FunMonoBind readsPrec_PN [a_Pat] [] (
-          readParen_Expr (OpApp a_Expr (Var gt_PN) (Lit (IntLit 9))) (
-          Lam (mk_easy_Match [b_Pat] []  (
+       mk_easy_FunMonoBind readsPrec_PN [a_Pat, b_Pat] [] (
              foldl1 append_Expr read_con_comprehensions
              foldl1 append_Expr read_con_comprehensions
-       ))))
+       )
       where
        read_con data_con   -- note: "b" is the string being "read"
          = let
       where
        read_con data_con   -- note: "b" is the string being "read"
          = let
@@ -705,17 +708,28 @@ gen_Text_binds fixities omit_derived_read tycon
                as_needed   = take (getDataConArity data_con) as_PNs
                bs_needed   = take (getDataConArity data_con) bs_PNs
                con_expr    = foldl App (Var data_con_PN) (map Var as_needed)
                as_needed   = take (getDataConArity data_con) as_PNs
                bs_needed   = take (getDataConArity data_con) bs_PNs
                con_expr    = foldl App (Var data_con_PN) (map Var as_needed)
+               is_nullary_con = isNullaryDataCon data_con
 
                con_qual
                  = GeneratorQual
 
                con_qual
                  = GeneratorQual
-                     (TuplePatIn [LitPatIn (StringLit data_con_str), c_Pat])
-                     (App (Var lex_PN) b_Expr)
+                     (TuplePatIn [LitPatIn (StringLit data_con_str), d_Pat])
+                     (App (Var lex_PN) c_Expr)
+
+               field_quals = snd (mapAccumL mk_qual d_Expr (as_needed `zip` bs_needed))
 
 
-               field_quals = snd (mapAccumL mk_qual c_Expr (as_needed `zip` bs_needed))
+               read_paren_arg
+                 = if is_nullary_con then -- must be False (parens are surely optional)
+                      false_Expr
+                   else -- parens depend on precedence...
+                      OpApp a_Expr (Var gt_PN) (Lit (IntLit 9))
            in
            in
-           ListComp (ExplicitTuple [con_expr,
-                       if null bs_needed then c_Expr else Var (last bs_needed)])
-             (con_qual : field_quals)
+           App (
+             readParen_Expr read_paren_arg (
+                Lam (mk_easy_Match [c_Pat] []  (
+                  ListComp (ExplicitTuple [con_expr,
+                           if null bs_needed then d_Expr else Var (last bs_needed)])
+                   (con_qual : field_quals)))
+           )) (Var b_PN)
          where
            mk_qual draw_from (con_field, str_left)
              = (Var str_left,  -- what to draw from down the line...
          where
            mk_qual draw_from (con_field, str_left)
              = (Var str_left,  -- what to draw from down the line...
index 5bd2564..4f71aba 100644 (file)
@@ -11,5 +11,4 @@ import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TcMonad(Baby_TcResult)
 tcInterfaceSigs :: E -> [Sig Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [(Name, Id)]
 import SrcLoc(SrcLoc)
 import TcMonad(Baby_TcResult)
 tcInterfaceSigs :: E -> [Sig Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [(Name, Id)]
-       {-# GHC_PRAGMA _A_ 6 _U_ 212122 _N_ _S_ "LSLLLL" _N_ _N_ #-}
 
 
index 60a805e..2c55829 100644 (file)
@@ -27,15 +27,9 @@ import UniType(UniType)
 import UniqFM(UniqFM)
 data InstInfo   = InstInfo Class [TyVarTemplate] UniType [(Class, UniType)] [(Class, UniType)] Id [Id] (MonoBinds Name (InPat Name)) Bool _PackedString SrcLoc [Sig Name]
 buildInstanceEnvs :: Bag InstInfo -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv))
 import UniqFM(UniqFM)
 data InstInfo   = InstInfo Class [TyVarTemplate] UniType [(Class, UniType)] [(Class, UniType)] Id [Id] (MonoBinds Name (InPat Name)) Bool _PackedString SrcLoc [Sig Name]
 buildInstanceEnvs :: Bag InstInfo -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _N_ _N_ #-}
 mkInstanceRelatedIds :: E -> Bool -> InstancePragmas Name -> a -> Class -> [TyVarTemplate] -> UniType -> [(Class, UniType)] -> [Sig Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Id, [(Class, UniType)], [Id])
 mkInstanceRelatedIds :: E -> Bool -> InstancePragmas Name -> a -> Class -> [TyVarTemplate] -> UniType -> [(Class, UniType)] -> [Sig Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Id, [(Class, UniType)], [Id])
-       {-# GHC_PRAGMA _A_ 15 _U_ 222022221222122 _N_ _S_ "LLSALSLLLLLLU(ALS)LL" {_A_ 14 _U_ 22222221222122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 processInstBinds :: E -> [TyVar] -> (Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Expr Id TypecheckedPat, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [TyVar] -> [Inst] -> [Id] -> MonoBinds Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], MonoBinds Id TypecheckedPat)
 processInstBinds :: E -> [TyVar] -> (Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Expr Id TypecheckedPat, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [TyVar] -> [Inst] -> [Id] -> MonoBinds Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], MonoBinds Id TypecheckedPat)
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222222122 _N_ _S_ "LLLLLLS" _N_ _N_ #-}
 tcInstDecls1 :: E -> UniqFM Class -> UniqFM TyCon -> [InstDecl Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Bag InstInfo, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 tcInstDecls1 :: E -> UniqFM Class -> UniqFM TyCon -> [InstDecl Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Bag InstInfo, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2221222222 _N_ _S_ "LLLS" _N_ _N_ #-}
 tcInstDecls2 :: E -> Bag InstInfo -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((LIE, Binds Id TypecheckedPat), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 tcInstDecls2 :: E -> Bag InstInfo -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((LIE, Binds Id TypecheckedPat), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 tcSpecInstSigs :: E -> UniqFM Class -> UniqFM TyCon -> Bag InstInfo -> [SpecialisedInstanceSig Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Bag InstInfo)
 tcSpecInstSigs :: E -> UniqFM Class -> UniqFM TyCon -> Bag InstInfo -> [SpecialisedInstanceSig Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Bag InstInfo)
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222222222 _N_ _S_ "LLLLS" _N_ _N_ #-}
 
 
index d286122..045238c 100644 (file)
@@ -15,9 +15,6 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcMatch :: E -> Match Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Match Id TypecheckedPat, LIE, UniType)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcMatch :: E -> Match Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Match Id TypecheckedPat, LIE, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 tcMatchesCase :: E -> [Match Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Match Id TypecheckedPat], LIE, UniType)
 tcMatchesCase :: E -> [Match Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Match Id TypecheckedPat], LIE, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222122 _N_ _S_ "LS" _N_ _N_ #-}
 tcMatchesFun :: E -> Name -> UniType -> [Match Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Match Id TypecheckedPat], LIE)
 tcMatchesFun :: E -> Name -> UniType -> [Match Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Match Id TypecheckedPat], LIE)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222222222 _N_ _S_ "LLLS" _N_ _N_ #-}
 
 
index 380e399..bb41c1d 100644 (file)
@@ -17,13 +17,11 @@ import HsLit(Literal)
 import HsMatches(Match)
 import HsPat(InPat, RenamedPat(..), TypecheckedPat)
 import HsTypes(PolyType)
 import HsMatches(Match)
 import HsPat(InPat, RenamedPat(..), TypecheckedPat)
 import HsTypes(PolyType)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Inst(Inst, InstOrigin, OverloadedLit)
+import Id(Id)
+import Inst(Inst)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
-import PreludeGlaST(_MutableArray)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
@@ -38,31 +36,30 @@ import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Module a b 
+data Bag a 
 type CE = UniqFM Class
 type CE = UniqFM Class
-data E         {-# GHC_PRAGMA MkE (UniqFM TyCon) (UniqFM Id) (UniqFM Id) (UniqFM Class) #-}
+data E 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data FixityDecl a      {-# GHC_PRAGMA InfixL a Int | InfixR a Int | InfixN a Int #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data Binds a b 
+data FixityDecl a 
+data Expr a b 
+data InPat a 
 type RenamedPat = InPat Name
 type RenamedPat = InPat Name
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data TypecheckedPat 
+data Id 
+data Inst 
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
+data PrettyRep 
+data ProtoName 
+data SrcLoc 
+data Subst 
 type TCE = UniqFM TyCon
 type TCE = UniqFM TyCon
-data InstInfo  {-# GHC_PRAGMA InstInfo Class [TyVarTemplate] UniType [(Class, UniType)] [(Class, UniType)] Id [Id] (MonoBinds Name (InPat Name)) Bool _PackedString SrcLoc [Sig Name] #-}
-data TcResult a        {-# GHC_PRAGMA TcSucceeded a Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) | TcFailed Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data InstInfo 
+data TcResult a 
+data UniqFM a 
 tcModule :: E -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> Module Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ((Binds Id TypecheckedPat, Binds Id TypecheckedPat, Binds Id TypecheckedPat, [(Inst, Expr Id TypecheckedPat)]), ([FixityDecl Name], [Id], UniqFM Class, UniqFM TyCon, Bag InstInfo), FiniteMap TyCon [[Labda UniType]], E, PprStyle -> Int -> Bool -> PrettyRep)
 tcModule :: E -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> Module Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ((Binds Id TypecheckedPat, Binds Id TypecheckedPat, Binds Id TypecheckedPat, [(Inst, Expr Id TypecheckedPat)]), ([FixityDecl Name], [Id], UniqFM Class, UniqFM TyCon, Bag InstInfo), FiniteMap TyCon [[Labda UniType]], E, PprStyle -> Int -> Bool -> PrettyRep)
-       {-# GHC_PRAGMA _A_ 9 _U_ 221222120 _N_ _S_ "LLU(LAALSLLLLLLLL)LLLU(ALL)LA" {_A_ 8 _U_ 22122212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 1b78564..b90935d 100644 (file)
@@ -2,7 +2,7 @@
 interface TcMonad where
 import Bag(Bag)
 import CharSeq(CSeq)
 interface TcMonad where
 import Bag(Bag)
 import CharSeq(CSeq)
-import Class(Class, ClassOp)
+import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import ErrsTc(UnifyErrContext)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import ErrsTc(UnifyErrContext)
@@ -13,206 +13,125 @@ import HsLit(Literal)
 import HsMatches(GRHS, GRHSsAndBinds, Match)
 import HsPat(InPat, TypecheckedPat)
 import HsTypes(PolyType)
 import HsMatches(GRHS, GRHSsAndBinds, Match)
 import HsPat(InPat, TypecheckedPat)
 import HsTypes(PolyType)
-import Id(Id, IdDetails, applySubstToId)
-import IdInfo(ArgUsageInfo, ArityInfo, DeforestInfo, DemandInfo, FBTypeInfo, IdInfo, SpecEnv, StrictnessInfo, UpdateInfo)
-import Inst(Inst, InstOrigin, OverloadedLit, applySubstToInst)
-import InstEnv(InstTemplate)
+import Id(Id)
+import IdInfo(IdInfo)
+import Inst(Inst)
 import Maybes(Labda, MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Maybes(Labda, MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
-import PreludeGlaST(_MutableArray)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
-import PrimKind(PrimKind)
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..), GlobalNameFuns(..))
 import RenameMonad4(Rn4M(..))
 import ProtoName(ProtoName)
 import RenameAuxFuns(GlobalNameFun(..), GlobalNameFuns(..))
 import RenameMonad4(Rn4M(..))
-import SimplEnv(UnfoldingDetails)
-import SplitUniq(SUniqSM(..), SplitUniqSupply, getSUnique, getSUniques, splitUniqSupply)
+import SplitUniq(SUniqSM(..), SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import SrcLoc(SrcLoc)
-import Subst(Subst, applySubstToThetaTy, applySubstToTy, applySubstToTyVar)
+import Subst(Subst)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType)
-import Unique(Unique, UniqueSupply, mkUniqueGrimily)
+import Unique(Unique, UniqueSupply)
+infixr 9 `thenLazilyNF_Tc`
 infixr 9 `thenNF_Tc`
 infixr 9 `thenTc`
 infixr 9 `thenTc_`
 type Baby_TcM a = (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
 infixr 9 `thenNF_Tc`
 infixr 9 `thenTc`
 infixr 9 `thenTc_`
 type Baby_TcM a = (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
-data Baby_TcResult a   {-# GHC_PRAGMA BabyTcFailed (Bag (PprStyle -> Int -> Bool -> PrettyRep)) | BabyTcSucceeded a (Bag (PprStyle -> Int -> Bool -> PrettyRep)) #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data Baby_TcResult a 
+data Bag a 
+data Class 
+data GlobalSwitch 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
+data Expr a b 
 type NF_TcM a = (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type TcM a = (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 type NF_TcM a = (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type TcM a = (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-data TcResult a        {-# GHC_PRAGMA TcSucceeded a Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) | TcFailed Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) #-}
-data UnifyErrContext
-       {-# GHC_PRAGMA PredCtxt (Expr Name (InPat Name)) | AppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | TooManyArgsCtxt (Expr Name (InPat Name)) | FunAppCtxt (Expr Name (InPat Name)) (Labda Id) (Expr Name (InPat Name)) UniType UniType Int | OpAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionLAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionRAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | CaseCtxt (Expr Name (InPat Name)) [Match Name (InPat Name)] | BranchCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | ListCtxt [Expr Name (InPat Name)] | PatCtxt (InPat Name) | CaseBranchesCtxt [Match Name (InPat Name)] | FilterCtxt (Expr Name (InPat Name)) | GeneratorCtxt (InPat Name) (Expr Name (InPat Name)) | GRHSsBranchCtxt [GRHS Name (InPat Name)] | GRHSsGuardCtxt (Expr Name (InPat Name)) | PatMonoBindsCtxt (InPat Name) (GRHSsAndBinds Name (InPat Name)) | FunMonoBindsCtxt Name [Match Name (InPat Name)] | MatchCtxt UniType UniType | ArithSeqCtxt (Expr Name (InPat Name)) | CCallCtxt [Char] [Expr Name (InPat Name)] | AmbigDictCtxt [Inst] | SigCtxt Id UniType | MethodSigCtxt Name UniType | ExprSigCtxt (Expr Name (InPat Name)) UniType | ValSpecSigCtxt Name UniType SrcLoc | ValSpecSpecIdCtxt Name UniType Name SrcLoc | BindSigCtxt [Id] | SuperClassSigCtxt | CaseBranchCtxt (Match Name (InPat Name)) | Rank2ArgCtxt (Expr Id TypecheckedPat) UniType #-}
+data TcResult a 
+data UnifyErrContext 
 type TypecheckedExpr = Expr Id TypecheckedPat
 type TypecheckedExpr = Expr Id TypecheckedPat
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data TypecheckedPat 
+data Id 
+data IdInfo 
+data Inst 
+data Labda a 
+data MaybeErr a b 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data PrettyRep 
+data ProtoName 
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type Rn4M a = (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type SUniqSM a = SplitUniqSupply -> a
 type GlobalNameFun = ProtoName -> Labda Name
 type GlobalNameFuns = (ProtoName -> Labda Name, ProtoName -> Labda Name)
 type Rn4M a = (GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 type SUniqSM a = SplitUniqSupply -> a
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data SplitUniqSupply 
+data SrcLoc 
+data Subst 
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data UniType 
+data Unique 
+data UniqueSupply 
 addSrcLocB_Tc :: SrcLoc -> ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
 addSrcLocB_Tc :: SrcLoc -> ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
-       {-# GHC_PRAGMA _A_ 6 _U_ 212220 _N_ _S_ "LSLLLA" {_A_ 5 _U_ 21222 _N_ _N_ _F_ _IF_ARGS_ 1 5 XXXXX 5 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: SplitUniqSupply) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u2 [ u3, u4, u5, u1 ] _N_} _F_ _IF_ARGS_ 1 6 XXXXXX 5 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: SplitUniqSupply) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: SrcLoc) -> _APP_  u2 [ u3, u4, u5, u1 ] _N_ #-}
 addSrcLocTc :: SrcLoc -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 addSrcLocTc :: SrcLoc -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 8 _U_ 21222220 _N_ _S_ "LSLLLLLA" {_A_ 7 _U_ 2122222 _N_ _N_ _F_ _IF_ARGS_ 1 7 XXXXXXX 7 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: [UniType]) (u5 :: Subst) (u6 :: SplitUniqSupply) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u2 [ u3, u4, u5, u6, u7, u1 ] _N_} _F_ _IF_ARGS_ 1 8 XXXXXXXX 7 _/\_ u0 -> \ (u1 :: SrcLoc) (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: [UniType]) (u5 :: Subst) (u6 :: SplitUniqSupply) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SrcLoc) -> _APP_  u2 [ u3, u4, u5, u6, u7, u1 ] _N_ #-}
-applySubstToId :: Subst -> Id -> (Subst, Id)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(LSU(LLU(S)LLLLLLL)S)" {_A_ 5 _U_ 22212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-applySubstToInst :: Subst -> Inst -> (Subst, Inst)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 applyTcSubstToId :: Id -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToId :: Id -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1002020 _N_ _S_ "U(LSU(LLU(S)LLLLLLL)S)AALALA" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 applyTcSubstToInst :: Inst -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToInst :: Inst -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1002020 _N_ _S_ "SAALALA" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 XXXXXXX 8 \ (u0 :: Inst) (u1 :: GlobalSwitch -> Bool) (u2 :: [UniType]) (u3 :: Subst) (u4 :: SplitUniqSupply) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: SrcLoc) -> case _APP_  _ORIG_ Inst applySubstToInst [ u3, u0 ] of { _ALG_ _TUP_2 (u7 :: Subst) (u8 :: Inst) -> _!_ _TUP_3 [Inst, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u8, u7, u5]; _NO_DEFLT_ } _N_ #-}
 applyTcSubstToInsts :: [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Inst], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToInsts :: [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Inst], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: [Inst]) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ TcMonad mapNF_Tc { Inst } { Inst } [ _ORIG_ TcMonad applyTcSubstToInst, u0 ] _N_ #-}
 applyTcSubstToTy :: UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToTy :: UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002020 _N_ _S_ "SAALALA" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 XXXXXXX 8 \ (u0 :: UniType) (u1 :: GlobalSwitch -> Bool) (u2 :: [UniType]) (u3 :: Subst) (u4 :: SplitUniqSupply) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: SrcLoc) -> case _APP_  _ORIG_ Subst applySubstToTy [ u3, u0 ] of { _ALG_ _TUP_2 (u7 :: Subst) (u8 :: UniType) -> _!_ _TUP_3 [UniType, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u8, u7, u5]; _NO_DEFLT_ } _N_ #-}
 applyTcSubstToTyVar :: TyVar -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToTyVar :: TyVar -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002020 _N_ _S_ "LAALALA" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 XXXXXXX 8 \ (u0 :: TyVar) (u1 :: GlobalSwitch -> Bool) (u2 :: [UniType]) (u3 :: Subst) (u4 :: SplitUniqSupply) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: SrcLoc) -> case _APP_  _ORIG_ Subst applySubstToTyVar [ u3, u0 ] of { _ALG_ _TUP_2 (u7 :: Subst) (u8 :: UniType) -> _!_ _TUP_3 [UniType, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u8, u7, u5]; _NO_DEFLT_ } _N_ #-}
 applyTcSubstToTyVars :: [TyVar] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToTyVars :: [TyVar] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: [TyVar]) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ TcMonad mapNF_Tc { TyVar } { UniType } [ _ORIG_ TcMonad applyTcSubstToTyVar, u0 ] _N_ #-}
 applyTcSubstToTys :: [UniType] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstToTys :: [UniType] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222222 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: [UniType]) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ TcMonad mapNF_Tc { UniType } { UniType } [ _ORIG_ TcMonad applyTcSubstToTy, u0 ] _N_ #-}
 babyTcMtoNF_TcM :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 babyTcMtoNF_TcM :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1202222 _N_ _S_ "SLALLLL" {_A_ 6 _U_ 122222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 babyTcMtoTcM :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 babyTcMtoTcM :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 7 _U_ 1202222 _N_ _S_ "SLALLLL" {_A_ 6 _U_ 122222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 checkB_Tc :: Bool -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult ()
 checkB_Tc :: Bool -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult ()
-       {-# GHC_PRAGMA _A_ 6 _U_ 120020 _N_ _S_ "EL" _N_ _N_ #-}
 checkMaybeErrTc :: MaybeErr b a -> (a -> PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
 checkMaybeErrTc :: MaybeErr b a -> (a -> PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
-       {-# GHC_PRAGMA _A_ 2 _U_ 11222222 _N_ _S_ "SL" _N_ _N_ #-}
 checkMaybeTc :: Labda a -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 checkMaybeTc :: Labda a -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 8 _U_ 12002020 _N_ _S_ "SL" _F_ _IF_ARGS_ 1 8 CXXXXXXX 10 _/\_ u0 -> \ (u1 :: Labda u0) (u2 :: PprStyle -> Int -> Bool -> PrettyRep) (u3 :: GlobalSwitch -> Bool) (u4 :: [UniType]) (u5 :: Subst) (u6 :: SplitUniqSupply) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SrcLoc) -> case u1 of { _ALG_ _ORIG_ Maybes Ni (u9 :: u0) -> _!_ _ORIG_ TcMonad TcSucceeded [u0] [u9, u5, u7]; _ORIG_ Maybes Hamna  -> _APP_  _TYAPP_  _TYAPP_  _TYAPP_  _TYAPP_  _TYAPP_  _WRKR_ _ORIG_ TcMonad failTc { (GlobalSwitch -> Bool) } { [UniType] } { SplitUniqSupply } { SrcLoc } { u0 } [ u2, u5, u7 ]; _NO_DEFLT_ } _N_ #-}
 checkMaybesTc :: [Labda a] -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [a]
 checkMaybesTc :: [Labda a] -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 12222222 _N_ _S_ "SL" _N_ _N_ #-}
 checkTc :: Bool -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 checkTc :: Bool -> (PprStyle -> Int -> Bool -> PrettyRep) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 8 _U_ 12002020 _N_ _S_ "EL" _N_ _N_ #-}
 extendSubstTc :: TyVar -> UniType -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 extendSubstTc :: TyVar -> UniType -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 9 _U_ 222221222 _N_ _N_ _N_ _N_ #-}
 failB_Tc :: (PprStyle -> Int -> Bool -> PrettyRep) -> a -> b -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> c -> Baby_TcResult d
 failB_Tc :: (PprStyle -> Int -> Bool -> PrettyRep) -> a -> b -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> c -> Baby_TcResult d
-       {-# GHC_PRAGMA _A_ 5 _U_ 20020 _N_ _S_ "LAALA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 4 5 XXXXX 6 _/\_ u0 u1 u2 u3 -> \ (u4 :: PprStyle -> Int -> Bool -> PrettyRep) (u5 :: u0) (u6 :: u1) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: u2) -> let {(u9 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) = _APP_  _TYAPP_  _ORIG_ Bag snocBag { (PprStyle -> Int -> Bool -> PrettyRep) } [ u7, u4 ]} in _!_ _ORIG_ TcMonad BabyTcFailed [u3] [u9] _N_ #-}
 failTc :: (PprStyle -> Int -> Bool -> PrettyRep) -> a -> b -> Subst -> c -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> d -> TcResult e
 failTc :: (PprStyle -> Int -> Bool -> PrettyRep) -> a -> b -> Subst -> c -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> d -> TcResult e
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002020 _N_ _S_ "LAALALA" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 5 7 XXXXXXX 7 _/\_ u0 u1 u2 u3 u4 -> \ (u5 :: PprStyle -> Int -> Bool -> PrettyRep) (u6 :: u0) (u7 :: u1) (u8 :: Subst) (u9 :: u2) (ua :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (ub :: u3) -> let {(uc :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) = _APP_  _TYAPP_  _ORIG_ Bag snocBag { (PprStyle -> Int -> Bool -> PrettyRep) } [ ua, u5 ]} in _!_ _ORIG_ TcMonad TcFailed [u4] [u8, uc] _N_ #-}
 fixB_Tc :: (a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
 fixB_Tc :: (a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
-       {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _S_ "SLLLL" _N_ _N_ #-}
 fixNF_Tc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 fixNF_Tc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222 _N_ _S_ "SLLLLLL" _N_ _N_ #-}
 fixTc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 fixTc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222 _N_ _S_ "SLLLLLL" _N_ _N_ #-}
 foldlTc :: (b -> a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> b -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
 foldlTc :: (b -> a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> b -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
-       {-# GHC_PRAGMA _A_ 3 _U_ 221222222 _N_ _S_ "LLS" _N_ _N_ #-}
 getDefaultingTys :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getDefaultingTys :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 022020 _N_ _S_ "ALLALA" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: [UniType]) (u1 :: Subst) (u2 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _TUP_3 [[UniType], Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u0, u1, u2] _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 4 \ (u0 :: GlobalSwitch -> Bool) (u1 :: [UniType]) (u2 :: Subst) (u3 :: SplitUniqSupply) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SrcLoc) -> _!_ _TUP_3 [[UniType], Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u1, u2, u4] _N_ #-}
-getSUnique :: SplitUniqSupply -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> case u1 of { _ALG_ I# (u4 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u4]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
-getSUniques :: Int -> SplitUniqSupply -> [Unique]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)L" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSrcLocB_Tc :: a -> b -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> c -> Baby_TcResult c
 getSrcLocB_Tc :: a -> b -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> c -> Baby_TcResult c
-       {-# GHC_PRAGMA _A_ 4 _U_ 0022 _N_ _S_ "AALL" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 3 2 XX 3 _/\_ u0 u1 u2 -> \ (u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u4 :: u2) -> _!_ _ORIG_ TcMonad BabyTcSucceeded [u2] [u4, u3] _N_} _F_ _IF_ARGS_ 3 4 XXXX 3 _/\_ u0 u1 u2 -> \ (u3 :: u0) (u4 :: u1) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: u2) -> _!_ _ORIG_ TcMonad BabyTcSucceeded [u2] [u6, u5] _N_ #-}
 getSrcLocTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (SrcLoc, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getSrcLocTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (SrcLoc, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 002022 _N_ _S_ "AALALL" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: Subst) (u1 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u2 :: SrcLoc) -> _!_ _TUP_3 [SrcLoc, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u2, u0, u1] _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 4 \ (u0 :: GlobalSwitch -> Bool) (u1 :: [UniType]) (u2 :: Subst) (u3 :: SplitUniqSupply) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SrcLoc) -> _!_ _TUP_3 [SrcLoc, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u5, u2, u4] _N_ #-}
 getSwitchCheckerB_Tc :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult (GlobalSwitch -> Bool)
 getSwitchCheckerB_Tc :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult (GlobalSwitch -> Bool)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2020 _N_ _S_ "LALA" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: GlobalSwitch -> Bool) (u1 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _ORIG_ TcMonad BabyTcSucceeded [(GlobalSwitch -> Bool)] [u0, u1] _N_} _F_ _IF_ARGS_ 0 4 XXXX 3 \ (u0 :: GlobalSwitch -> Bool) (u1 :: SplitUniqSupply) (u2 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u3 :: SrcLoc) -> _!_ _ORIG_ TcMonad BabyTcSucceeded [(GlobalSwitch -> Bool)] [u0, u2] _N_ #-}
 getSwitchCheckerTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (GlobalSwitch -> Bool, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getSwitchCheckerTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (GlobalSwitch -> Bool, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 202020 _N_ _S_ "LALALA" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: GlobalSwitch -> Bool) (u1 :: Subst) (u2 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _TUP_3 [(GlobalSwitch -> Bool), Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u0, u1, u2] _N_} _F_ _IF_ARGS_ 0 6 XXXXXX 4 \ (u0 :: GlobalSwitch -> Bool) (u1 :: [UniType]) (u2 :: Subst) (u3 :: SplitUniqSupply) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SrcLoc) -> _!_ _TUP_3 [(GlobalSwitch -> Bool), Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u0, u2, u4] _N_ #-}
 getTyVarUniqueTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Unique, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getTyVarUniqueTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Unique, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 001020 _N_ _S_ "AALALA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getTyVarUniquesTc :: Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Unique], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getTyVarUniquesTc :: Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Unique], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1001020 _N_ _S_ "LAALALA" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getUniqueB_Tc :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult Unique
 getUniqueB_Tc :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult Unique
-       {-# GHC_PRAGMA _A_ 4 _U_ 0120 _N_ _S_ "ALLA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 4 XCXX 8 \ (u0 :: GlobalSwitch -> Bool) (u1 :: SplitUniqSupply) (u2 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u3 :: SrcLoc) -> let {(u8 :: Unique) = case u1 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u4 :: Int) (u5 :: SplitUniqSupply) (u6 :: SplitUniqSupply) -> case u4 of { _ALG_ I# (u7 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u7]; _NO_DEFLT_ }; _NO_DEFLT_ }} in _!_ _ORIG_ TcMonad BabyTcSucceeded [Unique] [u8, u2] _N_ #-}
 getUniqueTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Unique, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getUniqueTc :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Unique, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 002120 _N_ _S_ "AALLLA" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 6 XXXCXX 9 \ (u0 :: GlobalSwitch -> Bool) (u1 :: [UniType]) (u2 :: Subst) (u3 :: SplitUniqSupply) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SrcLoc) -> let {(ua :: Unique) = case u3 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u6 :: Int) (u7 :: SplitUniqSupply) (u8 :: SplitUniqSupply) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u9]; _NO_DEFLT_ }; _NO_DEFLT_ }} in _!_ _TUP_3 [Unique, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [ua, u2, u4] _N_ #-}
 getUniquesB_Tc :: Int -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [Unique]
 getUniquesB_Tc :: Int -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [Unique]
-       {-# GHC_PRAGMA _A_ 5 _U_ 10220 _N_ _S_ "LALLA" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 5 CXXXX 8 \ (u0 :: Int) (u1 :: GlobalSwitch -> Bool) (u2 :: SplitUniqSupply) (u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u4 :: SrcLoc) -> let {(u6 :: [Unique]) = case u0 of { _ALG_ I# (u5 :: Int#) -> _APP_  _WRKR_ _ORIG_ SplitUniq getSUniques [ u5, u2 ]; _NO_DEFLT_ }} in _!_ _ORIG_ TcMonad BabyTcSucceeded [[Unique]] [u6, u3] _N_ #-}
 getUniquesTc :: Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Unique], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 getUniquesTc :: Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Unique], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1002220 _N_ _S_ "LAALLLA" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 7 CXXXXXX 9 \ (u0 :: Int) (u1 :: GlobalSwitch -> Bool) (u2 :: [UniType]) (u3 :: Subst) (u4 :: SplitUniqSupply) (u5 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u6 :: SrcLoc) -> let {(u8 :: [Unique]) = case u0 of { _ALG_ I# (u7 :: Int#) -> _APP_  _WRKR_ _ORIG_ SplitUniq getSUniques [ u7, u4 ]; _NO_DEFLT_ }} in _!_ _TUP_3 [[Unique], Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u8, u3, u5] _N_ #-}
 initTc :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> MaybeErr a (Bag (PprStyle -> Int -> Bool -> PrettyRep))
 initTc :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> MaybeErr a (Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 listNF_Tc :: [(GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([a], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 listNF_Tc :: [(GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([a], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1222122 _N_ _S_ "SLLLLLL" _N_ _N_ #-}
 listTc :: [(GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [a]
 listTc :: [(GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [a]
-       {-# GHC_PRAGMA _A_ 7 _U_ 1222122 _N_ _S_ "SLLLLLL" _N_ _N_ #-}
 lookupInst_Tc :: Inst -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Expr Id TypecheckedPat, [Inst])
 lookupInst_Tc :: Inst -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (Expr Id TypecheckedPat, [Inst])
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002220 _N_ _S_ "SAALLLA" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupNoBindInst_Tc :: Inst -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [Inst]
 lookupNoBindInst_Tc :: Inst -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [Inst]
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002120 _N_ _S_ "SAALLLA" {_A_ 4 _U_ 2212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mapAndUnzipTc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (b, c)) -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([b], [c])
 mapAndUnzipTc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (b, c)) -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([b], [c])
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 mapB_Tc :: (a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b) -> [a] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [b]
 mapB_Tc :: (a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b) -> [a] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 212222 _N_ _S_ "LS" _N_ _N_ #-}
 mapNF_Tc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (b, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([b], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mapNF_Tc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (b, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([b], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 mapTc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [b]
 mapTc :: (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> [a] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 noFailTc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 noFailTc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 1222222 _N_ _S_ "SLLLLLL" _N_ _N_ #-}
 pruneSubstTc :: [TyVar] -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 pruneSubstTc :: [TyVar] -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 8 _U_ 01222222 _N_ _S_ "ASLLLLLL" {_A_ 7 _U_ 1222222 _N_ _N_ _F_ _IF_ARGS_ 1 7 XXXXXXX 7 _/\_ u0 -> \ (u1 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u2 :: GlobalSwitch -> Bool) (u3 :: [UniType]) (u4 :: Subst) (u5 :: SplitUniqSupply) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SrcLoc) -> _APP_  u1 [ u2, u3, u4, u5, u6, u7 ] _N_} _F_ _IF_ARGS_ 1 8 XXXXXXXX 7 _/\_ u0 -> \ (u1 :: [TyVar]) (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: [UniType]) (u5 :: Subst) (u6 :: SplitUniqSupply) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SrcLoc) -> _APP_  u2 [ u3, u4, u5, u6, u7, u8 ] _N_ #-}
 recoverIgnoreErrorsB_Tc :: e -> (b -> c -> Bag a -> d -> Baby_TcResult e) -> b -> c -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> d -> Baby_TcResult e
 recoverIgnoreErrorsB_Tc :: e -> (b -> c -> Bag a -> d -> Baby_TcResult e) -> b -> c -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> d -> Baby_TcResult e
-       {-# GHC_PRAGMA _A_ 6 _U_ 112222 _N_ _N_ _N_ _N_ #-}
 recoverQuietlyTc :: a -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 recoverQuietlyTc :: a -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 21221222 _N_ _N_ _N_ _N_ #-}
 recoverTc :: a -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 recoverTc :: a -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 21221222 _N_ _S_ "LSLLLLLL" _N_ _N_ #-}
 returnB_Tc :: a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
 returnB_Tc :: a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
-       {-# GHC_PRAGMA _A_ 5 _U_ 20020 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: GlobalSwitch -> Bool) (u3 :: SplitUniqSupply) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SrcLoc) -> _!_ _ORIG_ TcMonad BabyTcSucceeded [u0] [u1, u4] _N_ #-}
 returnNF_Tc :: a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 returnNF_Tc :: a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002020 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: GlobalSwitch -> Bool) (u3 :: [UniType]) (u4 :: Subst) (u5 :: SplitUniqSupply) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SrcLoc) -> _!_ _TUP_3 [u0, Subst, (Bag (PprStyle -> Int -> Bool -> PrettyRep))] [u1, u4, u6] _N_ #-}
 returnTc :: a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 returnTc :: a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002020 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: GlobalSwitch -> Bool) (u3 :: [UniType]) (u4 :: Subst) (u5 :: SplitUniqSupply) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SrcLoc) -> _!_ _ORIG_ TcMonad TcSucceeded [u0] [u1, u4, u6] _N_ #-}
 rn4MtoTcM :: (ProtoName -> Labda Name, ProtoName -> Labda Name) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((a, Bag (PprStyle -> Int -> Bool -> PrettyRep)), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 rn4MtoTcM :: (ProtoName -> Labda Name, ProtoName -> Labda Name) -> ((GlobalSwitch -> Bool) -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> FiniteMap _PackedString Name -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SplitUniqSupply -> SrcLoc -> (a, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((a, Bag (PprStyle -> Int -> Bool -> PrettyRep)), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 21202220 _N_ _S_ "LLLALLLA" {_A_ 6 _U_ 212222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setDefaultingTys :: [UniType] -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
 setDefaultingTys :: [UniType] -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a
-       {-# GHC_PRAGMA _A_ 8 _U_ 21202222 _N_ _S_ "LSLALLLL" {_A_ 7 _U_ 2122222 _N_ _N_ _F_ _IF_ARGS_ 1 7 XXXXXXX 7 _/\_ u0 -> \ (u1 :: [UniType]) (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: Subst) (u5 :: SplitUniqSupply) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SrcLoc) -> _APP_  u2 [ u3, u1, u4, u5, u6, u7 ] _N_} _F_ _IF_ARGS_ 1 8 XXXXXXXX 7 _/\_ u0 -> \ (u1 :: [UniType]) (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: GlobalSwitch -> Bool) (u4 :: [UniType]) (u5 :: Subst) (u6 :: SplitUniqSupply) (u7 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u8 :: SrcLoc) -> _APP_  u2 [ u3, u1, u5, u6, u7, u8 ] _N_ #-}
-splitUniqSupply :: SplitUniqSupply -> (SplitUniqSupply, SplitUniqSupply)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _ALWAYS_ \ (u0 :: SplitUniqSupply) -> case u0 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u1 :: Int) (u2 :: SplitUniqSupply) (u3 :: SplitUniqSupply) -> _!_ _TUP_2 [SplitUniqSupply, SplitUniqSupply] [u2, u3]; _NO_DEFLT_ } _N_ #-}
-applySubstToThetaTy :: Subst -> [(Class, UniType)] -> (Subst, [(Class, UniType)])
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
-applySubstToTy :: Subst -> UniType -> (Subst, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
-applySubstToTyVar :: Subst -> TyVar -> (Subst, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
-mkUniqueGrimily :: Int# -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_ #-}
 thenB_Tc :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b
 thenB_Tc :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> (a -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b
-       {-# GHC_PRAGMA _A_ 6 _U_ 112122 _N_ _S_ "SLLU(ALL)LL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult u0) (u3 :: u0 -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult u1) (u4 :: GlobalSwitch -> Bool) (u5 :: SplitUniqSupply) (u6 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u7 :: SrcLoc) -> case u5 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (u8 :: Int) (u9 :: SplitUniqSupply) (ua :: SplitUniqSupply) -> case _APP_  u2 [ u4, u9, u6, u7 ] of { _ALG_ _ORIG_ TcMonad BabyTcFailed (ub :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _ORIG_ TcMonad BabyTcFailed [u1] [ub]; _ORIG_ TcMonad BabyTcSucceeded (uc :: u0) (ud :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ uc, u4, ua, ud, u7 ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 thenB_Tc_ :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b
 thenB_Tc_ :: ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a) -> ((GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult b
-       {-# GHC_PRAGMA _A_ 6 _U_ 112122 _N_ _S_ "SLLU(ALL)LL" _N_ _N_ #-}
+thenLazilyNF_Tc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> b
 thenNF_Tc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> b
 thenNF_Tc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (a, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) -> (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> b
-       {-# GHC_PRAGMA _A_ 8 _U_ 11222122 _N_ _S_ "SSLLLU(ALL)LL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (u0, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))) (u3 :: u0 -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> u1) (u4 :: GlobalSwitch -> Bool) (u5 :: [UniType]) (u6 :: Subst) (u7 :: SplitUniqSupply) (u8 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u9 :: SrcLoc) -> case u7 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ u4, u5, u6, ub, u8, u9 ] of { _ALG_ _TUP_3 (ud :: u0) (ue :: Subst) (uf :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ ud, u4, u5, ue, uc, uf, u9 ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 thenTc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
 thenTc :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> (a -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
-       {-# GHC_PRAGMA _A_ 8 _U_ 11222122 _N_ _S_ "SLLLLU(ALL)LL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: u0 -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u1) (u4 :: GlobalSwitch -> Bool) (u5 :: [UniType]) (u6 :: Subst) (u7 :: SplitUniqSupply) (u8 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u9 :: SrcLoc) -> case u7 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ u4, u5, u6, ub, u8, u9 ] of { _ALG_ _ORIG_ TcMonad TcFailed (ud :: Subst) (ue :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _ORIG_ TcMonad TcFailed [u1] [ud, ue]; _ORIG_ TcMonad TcSucceeded (uf :: u0) (ug :: Subst) (uh :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ uf, u4, u5, ug, uc, uh, u9 ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 thenTc_ :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
 thenTc_ :: ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult a) -> ((GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult b
-       {-# GHC_PRAGMA _A_ 8 _U_ 11222122 _N_ _S_ "SLLLLU(ALL)LL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u0) (u3 :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult u1) (u4 :: GlobalSwitch -> Bool) (u5 :: [UniType]) (u6 :: Subst) (u7 :: SplitUniqSupply) (u8 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u9 :: SrcLoc) -> case u7 of { _ALG_ _ORIG_ SplitUniq MkSplitUniqSupply (ua :: Int) (ub :: SplitUniqSupply) (uc :: SplitUniqSupply) -> case _APP_  u2 [ u4, u5, u6, ub, u8, u9 ] of { _ALG_ _ORIG_ TcMonad TcFailed (ud :: Subst) (ue :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _!_ _ORIG_ TcMonad TcFailed [u1] [ud, ue]; _ORIG_ TcMonad TcSucceeded (uf :: u0) (ug :: Subst) (uh :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> _APP_  u3 [ u4, u5, ug, uc, uh, u9 ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 uniqSMtoBabyTcM :: (SplitUniqSupply -> a) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
 uniqSMtoBabyTcM :: (SplitUniqSupply -> a) -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult a
-       {-# GHC_PRAGMA _A_ 5 _U_ 10220 _N_ _S_ "LALLA" {_A_ 3 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 1 3 XXX 6 _/\_ u0 -> \ (u1 :: SplitUniqSupply -> u0) (u2 :: SplitUniqSupply) (u3 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) -> let {(u4 :: u0) = _APP_  u1 [ u2 ]} in _!_ _ORIG_ TcMonad BabyTcSucceeded [u0] [u4, u3] _N_} _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: SplitUniqSupply -> u0) (u2 :: GlobalSwitch -> Bool) (u3 :: SplitUniqSupply) (u4 :: Bag (PprStyle -> Int -> Bool -> PrettyRep)) (u5 :: SrcLoc) -> let {(u6 :: u0) = _APP_  u1 [ u3 ]} in _!_ _ORIG_ TcMonad BabyTcSucceeded [u0] [u6, u4] _N_ #-}
 
 
index 48cc7d9..dc947dc 100644 (file)
@@ -14,7 +14,7 @@ module TcMonad (
        recoverTc, recoverQuietlyTc,
 
        NF_TcM(..),
        recoverTc, recoverQuietlyTc,
 
        NF_TcM(..),
-       thenNF_Tc, returnNF_Tc, listNF_Tc, mapNF_Tc,
+       thenNF_Tc, thenLazilyNF_Tc, returnNF_Tc, listNF_Tc, mapNF_Tc,
        fixNF_Tc, noFailTc,
 
        Baby_TcM(..), Baby_TcResult{-abstract-},
        fixNF_Tc, noFailTc,
 
        Baby_TcM(..), Baby_TcResult{-abstract-},
@@ -90,7 +90,7 @@ import SplitUniq
 import Unique
 import Util
 
 import Unique
 import Util
 
-infixr 9 `thenTc`, `thenTc_`, `thenNF_Tc`
+infixr 9 `thenTc`, `thenTc_`, `thenNF_Tc`, `thenLazilyNF_Tc`
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -278,10 +278,12 @@ type NF_TcM result = InTcM (result, Subst, Bag Error)
 
 #ifdef __GLASGOW_HASKELL__
 {-# INLINE thenNF_Tc #-}
 
 #ifdef __GLASGOW_HASKELL__
 {-# INLINE thenNF_Tc #-}
+{-# INLINE thenLazilyNF_Tc #-}
 {-# INLINE returnNF_Tc #-}
 #endif
 
 {-# INLINE returnNF_Tc #-}
 #endif
 
-thenNF_Tc :: NF_TcM a -> (a -> InTcM b) -> InTcM b
+thenNF_Tc, thenLazilyNF_Tc :: NF_TcM a -> (a -> InTcM b) -> InTcM b
+-- ...Lazily... is purely a performance thing (WDP 95/09)
 \end{code}
 
 In particular, @thenNF_Tc@ has all of these types:
 \end{code}
 
 In particular, @thenNF_Tc@ has all of these types:
@@ -298,6 +300,15 @@ thenNF_Tc expr cont sw_chkr dtys subst us errs src_loc
        -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
     }
 
        -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
     }
 
+thenLazilyNF_Tc expr cont sw_chkr dtys subst us errs src_loc
+  = let
+       (s1, s2) = splitUniqSupply us
+    in
+    case (expr sw_chkr dtys subst s1 errs src_loc) of {
+     (result, subst2, errs2)
+       -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
+    }
+
 returnNF_Tc :: a -> NF_TcM a
 returnNF_Tc result sw_chkr dtys subst us errs src_loc
   = (result, subst, errs)
 returnNF_Tc :: a -> NF_TcM a
 returnNF_Tc result sw_chkr dtys subst us errs src_loc
   = (result, subst, errs)
index 301a099..4786266 100644 (file)
@@ -1,7 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TcMonadFns where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TcMonadFns where
 import Bag(Bag)
-import CharSeq(CSeq)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import ErrUtils(Error(..))
@@ -9,19 +8,18 @@ import ErrsTc(UnifyErrContext)
 import HsBinds(Bind, Binds, MonoBinds, Sig)
 import HsExpr(ArithSeqInfo, Expr)
 import HsLit(Literal)
 import HsBinds(Bind, Binds, MonoBinds, Sig)
 import HsExpr(ArithSeqInfo, Expr)
 import HsLit(Literal)
-import HsMatches(GRHS, GRHSsAndBinds, Match)
+import HsMatches(GRHSsAndBinds, Match)
 import HsPat(InPat, TypecheckedPat)
 import HsPat(InPat, TypecheckedPat)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdInfo(IdInfo, SpecEnv, SpecInfo)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import InstEnv(InstTemplate)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import IdInfo(IdInfo, SpecEnv, SpecInfo)
 import Inst(Inst, InstOrigin, OverloadedLit)
 import InstEnv(InstTemplate)
 import Maybes(Labda)
 import Name(Name)
 import NameTypes(FullName, ShortName)
-import PreludeGlaST(_MutableArray)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import Subst(Subst)
@@ -30,66 +28,46 @@ import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique, UniqueSupply)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique, UniqueSupply)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Bag a 
+data Class 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data UnifyErrContext
-       {-# GHC_PRAGMA PredCtxt (Expr Name (InPat Name)) | AppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | TooManyArgsCtxt (Expr Name (InPat Name)) | FunAppCtxt (Expr Name (InPat Name)) (Labda Id) (Expr Name (InPat Name)) UniType UniType Int | OpAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionLAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | SectionRAppCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | CaseCtxt (Expr Name (InPat Name)) [Match Name (InPat Name)] | BranchCtxt (Expr Name (InPat Name)) (Expr Name (InPat Name)) | ListCtxt [Expr Name (InPat Name)] | PatCtxt (InPat Name) | CaseBranchesCtxt [Match Name (InPat Name)] | FilterCtxt (Expr Name (InPat Name)) | GeneratorCtxt (InPat Name) (Expr Name (InPat Name)) | GRHSsBranchCtxt [GRHS Name (InPat Name)] | GRHSsGuardCtxt (Expr Name (InPat Name)) | PatMonoBindsCtxt (InPat Name) (GRHSsAndBinds Name (InPat Name)) | FunMonoBindsCtxt Name [Match Name (InPat Name)] | MatchCtxt UniType UniType | ArithSeqCtxt (Expr Name (InPat Name)) | CCallCtxt [Char] [Expr Name (InPat Name)] | AmbigDictCtxt [Inst] | SigCtxt Id UniType | MethodSigCtxt Name UniType | ExprSigCtxt (Expr Name (InPat Name)) UniType | ValSpecSigCtxt Name UniType SrcLoc | ValSpecSpecIdCtxt Name UniType Name SrcLoc | BindSigCtxt [Id] | SuperClassSigCtxt | CaseBranchCtxt (Match Name (InPat Name)) | Rank2ArgCtxt (Expr Id TypecheckedPat) UniType #-}
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data MonoBinds a b     {-# GHC_PRAGMA EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc #-}
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data SpecInfo  {-# GHC_PRAGMA SpecInfo [Labda UniType] Int Id #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data InstOrigin        {-# GHC_PRAGMA OccurrenceOf Id SrcLoc | InstanceDeclOrigin SrcLoc | LiteralOrigin Literal SrcLoc | ArithSeqOrigin (ArithSeqInfo Name (InPat Name)) SrcLoc | SignatureOrigin | ClassDeclOrigin SrcLoc | DerivingOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class Bool TyCon SrcLoc | InstanceSpecOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class UniType SrcLoc | DefaultDeclOrigin SrcLoc | ValSpecOrigin Name SrcLoc | CCallOrigin SrcLoc [Char] (Labda (Expr Name (InPat Name))) | LitLitOrigin SrcLoc [Char] | UnknownOrigin #-}
-data OverloadedLit     {-# GHC_PRAGMA OverloadedIntegral Integer Id Id | OverloadedFractional (Ratio Integer) Id #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data UnifyErrContext 
+data Binds a b 
+data MonoBinds a b 
+data TypecheckedPat 
+data Id 
+data SpecInfo 
+data Inst 
+data InstOrigin 
+data OverloadedLit 
+data Labda a 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data Subst     {-# GHC_PRAGMA MkSubst (_MutableArray _RealWorld Int (Labda UniType)) [(Int, Bag (Int, Labda UniType))] (_State _RealWorld) Int #-}
-data TcResult a        {-# GHC_PRAGMA TcSucceeded a Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) | TcFailed Subst (Bag (PprStyle -> Int -> Bool -> PrettyRep)) #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data PrettyRep 
+data SrcLoc 
+data Subst 
+data TcResult a 
+data TyVar 
+data UniType 
+data UniqueSupply 
 applyTcSubstAndCollectTyVars :: [TyVar] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([TyVar], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstAndCollectTyVars :: [TyVar] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([TyVar], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222122 _N_ _S_ "S" _N_ _N_ #-}
 applyTcSubstAndExpectTyVars :: [TyVar] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([TyVar], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 applyTcSubstAndExpectTyVars :: [TyVar] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([TyVar], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222122 _N_ _S_ "S" _N_ _N_ #-}
 copyTyVars :: [TyVarTemplate] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (([(TyVarTemplate, UniType)], [TyVar], [UniType]), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 copyTyVars :: [TyVarTemplate] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (([(TyVarTemplate, UniType)], [TyVar], [UniType]), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2002120 _N_ _N_ _N_ _N_ #-}
 mkIdsWithGivenTys :: [Name] -> [UniType] -> [IdInfo] -> [(Name, Id)]
 mkIdsWithGivenTys :: [Name] -> [UniType] -> [IdInfo] -> [(Name, Id)]
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "SSL" _N_ _N_ #-}
 mkIdsWithOpenTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([(Name, Id)], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mkIdsWithOpenTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([(Name, Id)], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2002120 _N_ _N_ _N_ _N_ #-}
 mkIdsWithPolyTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([(Name, Id)], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 mkIdsWithPolyTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([(Name, Id)], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2002120 _N_ _N_ _N_ _N_ #-}
 newClassOpLocals :: [(TyVarTemplate, UniType)] -> [ClassOp] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Id], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newClassOpLocals :: [(TyVarTemplate, UniType)] -> [ClassOp] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Id], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22002122 _N_ _S_ "LLAALU(AAS)LL" {_A_ 6 _U_ 222122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newDict :: InstOrigin -> Class -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newDict :: InstOrigin -> Class -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 9 _U_ 222002120 _N_ _S_ "LLLAALU(ALA)LA" {_A_ 6 _U_ 222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newDicts :: InstOrigin -> [(Class, UniType)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Inst], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newDicts :: InstOrigin -> [(Class, UniType)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Inst], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22002120 _N_ _S_ "LLAALU(ALA)LA" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newLocalWithGivenTy :: Name -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newLocalWithGivenTy :: Name -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 8 _U_ 22002120 _N_ _S_ "LLAALU(ALA)LA" {_A_ 5 _U_ 22212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newLocalsWithOpenTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Id], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newLocalsWithOpenTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Id], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2002120 _N_ _N_ _N_ _N_ #-}
 newLocalsWithPolyTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Id], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newLocalsWithPolyTyVarTys :: [Name] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([Id], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 1 _U_ 2002120 _N_ _N_ _N_ _N_ #-}
 newMethod :: InstOrigin -> Id -> [UniType] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newMethod :: InstOrigin -> Id -> [UniType] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 9 _U_ 222002120 _N_ _S_ "LLLAALU(ALA)LA" {_A_ 6 _U_ 222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newOpenTyVarTy :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newOpenTyVarTy :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 002120 _N_ _S_ "AALU(AAA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newOverloadedLit :: InstOrigin -> OverloadedLit -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newOverloadedLit :: InstOrigin -> OverloadedLit -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Inst, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 9 _U_ 222002120 _N_ _S_ "LLLAALU(ALA)LA" {_A_ 6 _U_ 222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newPolyTyVarTy :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newPolyTyVarTy :: (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (UniType, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 6 _U_ 002120 _N_ _S_ "AALU(AAA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newPolyTyVarTys :: Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newPolyTyVarTys :: Int -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ([UniType], Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 7 _U_ 2002120 _N_ _S_ "LAALU(AAA)LA" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newSpecId :: Id -> [Labda UniType] -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newSpecId :: Id -> [Labda UniType] -> UniType -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 9 _U_ 222002120 _N_ _S_ "LLLAALU(ALA)LA" {_A_ 6 _U_ 222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 newSpecPragmaId :: Name -> UniType -> Labda SpecInfo -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 newSpecPragmaId :: Name -> UniType -> Labda SpecInfo -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> (Id, Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 9 _U_ 222002120 _N_ _S_ "LLLAALU(ALA)LA" {_A_ 6 _U_ 222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 32c8044..a628baa 100644 (file)
@@ -71,21 +71,21 @@ copyTyVars old_tyvars
 
 newOpenTyVarTys :: Int -> NF_TcM [UniType]
 newOpenTyVarTys n
 
 newOpenTyVarTys :: Int -> NF_TcM [UniType]
 newOpenTyVarTys n
-  = getTyVarUniquesTc n        `thenNF_Tc` \ new_uniqs ->
+  = getTyVarUniquesTc n        `thenLazilyNF_Tc` \ new_uniqs ->
     returnNF_Tc [mkTyVarTy (mkOpenSysTyVar u) | u <- new_uniqs]
 
 newPolyTyVarTys :: Int -> NF_TcM [UniType]
 newPolyTyVarTys n
     returnNF_Tc [mkTyVarTy (mkOpenSysTyVar u) | u <- new_uniqs]
 
 newPolyTyVarTys :: Int -> NF_TcM [UniType]
 newPolyTyVarTys n
-  = getTyVarUniquesTc n        `thenNF_Tc` \ new_uniqs ->
+  = getTyVarUniquesTc n        `thenLazilyNF_Tc` \ new_uniqs ->
     returnNF_Tc [mkTyVarTy (mkPolySysTyVar u) | u <- new_uniqs]
 
 newOpenTyVarTy, newPolyTyVarTy :: NF_TcM UniType
 newOpenTyVarTy
     returnNF_Tc [mkTyVarTy (mkPolySysTyVar u) | u <- new_uniqs]
 
 newOpenTyVarTy, newPolyTyVarTy :: NF_TcM UniType
 newOpenTyVarTy
-  = getTyVarUniqueTc `thenNF_Tc` \ new_uniq ->
+  = getTyVarUniqueTc `thenLazilyNF_Tc` \ new_uniq ->
     returnNF_Tc (mkTyVarTy (mkOpenSysTyVar new_uniq))
 
 newPolyTyVarTy
     returnNF_Tc (mkTyVarTy (mkOpenSysTyVar new_uniq))
 
 newPolyTyVarTy
-  = getTyVarUniqueTc `thenNF_Tc` \ new_uniq ->
+  = getTyVarUniqueTc `thenLazilyNF_Tc` \ new_uniq ->
     returnNF_Tc (mkTyVarTy (mkPolySysTyVar new_uniq))
 \end{code}
 
     returnNF_Tc (mkTyVarTy (mkPolySysTyVar new_uniq))
 \end{code}
 
index abe09ba..640843d 100644 (file)
@@ -15,5 +15,4 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcMonoBinds :: E -> MonoBinds Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (MonoBinds Id TypecheckedPat, LIE)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcMonoBinds :: E -> MonoBinds Name (InPat Name) -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (MonoBinds Id TypecheckedPat, LIE)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index deb19fa..a31c3d9 100644 (file)
@@ -13,7 +13,5 @@ import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcInstanceType :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> Bool -> SrcLoc -> MonoType Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult UniType
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcInstanceType :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> Bool -> SrcLoc -> MonoType Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult UniType
-       {-# GHC_PRAGMA _A_ 6 _U_ 2221212122 _N_ _S_ "LLLLLS" _N_ _N_ #-}
 tcMonoType :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> MonoType Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult UniType
 tcMonoType :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> MonoType Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult UniType
-       {-# GHC_PRAGMA _A_ 4 _U_ 22212222 _N_ _S_ "LLLS" _N_ _N_ #-}
 
 
index 12e7ba3..2f13f7f 100644 (file)
@@ -13,5 +13,4 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcPat :: E -> InPat Name -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (TypecheckedPat, LIE, UniType)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcPat :: E -> InPat Name -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult (TypecheckedPat, LIE, UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 158d223..c7a6a78 100644 (file)
@@ -13,5 +13,4 @@ import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcPolyType :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> PolyType Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult UniType
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcPolyType :: UniqFM Class -> UniqFM TyCon -> UniqFM UniType -> PolyType Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult UniType
-       {-# GHC_PRAGMA _A_ 4 _U_ 22212222 _N_ _S_ "LLLS" _N_ _N_ #-}
 
 
index 8c3238a..bfb87a5 100644 (file)
@@ -18,13 +18,8 @@ import TyVar(TyVarTemplate)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcClassOpPragmas :: E -> UniType -> Id -> Id -> SpecEnv -> ClassOpPragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult (IdInfo, IdInfo)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcClassOpPragmas :: E -> UniType -> Id -> Id -> SpecEnv -> ClassOpPragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult (IdInfo, IdInfo)
-       {-# GHC_PRAGMA _A_ 6 _U_ 2022212222 _N_ _S_ "LALLLS" {_A_ 5 _U_ 222212222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 tcDataPragmas :: UniqFM TyCon -> UniqFM UniType -> TyCon -> [TyVarTemplate] -> DataPragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult ([ConDecl Name], [SpecInfo])
 tcDataPragmas :: UniqFM TyCon -> UniqFM UniType -> TyCon -> [TyVarTemplate] -> DataPragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult ([ConDecl Name], [SpecInfo])
-       {-# GHC_PRAGMA _A_ 5 _U_ 200112222 _N_ _S_ "LAALU(LS)" {_A_ 4 _U_ 21212122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 tcDictFunPragmas :: E -> UniType -> Id -> InstancePragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult IdInfo
 tcDictFunPragmas :: E -> UniType -> Id -> InstancePragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult IdInfo
-       {-# GHC_PRAGMA _A_ 4 _U_ 22222222 _N_ _S_ "LLLS" _N_ _N_ #-}
 tcGenPragmas :: E -> Labda UniType -> Id -> GenPragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult IdInfo
 tcGenPragmas :: E -> Labda UniType -> Id -> GenPragmas Name -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult IdInfo
-       {-# GHC_PRAGMA _A_ 4 _U_ 22212222 _N_ _S_ "LLLS" _N_ _N_ #-}
 tcTypePragmas :: TypePragmas -> Bool
 tcTypePragmas :: TypePragmas -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: TypePragmas) -> case u0 of { _ALG_ _ORIG_ HsPragmas NoTypePragmas  -> _!_ False [] []; _ORIG_ HsPragmas AbstractTySynonym  -> _!_ True [] []; _NO_DEFLT_ } _N_ #-}
 
 
index 2337eec..135792c 100644 (file)
@@ -15,5 +15,4 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcQuals :: E -> [Qual Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Qual Id TypecheckedPat], LIE)
 import TcMonad(TcResult)
 import UniType(UniType)
 tcQuals :: E -> [Qual Name (InPat Name)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Qual Id TypecheckedPat], LIE)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 
 
index 1b8acff..79735bc 100644 (file)
@@ -18,17 +18,10 @@ import TcMonad(TcResult)
 import TyVar(TyVar)
 import UniType(UniType)
 bindInstsOfLocalFuns :: LIE -> [Id] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((LIE, MonoBinds Id TypecheckedPat), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
 import TyVar(TyVar)
 import UniType(UniType)
 bindInstsOfLocalFuns :: LIE -> [Id] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> ((LIE, MonoBinds Id TypecheckedPat), Subst, Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 2 _U_ 12222222 _N_ _S_ "U(S)L" {_A_ 2 _U_ 22222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 tcSimplify :: Bool -> [TyVar] -> [TyVar] -> [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], [(Inst, Expr Id TypecheckedPat)], [Inst])
 tcSimplify :: Bool -> [TyVar] -> [TyVar] -> [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], [(Inst, Expr Id TypecheckedPat)], [Inst])
-       {-# GHC_PRAGMA _A_ 4 _U_ 1111222122 _N_ _S_ "LSSS" _N_ _N_ #-}
 tcSimplifyAndCheck :: Bool -> [TyVar] -> [TyVar] -> [Inst] -> [Inst] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], [(Inst, Expr Id TypecheckedPat)])
 tcSimplifyAndCheck :: Bool -> [TyVar] -> [TyVar] -> [Inst] -> [Inst] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], [(Inst, Expr Id TypecheckedPat)])
-       {-# GHC_PRAGMA _A_ 6 _U_ 111112222122 _N_ _S_ "LSSSSL" _N_ _N_ #-}
 tcSimplifyCheckThetas :: InstOrigin -> [(Class, UniType)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 tcSimplifyCheckThetas :: InstOrigin -> [(Class, UniType)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 tcSimplifyRank2 :: [TyVar] -> [Inst] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], [(Inst, Expr Id TypecheckedPat)])
 tcSimplifyRank2 :: [TyVar] -> [Inst] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ([Inst], [(Inst, Expr Id TypecheckedPat)])
-       {-# GHC_PRAGMA _A_ 3 _U_ 212222122 _N_ _S_ "LSL" _N_ _N_ #-}
 tcSimplifyThetas :: (Class -> UniType -> InstOrigin) -> [(Class, UniType)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [(Class, UniType)]
 tcSimplifyThetas :: (Class -> UniType -> InstOrigin) -> [(Class, UniType)] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [(Class, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21222222 _N_ _S_ "LS" _N_ _N_ #-}
 tcSimplifyTop :: [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [(Inst, Expr Id TypecheckedPat)]
 tcSimplifyTop :: [Inst] -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult [(Inst, Expr Id TypecheckedPat)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1222122 _N_ _S_ "S" _N_ _N_ #-}
 
 
index fbccc96..b4d6595 100644 (file)
@@ -16,5 +16,4 @@ import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcTyDecls :: E -> (Name -> Bool) -> (Name -> [DataTypeSig Name]) -> [TyDecl Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult (UniqFM TyCon, [(Name, Id)], FiniteMap TyCon [[Labda UniType]])
 import UniType(UniType)
 import UniqFM(UniqFM)
 tcTyDecls :: E -> (Name -> Bool) -> (Name -> [DataTypeSig Name]) -> [TyDecl Name] -> (GlobalSwitch -> Bool) -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> Baby_TcResult (UniqFM TyCon, [(Name, Id)], FiniteMap TyCon [[Labda UniType]])
-       {-# GHC_PRAGMA _A_ 4 _U_ 22212222 _N_ _S_ "LLLS" _N_ _N_ #-}
 
 
index 9fcfb2d..967bdda 100644 (file)
@@ -3,13 +3,12 @@ interface Typecheck where
 import AbsSyn(Module)
 import Bag(Bag)
 import CE(CE(..))
 import AbsSyn(Module)
 import Bag(Bag)
 import CE(CE(..))
-import CharSeq(CSeq)
 import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import E(E)
 import ErrUtils(Error(..))
 import FiniteMap(FiniteMap)
 import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import E(E)
 import ErrUtils(Error(..))
 import FiniteMap(FiniteMap)
-import HsBinds(Bind, Binds, MonoBinds, Sig)
+import HsBinds(Bind, Binds, Sig)
 import HsDecls(ClassDecl, DataTypeSig, DefaultDecl, FixityDecl, InstDecl, SpecialisedInstanceSig, TyDecl)
 import HsExpr(ArithSeqInfo, Expr, Qual)
 import HsImpExp(IE, ImportedInterface)
 import HsDecls(ClassDecl, DataTypeSig, DefaultDecl, FixityDecl, InstDecl, SpecialisedInstanceSig, TyDecl)
 import HsExpr(ArithSeqInfo, Expr, Qual)
 import HsImpExp(IE, ImportedInterface)
@@ -17,48 +16,45 @@ import HsLit(Literal)
 import HsMatches(Match)
 import HsPat(InPat, RenamedPat(..), TypecheckedPat)
 import HsTypes(PolyType)
 import HsMatches(Match)
 import HsPat(InPat, RenamedPat(..), TypecheckedPat)
 import HsTypes(PolyType)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import Inst(Inst, InstOrigin, OverloadedLit)
+import Id(Id)
+import Inst(Inst)
 import Maybes(Labda, MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Maybes(Labda, MaybeErr)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import ProtoName(ProtoName)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TcInstDcls(InstInfo)
 import TyCon(TyCon)
 import ProtoName(ProtoName)
 import SplitUniq(SplitUniqSupply)
 import SrcLoc(SrcLoc)
 import TcInstDcls(InstInfo)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVar)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Module a b 
+data Bag a 
 type CE = UniqFM Class
 type CE = UniqFM Class
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data E         {-# GHC_PRAGMA MkE (UniqFM TyCon) (UniqFM Id) (UniqFM Id) (UniqFM Class) #-}
+data GlobalSwitch 
+data E 
 type Error = PprStyle -> Int -> Bool -> PrettyRep
 type Error = PprStyle -> Int -> Bool -> PrettyRep
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data FixityDecl a      {-# GHC_PRAGMA InfixL a Int | InfixR a Int | InfixN a Int #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
+data Binds a b 
+data FixityDecl a 
+data Expr a b 
+data InPat a 
 type RenamedPat = InPat Name
 type RenamedPat = InPat Name
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data TypecheckedPat 
+data Id 
+data Inst 
+data Labda a 
+data MaybeErr a b 
+data Name 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data InstInfo  {-# GHC_PRAGMA InstInfo Class [TyVarTemplate] UniType [(Class, UniType)] [(Class, UniType)] Id [Id] (MonoBinds Name (InPat Name)) Bool _PackedString SrcLoc [Sig Name] #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data PrettyRep 
+data ProtoName 
+data SplitUniqSupply 
+data InstInfo 
+data UniqFM a 
 typecheckModule :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> Module Name (InPat Name) -> MaybeErr ((Binds Id TypecheckedPat, Binds Id TypecheckedPat, Binds Id TypecheckedPat, [(Inst, Expr Id TypecheckedPat)]), ([FixityDecl Name], [Id], UniqFM Class, UniqFM TyCon, Bag InstInfo), FiniteMap TyCon [[Labda UniType]], E, PprStyle -> Int -> Bool -> PrettyRep) (Bag (PprStyle -> Int -> Bool -> PrettyRep))
 typecheckModule :: (GlobalSwitch -> Bool) -> SplitUniqSupply -> (ProtoName -> Labda Name, ProtoName -> Labda Name) -> Module Name (InPat Name) -> MaybeErr ((Binds Id TypecheckedPat, Binds Id TypecheckedPat, Binds Id TypecheckedPat, [(Inst, Expr Id TypecheckedPat)]), ([FixityDecl Name], [Id], UniqFM Class, UniqFM TyCon, Bag InstInfo), FiniteMap TyCon [[Labda UniType]], E, PprStyle -> Int -> Bool -> PrettyRep) (Bag (PprStyle -> Int -> Bool -> PrettyRep))
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _S_ "LLLU(LAALSLLLLLLLL)" _N_ _N_ #-}
 
 
index 412dc07..a0e98d3 100644 (file)
@@ -10,9 +10,6 @@ import Subst(Subst)
 import TcMonad(TcResult)
 import UniType(UniType)
 unifyTauTy :: UniType -> UniType -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 import TcMonad(TcResult)
 import UniType(UniType)
 unifyTauTy :: UniType -> UniType -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 3 _U_ 222222222 _N_ _S_ "SSL" _N_ _N_ #-}
 unifyTauTyList :: [UniType] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 unifyTauTyList :: [UniType] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 2 _U_ 12222222 _N_ _S_ "SL" _N_ _N_ #-}
 unifyTauTyLists :: [UniType] -> [UniType] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
 unifyTauTyLists :: [UniType] -> [UniType] -> UnifyErrContext -> (GlobalSwitch -> Bool) -> [UniType] -> Subst -> SplitUniqSupply -> Bag (PprStyle -> Int -> Bool -> PrettyRep) -> SrcLoc -> TcResult ()
-       {-# GHC_PRAGMA _A_ 3 _U_ 112222222 _N_ _S_ "SSL" _N_ _N_ #-}
 
 
index 02c4bcd..39077bb 100644 (file)
@@ -1,26 +1,19 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AbsUniType where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface AbsUniType where
 import Bag(Bag)
-import BasicLit(BasicLit)
-import BinderInfo(BinderInfo)
-import CharSeq(CSeq)
 import Class(Class, ClassOp, cmpClass, derivableClassKeys, getClassBigSig, getClassInstEnv, getClassKey, getClassOpId, getClassOpLocalType, getClassOpString, getClassOpTag, getClassOps, getClassSig, getConstMethodId, getDefaultMethodId, getSuperDictSelId, isNumericClass, isStandardClass, isSuperClassOf, mkClass, mkClassOp)
 import CmdLineOpts(GlobalSwitch)
 import Class(Class, ClassOp, cmpClass, derivableClassKeys, getClassBigSig, getClassInstEnv, getClassKey, getClassOpId, getClassOpLocalType, getClassOpString, getClassOpTag, getClassOps, getClassSig, getConstMethodId, getDefaultMethodId, getSuperDictSelId, isNumericClass, isStandardClass, isSuperClassOf, mkClass, mkClassOp)
 import CmdLineOpts(GlobalSwitch)
-import CoreSyn(CoreAtom, CoreExpr)
-import Id(DataCon(..), Id, IdDetails)
+import Id(DataCon(..), Id)
 import IdEnv(IdEnv(..))
 import IdEnv(IdEnv(..))
-import IdInfo(IdInfo)
-import InstEnv(ClassInstEnv(..), InstTemplate, InstTy, MatchEnv(..))
-import MagicUFs(MagicUnfoldingFun)
-import Maybes(Labda, assocMaybe)
+import InstEnv(ClassInstEnv(..), InstTemplate, MatchEnv(..))
+import Maybes(Labda)
 import Name(Name)
 import Name(Name)
-import NameTypes(FullName, Provenance, ShortName)
+import NameTypes(FullName, ShortName)
 import Outputable(ExportFlag, NamedThing, Outputable)
 import PreludePS(_PackedString)
 import Outputable(ExportFlag, NamedThing, Outputable)
 import PreludePS(_PackedString)
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep)
+import Pretty(PprStyle, Pretty(..), PrettyRep)
 import PrimKind(PrimKind)
 import PrimKind(PrimKind)
-import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance)
-import SrcLoc(SrcLoc)
+import SimplEnv(UnfoldingDetails)
 import TyCon(Arity(..), TyCon, cmpTyCon, derivedFor, eqTyCon, getTyConArity, getTyConDataCons, getTyConDerivings, getTyConFamilySize, getTyConKind, getTyConTyVarTemplates, isBigTupleTyCon, isBoxedTyCon, isDataTyCon, isEnumerationTyCon, isLocalGenTyCon, isLocalSpecTyCon, isPrimTyCon, isSynTyCon, isTupleTyCon, isVisibleSynTyCon, maybeCharLikeTyCon, maybeDoubleLikeTyCon, maybeFloatLikeTyCon, maybeIntLikeTyCon, maybeSingleConstructorTyCon, mkDataTyCon, mkPrimTyCon, mkSpecTyCon, mkSynonymTyCon, mkTupleTyCon)
 import TyVar(TyVar, TyVarTemplate, alphaTyVars, alpha_tv, alpha_tyvar, beta_tv, beta_tyvar, cloneTyVar, cloneTyVarFromTemplate, cmpTyVar, delta_tv, delta_tyvar, epsilon_tv, epsilon_tyvar, eqTyVar, gamma_tv, gamma_tyvar, instantiateTyVarTemplates, ltTyVar, mkOpenSysTyVar, mkPolySysTyVar, mkSysTyVarTemplate, mkTemplateTyVars, mkUserTyVar, mkUserTyVarTemplate)
 import TyVarEnv(TyVarEnv(..), TypeEnv(..))
 import TyCon(Arity(..), TyCon, cmpTyCon, derivedFor, eqTyCon, getTyConArity, getTyConDataCons, getTyConDerivings, getTyConFamilySize, getTyConKind, getTyConTyVarTemplates, isBigTupleTyCon, isBoxedTyCon, isDataTyCon, isEnumerationTyCon, isLocalGenTyCon, isLocalSpecTyCon, isPrimTyCon, isSynTyCon, isTupleTyCon, isVisibleSynTyCon, maybeCharLikeTyCon, maybeDoubleLikeTyCon, maybeFloatLikeTyCon, maybeIntLikeTyCon, maybeSingleConstructorTyCon, mkDataTyCon, mkPrimTyCon, mkSpecTyCon, mkSynonymTyCon, mkTupleTyCon)
 import TyVar(TyVar, TyVarTemplate, alphaTyVars, alpha_tv, alpha_tyvar, beta_tv, beta_tyvar, cloneTyVar, cloneTyVarFromTemplate, cmpTyVar, delta_tv, delta_tyvar, epsilon_tv, epsilon_tyvar, eqTyVar, gamma_tv, gamma_tyvar, instantiateTyVarTemplates, ltTyVar, mkOpenSysTyVar, mkPolySysTyVar, mkSysTyVarTemplate, mkTemplateTyVars, mkUserTyVar, mkUserTyVarTemplate)
 import TyVarEnv(TyVarEnv(..), TypeEnv(..))
@@ -28,31 +21,30 @@ import UniTyFuns(applyNonSynTyCon, applySynTyCon, applyTy, applyTyCon, applyType
 import UniType(InstTyEnv(..), RhoType(..), SigmaType(..), TauType(..), ThetaType(..), UniType, alpha, alpha_ty, beta, beta_ty, cmpUniType, delta, delta_ty, epsilon, epsilon_ty, gamma, gamma_ty, instantiateTauTy, instantiateThetaTy, instantiateTy, mkDictTy, mkForallTy, mkRhoTy, mkSigmaTy, mkTyVarTemplateTy, mkTyVarTy, quantifyTy)
 import UniqFM(UniqFM)
 import Unique(Unique)
 import UniType(InstTyEnv(..), RhoType(..), SigmaType(..), TauType(..), ThetaType(..), UniType, alpha, alpha_ty, beta, beta_ty, cmpUniType, delta, delta_ty, epsilon, epsilon_ty, gamma, gamma_ty, instantiateTauTy, instantiateThetaTy, instantiateTy, mkDictTy, mkForallTy, mkRhoTy, mkSigmaTy, mkTyVarTemplateTy, mkTyVarTy, quantifyTy)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data Bag a 
+data Class 
+data ClassOp 
+data GlobalSwitch 
 type DataCon = Id
 type DataCon = Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
 type ClassInstEnv = [(UniType, InstTemplate)]
 type IdEnv a = UniqFM a
 type ClassInstEnv = [(UniType, InstTemplate)]
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
+data InstTemplate 
 type MatchEnv a b = [(a, b)]
 type MatchEnv a b = [(a, b)]
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
+data Labda a 
+data Name 
+data FullName 
+data ShortName 
+data ExportFlag 
+data PprStyle 
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data UnfoldingDetails  {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-}
+data PrettyRep 
+data PrimKind 
+data UnfoldingDetails 
 type Arity = Int
 type Arity = Int
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
 type InstTyEnv = [(TyVarTemplate, UniType)]
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
 type InstTyEnv = [(TyVarTemplate, UniType)]
@@ -60,509 +52,193 @@ type RhoType = UniType
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data UniType 
+data UniqFM a 
+data Unique 
 cmpClass :: Class -> Class -> Int#
 cmpClass :: Class -> Class -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 derivableClassKeys :: [Unique]
 derivableClassKeys :: [Unique]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 getClassBigSig :: Class -> (TyVarTemplate, [Class], [Id], [ClassOp], [Id], [Id])
 getClassBigSig :: Class -> (TyVarTemplate, [Class], [Id], [ClassOp], [Id], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AALLLLLLAA)" _N_ _N_ #-}
 getClassInstEnv :: Class -> [(UniType, InstTemplate)]
 getClassInstEnv :: Class -> [(UniType, InstTemplate)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [(UniType, InstTemplate)]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> u9; _NO_DEFLT_ } _N_ #-}
 getClassKey :: Class -> Unique
 getClassKey :: Class -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> u1; _NO_DEFLT_ } _N_ #-}
 getClassOpId :: Class -> ClassOp -> Id
 getClassOpId :: Class -> ClassOp -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AAAAAASAAA)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: [Id]) (u1 :: Int#) -> case _#_ minusInt# [] [u1, 1#] of { _PRIM_ (u2 :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u0, u2 ] } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Class) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (uc :: _PackedString) (ud :: Int) (ue :: UniType) -> case ud of { _ALG_ I# (uf :: Int#) -> case _#_ minusInt# [] [uf, 1#] of { _PRIM_ (ug :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u8, ug ] }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getClassOpLocalType :: ClassOp -> UniType
 getClassOpLocalType :: ClassOp -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u1 :: _PackedString) (u2 :: Int) (u3 :: UniType) -> u3; _NO_DEFLT_ } _N_ #-}
 getClassOpString :: ClassOp -> _PackedString
 getClassOpString :: ClassOp -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(SAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u1 :: _PackedString) (u2 :: Int) (u3 :: UniType) -> u1; _NO_DEFLT_ } _N_ #-}
 getClassOpTag :: ClassOp -> Int
 getClassOpTag :: ClassOp -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AU(P)A)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u1 :: _PackedString) (u2 :: Int) (u3 :: UniType) -> u2; _NO_DEFLT_ } _N_ #-}
 getClassOps :: Class -> [ClassOp]
 getClassOps :: Class -> [ClassOp]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAASAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [ClassOp]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> u6; _NO_DEFLT_ } _N_ #-}
 getClassSig :: Class -> (TyVarTemplate, [Class], [ClassOp])
 getClassSig :: Class -> (TyVarTemplate, [Class], [ClassOp])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AALLALAAAA)" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: TyVarTemplate) (u1 :: [Class]) (u2 :: [ClassOp]) -> _!_ _TUP_3 [TyVarTemplate, [Class], [ClassOp]] [u0, u1, u2] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> _!_ _TUP_3 [TyVarTemplate, [Class], [ClassOp]] [u3, u4, u6]; _NO_DEFLT_ } _N_ #-}
 getConstMethodId :: Class -> ClassOp -> UniType -> Id
 getConstMethodId :: Class -> ClassOp -> UniType -> Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(AAAAALSAAA)U(LU(P)L)L" {_A_ 4 _U_ 2212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getDefaultMethodId :: Class -> ClassOp -> Id
 getDefaultMethodId :: Class -> ClassOp -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AAAAAAASAA)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: [Id]) (u1 :: Int#) -> case _#_ minusInt# [] [u1, 1#] of { _PRIM_ (u2 :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u0, u2 ] } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Class) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (uc :: _PackedString) (ud :: Int) (ue :: UniType) -> case ud of { _ALG_ I# (uf :: Int#) -> case _#_ minusInt# [] [uf, 1#] of { _PRIM_ (ug :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u9, ug ] }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getSuperDictSelId :: Class -> Class -> Id
 getSuperDictSelId :: Class -> Class -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAASLAAAAA)L" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isNumericClass :: Class -> Bool
 isNumericClass :: Class -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isStandardClass :: Class -> Bool
 isStandardClass :: Class -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isSuperClassOf :: Class -> Class -> Labda [Class]
 isSuperClassOf :: Class -> Class -> Labda [Class]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(AAAAAAAAAS)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Class) (u1 :: [(Class, [Class])]) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ Maybes assocMaybe [ (Class), _N_ ] { [Class] } [ u1, u0 ] _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: Class) (u1 :: Class) -> case u1 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ Maybes assocMaybe [ (Class), _N_ ] { [Class] } [ ub, u0 ]; _NO_DEFLT_ } _N_ #-}
 mkClass :: Name -> TyVarTemplate -> [Class] -> [Id] -> [ClassOp] -> [Id] -> [Id] -> [(UniType, InstTemplate)] -> Class
 mkClass :: Name -> TyVarTemplate -> [Class] -> [Id] -> [ClassOp] -> [Id] -> [Id] -> [(UniType, InstTemplate)] -> Class
-       {-# GHC_PRAGMA _A_ 8 _U_ 12222222 _N_ _N_ _N_ _N_ #-}
 mkClassOp :: _PackedString -> Int -> UniType -> ClassOp
 mkClassOp :: _PackedString -> Int -> UniType -> ClassOp
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: _PackedString) (u1 :: Int) (u2 :: UniType) -> _!_ _ORIG_ Class MkClassOp [] [u0, u1, u2] _N_ #-}
-assocMaybe :: Eq a => [(a, b)] -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "LSL" _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ [Char], _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ TyVarTemplate, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Name, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Class, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ } #-}
 cmpTyCon :: TyCon -> TyCon -> Int#
 cmpTyCon :: TyCon -> TyCon -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 derivedFor :: Class -> TyCon -> Bool
 derivedFor :: Class -> TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 9 \ (u0 :: Class) (u1 :: TyCon) -> case u1 of { _ALG_ _ORIG_ TyCon DataTyCon (u2 :: Unique) (u3 :: FullName) (u4 :: Int) (u5 :: [TyVarTemplate]) (u6 :: [Id]) (u7 :: [Class]) (u8 :: Bool) -> _APP_  _WRKR_ _SPEC_ _ORIG_ Util isIn [ (Class) ] [ u0, u7 ]; (u9 :: TyCon) -> _!_ False [] [] } _N_ #-}
 eqTyCon :: TyCon -> TyCon -> Bool
 eqTyCon :: TyCon -> TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
 getTyConArity :: TyCon -> Int
 getTyConArity :: TyCon -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyConDataCons :: TyCon -> [Id]
 getTyConDataCons :: TyCon -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyConDerivings :: TyCon -> [Class]
 getTyConDerivings :: TyCon -> [Class]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: TyCon) -> case u0 of { _ALG_ _ORIG_ TyCon DataTyCon (u1 :: Unique) (u2 :: FullName) (u3 :: Int) (u4 :: [TyVarTemplate]) (u5 :: [Id]) (u6 :: [Class]) (u7 :: Bool) -> u6; _ORIG_ TyCon SpecTyCon (u8 :: TyCon) (u9 :: [Labda UniType]) -> _APP_  _TYAPP_  _ORIG_ Util panic { [Class] } [ _NOREP_S_ "getTyConDerivings:SpecTyCon" ]; (ua :: TyCon) -> _!_ _NIL_ [Class] [] } _N_ #-}
 getTyConFamilySize :: TyCon -> Labda Int
 getTyConFamilySize :: TyCon -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyConKind :: TyCon -> [PrimKind] -> PrimKind
 getTyConKind :: TyCon -> [PrimKind] -> PrimKind
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 8 \ (u0 :: TyCon) (u1 :: [PrimKind]) -> case u0 of { _ALG_ _ORIG_ TyCon PrimTyCon (u2 :: Unique) (u3 :: FullName) (u4 :: Int) (u5 :: [PrimKind] -> PrimKind) -> _APP_  u5 [ u1 ]; (u6 :: TyCon) -> _!_ _ORIG_ PrimKind PtrKind [] [] } _N_ #-}
 getTyConTyVarTemplates :: TyCon -> [TyVarTemplate]
 getTyConTyVarTemplates :: TyCon -> [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isBigTupleTyCon :: TyCon -> Bool
 isBigTupleTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isBoxedTyCon :: TyCon -> Bool
 isBoxedTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isDataTyCon :: TyCon -> Bool
 isDataTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isEnumerationTyCon :: TyCon -> Bool
 isEnumerationTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isLocalGenTyCon :: TyCon -> Bool
 isLocalGenTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isLocalSpecTyCon :: Bool -> TyCon -> Bool
 isLocalSpecTyCon :: Bool -> TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "LS" _N_ _N_ #-}
 isPrimTyCon :: TyCon -> Bool
 isPrimTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isSynTyCon :: TyCon -> Bool
 isSynTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: TyCon) -> case u0 of { _ALG_ _ORIG_ TyCon SynonymTyCon (u1 :: Unique) (u2 :: FullName) (u3 :: Int) (u4 :: [TyVarTemplate]) (u5 :: UniType) (u6 :: Bool) -> _!_ True [] []; _ORIG_ TyCon SpecTyCon (u7 :: TyCon) (u8 :: [Labda UniType]) -> _APP_  _TYAPP_  _ORIG_ Util panic { Bool } [ _NOREP_S_ "isSynTyCon: SpecTyCon" ]; (u9 :: TyCon) -> _!_ False [] [] } _N_ #-}
 isTupleTyCon :: TyCon -> Bool
 isTupleTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isVisibleSynTyCon :: TyCon -> Bool
 isVisibleSynTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyCon) -> case u0 of { _ALG_ _ORIG_ TyCon SynonymTyCon (u1 :: Unique) (u2 :: FullName) (u3 :: Int) (u4 :: [TyVarTemplate]) (u5 :: UniType) (u6 :: Bool) -> u6; (u7 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Bool } [ _NOREP_S_ "isVisibleSynTyCon" ] } _N_ #-}
 maybeCharLikeTyCon :: TyCon -> Labda Id
 maybeCharLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeDoubleLikeTyCon :: TyCon -> Labda Id
 maybeDoubleLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeFloatLikeTyCon :: TyCon -> Labda Id
 maybeFloatLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeIntLikeTyCon :: TyCon -> Labda Id
 maybeIntLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeSingleConstructorTyCon :: TyCon -> Labda Id
 maybeSingleConstructorTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkDataTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> [Id] -> [Class] -> Bool -> TyCon
 mkDataTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> [Id] -> [Class] -> Bool -> TyCon
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222 _N_ _N_ _F_ _IF_ARGS_ 0 7 XXXXXXX 8 \ (u0 :: Unique) (u1 :: FullName) (u2 :: Int) (u3 :: [TyVarTemplate]) (u4 :: [Id]) (u5 :: [Class]) (u6 :: Bool) -> _!_ _ORIG_ TyCon DataTyCon [] [u0, u1, u2, u3, u4, u5, u6] _N_ #-}
 mkPrimTyCon :: Unique -> FullName -> Int -> ([PrimKind] -> PrimKind) -> TyCon
 mkPrimTyCon :: Unique -> FullName -> Int -> ([PrimKind] -> PrimKind) -> TyCon
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: FullName) (u2 :: Int) (u3 :: [PrimKind] -> PrimKind) -> _!_ _ORIG_ TyCon PrimTyCon [] [u0, u1, u2, u3] _N_ #-}
 mkSpecTyCon :: TyCon -> [Labda UniType] -> TyCon
 mkSpecTyCon :: TyCon -> [Labda UniType] -> TyCon
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: TyCon) (u1 :: [Labda UniType]) -> _!_ _ORIG_ TyCon SpecTyCon [] [u0, u1] _N_ #-}
 mkSynonymTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> UniType -> Bool -> TyCon
 mkSynonymTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> UniType -> Bool -> TyCon
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _F_ _IF_ARGS_ 0 6 XXXXXX 7 \ (u0 :: Unique) (u1 :: FullName) (u2 :: Int) (u3 :: [TyVarTemplate]) (u4 :: UniType) (u5 :: Bool) -> _!_ _ORIG_ TyCon SynonymTyCon [] [u0, u1, u2, u3, u4, u5] _N_ #-}
 mkTupleTyCon :: Int -> TyCon
 mkTupleTyCon :: Int -> TyCon
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ TyCon TupleTyCon [] [u0] _N_ #-}
 alphaTyVars :: [TyVarTemplate]
 alphaTyVars :: [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 alpha_tv :: TyVarTemplate
 alpha_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 alpha_tyvar :: TyVar
 alpha_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 beta_tv :: TyVarTemplate
 beta_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 beta_tyvar :: TyVar
 beta_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cloneTyVar :: TyVar -> Unique -> TyVar
 cloneTyVar :: TyVar -> Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 cloneTyVarFromTemplate :: TyVarTemplate -> Unique -> TyVar
 cloneTyVarFromTemplate :: TyVarTemplate -> Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: TyVarTemplate) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u2 :: Unique) (u3 :: _PackedString) -> _!_ _ORIG_ TyVar PolySysTyVar [] [u1]; _ORIG_ TyVar UserTyVarTemplate (u4 :: Unique) (u5 :: ShortName) -> _!_ _ORIG_ TyVar UserTyVar [] [u1, u5]; _NO_DEFLT_ } _N_ #-}
 cmpTyVar :: TyVar -> TyVar -> Int#
 cmpTyVar :: TyVar -> TyVar -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 delta_tv :: TyVarTemplate
 delta_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 delta_tyvar :: TyVar
 delta_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 epsilon_tv :: TyVarTemplate
 epsilon_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 epsilon_tyvar :: TyVar
 epsilon_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqTyVar :: TyVar -> TyVar -> Bool
 eqTyVar :: TyVar -> TyVar -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
 gamma_tv :: TyVarTemplate
 gamma_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gamma_tyvar :: TyVar
 gamma_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instantiateTyVarTemplates :: [TyVarTemplate] -> [Unique] -> ([(TyVarTemplate, UniType)], [TyVar], [UniType])
 instantiateTyVarTemplates :: [TyVarTemplate] -> [Unique] -> ([(TyVarTemplate, UniType)], [TyVar], [UniType])
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _N_ _N_ _N_ #-}
 ltTyVar :: TyVar -> TyVar -> Bool
 ltTyVar :: TyVar -> TyVar -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 mkOpenSysTyVar :: Unique -> TyVar
 mkOpenSysTyVar :: Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Unique) -> _!_ _ORIG_ TyVar OpenSysTyVar [] [u0] _N_ #-}
 mkPolySysTyVar :: Unique -> TyVar
 mkPolySysTyVar :: Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Unique) -> _!_ _ORIG_ TyVar PolySysTyVar [] [u0] _N_ #-}
 mkSysTyVarTemplate :: Unique -> _PackedString -> TyVarTemplate
 mkSysTyVarTemplate :: Unique -> _PackedString -> TyVarTemplate
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: _PackedString) -> _!_ _ORIG_ TyVar SysTyVarTemplate [] [u0, u1] _N_ #-}
 mkTemplateTyVars :: [TyVar] -> [TyVarTemplate]
 mkTemplateTyVars :: [TyVar] -> [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkUserTyVar :: Unique -> ShortName -> TyVar
 mkUserTyVar :: Unique -> ShortName -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: ShortName) -> _!_ _ORIG_ TyVar UserTyVar [] [u0, u1] _N_ #-}
 mkUserTyVarTemplate :: Unique -> ShortName -> TyVarTemplate
 mkUserTyVarTemplate :: Unique -> ShortName -> TyVarTemplate
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: ShortName) -> _!_ _ORIG_ TyVar UserTyVarTemplate [] [u0, u1] _N_ #-}
 applyNonSynTyCon :: TyCon -> [UniType] -> UniType
 applyNonSynTyCon :: TyCon -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: TyCon) (u1 :: [UniType]) -> _!_ _ORIG_ UniType UniData [] [u0, u1] _N_ #-}
 applySynTyCon :: TyCon -> [UniType] -> UniType
 applySynTyCon :: TyCon -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 applyTy :: UniType -> UniType -> UniType
 applyTy :: UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 applyTyCon :: TyCon -> [UniType] -> UniType
 applyTyCon :: TyCon -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 applyTypeEnvToThetaTy :: UniqFM UniType -> [(a, UniType)] -> [(a, UniType)]
 applyTypeEnvToThetaTy :: UniqFM UniType -> [(a, UniType)] -> [(a, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 applyTypeEnvToTy :: UniqFM UniType -> UniType -> UniType
 applyTypeEnvToTy :: UniqFM UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 cmpUniTypeMaybeList :: [Labda UniType] -> [Labda UniType] -> Int#
 cmpUniTypeMaybeList :: [Labda UniType] -> [Labda UniType] -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 expandVisibleTySyn :: UniType -> UniType
 expandVisibleTySyn :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarTemplatesFromTy :: UniType -> [TyVarTemplate]
 extractTyVarTemplatesFromTy :: UniType -> [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarsFromTy :: UniType -> [TyVar]
 extractTyVarsFromTy :: UniType -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarsFromTys :: [UniType] -> [TyVar]
 extractTyVarsFromTys :: [UniType] -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 funResultTy :: UniType -> Int -> UniType
 funResultTy :: UniType -> Int -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getMentionedTyCons :: TyCon -> [TyCon]
 getMentionedTyCons :: TyCon -> [TyCon]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getMentionedTyConsAndClassesFromClass :: Class -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromClass :: Class -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "U(LLLLLSLLLL)" _N_ _N_ #-}
 getMentionedTyConsAndClassesFromTyCon :: TyCon -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromTyCon :: TyCon -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getMentionedTyConsAndClassesFromUniType :: UniType -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromUniType :: UniType -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTauType :: UniType -> UniType
 getTauType :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 4 \ (u0 :: UniType) -> case _APP_  _ORIG_ UniTyFuns splitType [ u0 ] of { _ALG_ _TUP_3 (u1 :: [TyVarTemplate]) (u2 :: [(Class, UniType)]) (u3 :: UniType) -> u3; _NO_DEFLT_ } _N_ #-}
 getTyVar :: [Char] -> UniType -> TyVar
 getTyVar :: [Char] -> UniType -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 getTyVarMaybe :: UniType -> Labda TyVar
 getTyVarMaybe :: UniType -> Labda TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyVarTemplateMaybe :: UniType -> Labda TyVarTemplate
 getTyVarTemplateMaybe :: UniType -> Labda TyVarTemplate
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTypeString :: UniType -> [_PackedString]
 getTypeString :: UniType -> [_PackedString]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataSpecTyCon :: UniType -> (TyCon, [UniType], [Id])
 getUniDataSpecTyCon :: UniType -> (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataSpecTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
 getUniDataSpecTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataTyCon :: UniType -> (TyCon, [UniType], [Id])
 getUniDataTyCon :: UniType -> (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
 getUniDataTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniTyDescription :: UniType -> [Char]
 getUniTyDescription :: UniType -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 glueTyArgs :: [UniType] -> UniType -> UniType
 glueTyArgs :: [UniType] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instanceIsExported :: Class -> UniType -> Bool -> Bool
 instanceIsExported :: Class -> UniType -> Bool -> Bool
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AU(AASLAA)AAAAAAAA)SL" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isDictTy :: UniType -> Bool
 isDictTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isForAllTy :: UniType -> Bool
 isForAllTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isFunType :: UniType -> Bool
 isFunType :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isGroundOrTyVarTy :: UniType -> Bool
 isGroundOrTyVarTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isGroundTy :: UniType -> Bool
 isGroundTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isLeakFreeType :: [TyCon] -> UniType -> Bool
 isLeakFreeType :: [TyCon] -> UniType -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 isPrimType :: UniType -> Bool
 isPrimType :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTauTy :: UniType -> Bool
 isTauTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTyVarTemplateTy :: UniType -> Bool
 isTyVarTemplateTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTyVarTy :: UniType -> Bool
 isTyVarTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isUnboxedDataType :: UniType -> Bool
 isUnboxedDataType :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 kindFromType :: UniType -> PrimKind
 kindFromType :: UniType -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mapOverTyVars :: (TyVar -> UniType) -> UniType -> UniType
 mapOverTyVars :: (TyVar -> UniType) -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 matchTy :: UniType -> UniType -> Labda [(TyVarTemplate, UniType)]
 matchTy :: UniType -> UniType -> Labda [(TyVarTemplate, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 maybeBoxedPrimType :: UniType -> Labda (Id, UniType)
 maybeBoxedPrimType :: UniType -> Labda (Id, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 maybePurelyLocalClass :: Class -> Labda [Int -> Bool -> PrettyRep]
 maybePurelyLocalClass :: Class -> Labda [Int -> Bool -> PrettyRep]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "U(LLLLLSLLLL)" _N_ _N_ #-}
 maybePurelyLocalTyCon :: TyCon -> Labda [Int -> Bool -> PrettyRep]
 maybePurelyLocalTyCon :: TyCon -> Labda [Int -> Bool -> PrettyRep]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 maybePurelyLocalType :: UniType -> Labda [Int -> Bool -> PrettyRep]
 maybePurelyLocalType :: UniType -> Labda [Int -> Bool -> PrettyRep]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeUnpackFunTy :: UniType -> Labda (UniType, UniType)
 maybeUnpackFunTy :: UniType -> Labda (UniType, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkSuperDictSelType :: Class -> Class -> UniType
 mkSuperDictSelType :: Class -> Class -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "U(LLLLLLLLLL)L" _N_ _N_ #-}
 pprClassOp :: PprStyle -> ClassOp -> Int -> Bool -> PrettyRep
 pprClassOp :: PprStyle -> ClassOp -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 pprIfaceClass :: (GlobalSwitch -> Bool) -> (Id -> Id) -> UniqFM UnfoldingDetails -> Class -> Int -> Bool -> PrettyRep
 pprIfaceClass :: (GlobalSwitch -> Bool) -> (Id -> Id) -> UniqFM UnfoldingDetails -> Class -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222122 _N_ _S_ "LLLU(ALLLLLLLAA)" _N_ _N_ #-}
 pprMaybeTy :: PprStyle -> Labda UniType -> Int -> Bool -> PrettyRep
 pprMaybeTy :: PprStyle -> Labda UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "SS" _N_ _N_ #-}
 pprParendUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
 pprParendUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 pprTyCon :: PprStyle -> TyCon -> [[Labda UniType]] -> Int -> Bool -> PrettyRep
 pprTyCon :: PprStyle -> TyCon -> [[Labda UniType]] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "SSL" _N_ _N_ #-}
 pprUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
 pprUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 returnsRealWorld :: UniType -> Bool
 returnsRealWorld :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 showTyCon :: PprStyle -> TyCon -> [Char]
 showTyCon :: PprStyle -> TyCon -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 showTypeCategory :: UniType -> Char
 showTypeCategory :: UniType -> Char
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 specMaybeTysSuffix :: [Labda UniType] -> _PackedString
 specMaybeTysSuffix :: [Labda UniType] -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 specialiseTy :: UniType -> [Labda UniType] -> Int -> UniType
 specialiseTy :: UniType -> [Labda UniType] -> Int -> UniType
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "SLL" _N_ _N_ #-}
 splitDictType :: UniType -> (Class, UniType)
 splitDictType :: UniType -> (Class, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 splitForalls :: UniType -> ([TyVarTemplate], UniType)
 splitForalls :: UniType -> ([TyVarTemplate], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 splitTyArgs :: UniType -> ([UniType], UniType)
 splitTyArgs :: UniType -> ([UniType], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 splitType :: UniType -> ([TyVarTemplate], [(Class, UniType)], UniType)
 splitType :: UniType -> ([TyVarTemplate], [(Class, UniType)], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 splitTypeWithDictsAsArgs :: UniType -> ([TyVarTemplate], [UniType], UniType)
 splitTypeWithDictsAsArgs :: UniType -> ([TyVarTemplate], [UniType], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 typeMaybeString :: Labda UniType -> [_PackedString]
 typeMaybeString :: Labda UniType -> [_PackedString]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unDictifyTy :: UniType -> UniType
 unDictifyTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 alpha :: UniType
 alpha :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar alpha_tv] _N_ #-}
 alpha_ty :: UniType
 alpha_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar alpha_tyvar] _N_ #-}
 beta :: UniType
 beta :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar beta_tv] _N_ #-}
 beta_ty :: UniType
 beta_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar beta_tyvar] _N_ #-}
 cmpUniType :: Bool -> UniType -> UniType -> Int#
 cmpUniType :: Bool -> UniType -> UniType -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 delta :: UniType
 delta :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar delta_tv] _N_ #-}
 delta_ty :: UniType
 delta_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar delta_tyvar] _N_ #-}
 epsilon :: UniType
 epsilon :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar epsilon_tv] _N_ #-}
 epsilon_ty :: UniType
 epsilon_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar epsilon_tyvar] _N_ #-}
 gamma :: UniType
 gamma :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar gamma_tv] _N_ #-}
 gamma_ty :: UniType
 gamma_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar gamma_tyvar] _N_ #-}
 instantiateTauTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
 instantiateTauTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniType instantiateTy _N_ #-}
 instantiateThetaTy :: [(TyVarTemplate, UniType)] -> [(Class, UniType)] -> [(Class, UniType)]
 instantiateThetaTy :: [(TyVarTemplate, UniType)] -> [(Class, UniType)] -> [(Class, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 instantiateTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
 instantiateTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ #-}
 mkDictTy :: Class -> UniType -> UniType
 mkDictTy :: Class -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Class) (u1 :: UniType) -> _!_ _ORIG_ UniType UniDict [] [u0, u1] _N_ #-}
 mkForallTy :: [TyVarTemplate] -> UniType -> UniType
 mkForallTy :: [TyVarTemplate] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mkRhoTy :: [(Class, UniType)] -> UniType -> UniType
 mkRhoTy :: [(Class, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mkSigmaTy :: [TyVarTemplate] -> [(Class, UniType)] -> UniType -> UniType
 mkSigmaTy :: [TyVarTemplate] -> [(Class, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SLL" _N_ _N_ #-}
 mkTyVarTemplateTy :: TyVarTemplate -> UniType
 mkTyVarTemplateTy :: TyVarTemplate -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVarTemplate) -> _!_ _ORIG_ UniType UniTyVarTemplate [] [u0] _N_ #-}
 mkTyVarTy :: TyVar -> UniType
 mkTyVarTy :: TyVar -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _!_ _ORIG_ UniType UniTyVar [] [u0] _N_ #-}
 quantifyTy :: [TyVar] -> UniType -> ([TyVarTemplate], UniType)
 quantifyTy :: [TyVar] -> UniType -> ([TyVarTemplate], UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 instance Eq Class
 instance Eq Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Class -> Class -> Bool), (Class -> Class -> Bool)] [_CONSTM_ Eq (==) (Class), _CONSTM_ Eq (/=) (Class)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ eqInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Eq (/=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq ClassOp
 instance Eq ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool)] [_CONSTM_ Eq (==) (ClassOp), _CONSTM_ Eq (/=) (ClassOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq TyCon
 instance Eq TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVar
 instance Eq TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool)] [_CONSTM_ Eq (==) (TyVar), _CONSTM_ Eq (/=) (TyVar)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVarTemplate
 instance Eq TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool)] [_CONSTM_ Eq (==) (TyVarTemplate), _CONSTM_ Eq (/=) (TyVarTemplate)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq UniType
 instance Eq UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UniType -> UniType -> Bool), (UniType -> UniType -> Bool)] [_CONSTM_ Eq (==) (UniType), _CONSTM_ Eq (/=) (UniType)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq Unique
 instance Eq Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord Class
 instance Ord Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Class}}, (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Class), (Class -> Class -> Class), (Class -> Class -> _CMP_TAG)] [_DFUN_ Eq (Class), _CONSTM_ Ord (<) (Class), _CONSTM_ Ord (<=) (Class), _CONSTM_ Ord (>=) (Class), _CONSTM_ Ord (>) (Class), _CONSTM_ Ord max (Class), _CONSTM_ Ord min (Class), _CONSTM_ Ord _tagCmp (Class)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ ltInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ leInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord ClassOp
 instance Ord ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq ClassOp}}, (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> _CMP_TAG)] [_DFUN_ Eq (ClassOp), _CONSTM_ Ord (<) (ClassOp), _CONSTM_ Ord (<=) (ClassOp), _CONSTM_ Ord (>=) (ClassOp), _CONSTM_ Ord (>) (ClassOp), _CONSTM_ Ord max (ClassOp), _CONSTM_ Ord min (ClassOp), _CONSTM_ Ord _tagCmp (ClassOp)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ ltInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ leInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ geInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ geInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ gtInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ gtInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord TyCon
 instance Ord TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVar
 instance Ord TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVar}}, (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> _CMP_TAG)] [_DFUN_ Eq (TyVar), _CONSTM_ Ord (<) (TyVar), _CONSTM_ Ord (<=) (TyVar), _CONSTM_ Ord (>=) (TyVar), _CONSTM_ Ord (>) (TyVar), _CONSTM_ Ord max (TyVar), _CONSTM_ Ord min (TyVar), _CONSTM_ Ord _tagCmp (TyVar)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVarTemplate
 instance Ord TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVarTemplate}}, (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> TyVarTemplate), (TyVarTemplate -> TyVarTemplate -> TyVarTemplate), (TyVarTemplate -> TyVarTemplate -> _CMP_TAG)] [_DFUN_ Eq (TyVarTemplate), _CONSTM_ Ord (<) (TyVarTemplate), _CONSTM_ Ord (<=) (TyVarTemplate), _CONSTM_ Ord (>=) (TyVarTemplate), _CONSTM_ Ord (>) (TyVarTemplate), _CONSTM_ Ord max (TyVarTemplate), _CONSTM_ Ord min (TyVarTemplate), _CONSTM_ Ord _tagCmp (TyVarTemplate)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord Unique
 instance Ord Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Class
 instance NamedThing Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Class -> ExportFlag), (Class -> Bool), (Class -> (_PackedString, _PackedString)), (Class -> _PackedString), (Class -> [_PackedString]), (Class -> SrcLoc), (Class -> Unique), (Class -> Bool), (Class -> UniType), (Class -> Bool)] [_CONSTM_ NamedThing getExportFlag (Class), _CONSTM_ NamedThing isLocallyDefined (Class), _CONSTM_ NamedThing getOrigName (Class), _CONSTM_ NamedThing getOccurrenceName (Class), _CONSTM_ NamedThing getInformingModules (Class), _CONSTM_ NamedThing getSrcLoc (Class), _CONSTM_ NamedThing getTheUnique (Class), _CONSTM_ NamedThing hasType (Class), _CONSTM_ NamedThing getType (Class), _CONSTM_ NamedThing fromPreludeCore (Class)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(LLAAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [ub, uc]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(ALSAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAAAS)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ug; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Unique) } [ _NOREP_S_ "NamedThing.Class.getTheUnique", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Bool) } [ _NOREP_S_ "NamedThing.Class.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> UniType) } [ _NOREP_S_ "NamedThing.Class.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing FullName
 instance NamedThing FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(FullName -> ExportFlag), (FullName -> Bool), (FullName -> (_PackedString, _PackedString)), (FullName -> _PackedString), (FullName -> [_PackedString]), (FullName -> SrcLoc), (FullName -> Unique), (FullName -> Bool), (FullName -> UniType), (FullName -> Bool)] [_CONSTM_ NamedThing getExportFlag (FullName), _CONSTM_ NamedThing isLocallyDefined (FullName), _CONSTM_ NamedThing getOrigName (FullName), _CONSTM_ NamedThing getOccurrenceName (FullName), _CONSTM_ NamedThing getInformingModules (FullName), _CONSTM_ NamedThing getSrcLoc (FullName), _CONSTM_ NamedThing getTheUnique (FullName), _CONSTM_ NamedThing hasType (FullName), _CONSTM_ NamedThing getType (FullName), _CONSTM_ NamedThing fromPreludeCore (FullName)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAEAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u4; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ThisModule  -> _!_ True [] []; _ORIG_ NameTypes InventedInThisModule  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LLAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [u1, u2]; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(ALSAAA)" {_A_ 2 _U_ 11 _N_ _N_ _F_ _IF_ARGS_ 0 2 XC 10 \ (u0 :: _PackedString) (u1 :: Provenance) -> case u1 of { _ALG_ _ORIG_ NameTypes OtherPrelude (u2 :: _PackedString) -> u2; _ORIG_ NameTypes OtherModule (u3 :: _PackedString) (u4 :: [_PackedString]) -> u3; (u5 :: Provenance) -> u0 } _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_  _TYAPP_  patError# { (FullName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ExportedByPreludeCore  -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore  -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 instance NamedThing ShortName
 instance NamedThing ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ShortName -> ExportFlag), (ShortName -> Bool), (ShortName -> (_PackedString, _PackedString)), (ShortName -> _PackedString), (ShortName -> [_PackedString]), (ShortName -> SrcLoc), (ShortName -> Unique), (ShortName -> Bool), (ShortName -> UniType), (ShortName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ShortName), _CONSTM_ NamedThing isLocallyDefined (ShortName), _CONSTM_ NamedThing getOrigName (ShortName), _CONSTM_ NamedThing getOccurrenceName (ShortName), _CONSTM_ NamedThing getInformingModules (ShortName), _CONSTM_ NamedThing getSrcLoc (ShortName), _CONSTM_ NamedThing getTheUnique (ShortName), _CONSTM_ NamedThing hasType (ShortName), _CONSTM_ NamedThing getType (ShortName), _CONSTM_ NamedThing fromPreludeCore (ShortName)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(SA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u1; _NO_DEFLT_ } _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u2; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_  _TYAPP_  patError# { (ShortName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AA)" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 instance NamedThing TyCon
 instance NamedThing TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance NamedThing TyVar
 instance NamedThing TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVar -> ExportFlag), (TyVar -> Bool), (TyVar -> (_PackedString, _PackedString)), (TyVar -> _PackedString), (TyVar -> [_PackedString]), (TyVar -> SrcLoc), (TyVar -> Unique), (TyVar -> Bool), (TyVar -> UniType), (TyVar -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVar), _CONSTM_ NamedThing isLocallyDefined (TyVar), _CONSTM_ NamedThing getOrigName (TyVar), _CONSTM_ NamedThing getOccurrenceName (TyVar), _CONSTM_ NamedThing getInformingModules (TyVar), _CONSTM_ NamedThing getSrcLoc (TyVar), _CONSTM_ NamedThing getTheUnique (TyVar), _CONSTM_ NamedThing hasType (TyVar), _CONSTM_ NamedThing getType (TyVar), _CONSTM_ NamedThing fromPreludeCore (TyVar)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVar" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar UserTyVar (u1 :: Unique) (u2 :: ShortName) -> case u2 of { _ALG_ _ORIG_ NameTypes ShortName (u3 :: _PackedString) (u4 :: SrcLoc) -> u4; _NO_DEFLT_ }; (u5 :: TyVar) -> _ORIG_ SrcLoc mkUnknownSrcLoc } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar PolySysTyVar (u1 :: Unique) -> u1; _ORIG_ TyVar PrimSysTyVar (u2 :: Unique) -> u2; _ORIG_ TyVar OpenSysTyVar (u3 :: Unique) -> u3; _ORIG_ TyVar UserTyVar (u4 :: Unique) (u5 :: ShortName) -> u4; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ False [] [] _N_ #-}
 instance NamedThing TyVarTemplate
 instance NamedThing TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVarTemplate -> ExportFlag), (TyVarTemplate -> Bool), (TyVarTemplate -> (_PackedString, _PackedString)), (TyVarTemplate -> _PackedString), (TyVarTemplate -> [_PackedString]), (TyVarTemplate -> SrcLoc), (TyVarTemplate -> Unique), (TyVarTemplate -> Bool), (TyVarTemplate -> UniType), (TyVarTemplate -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVarTemplate), _CONSTM_ NamedThing isLocallyDefined (TyVarTemplate), _CONSTM_ NamedThing getOrigName (TyVarTemplate), _CONSTM_ NamedThing getOccurrenceName (TyVarTemplate), _CONSTM_ NamedThing getInformingModules (TyVarTemplate), _CONSTM_ NamedThing getSrcLoc (TyVarTemplate), _CONSTM_ NamedThing getTheUnique (TyVarTemplate), _CONSTM_ NamedThing hasType (TyVarTemplate), _CONSTM_ NamedThing getType (TyVarTemplate), _CONSTM_ NamedThing fromPreludeCore (TyVarTemplate)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVarTemplate" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: TyVarTemplate) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u1 :: Unique) (u2 :: _PackedString) -> _ORIG_ SrcLoc mkUnknownSrcLoc; _ORIG_ TyVar UserTyVarTemplate (u3 :: Unique) (u4 :: ShortName) -> case u4 of { _ALG_ _ORIG_ NameTypes ShortName (u5 :: _PackedString) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: TyVarTemplate) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u1 :: Unique) (u2 :: _PackedString) -> u1; _ORIG_ TyVar UserTyVarTemplate (u3 :: Unique) (u4 :: ShortName) -> u3; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  patError# { (TyVarTemplate -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  patError# { (TyVarTemplate -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ False [] [] _N_ #-}
 instance Outputable Class
 instance Outputable Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Class) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(AU(LLLLAA)AAAAAAAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ClassOp
 instance Outputable ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable FullName
 instance Outputable FullName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FullName) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LLLLAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ShortName
 instance Outputable ShortName
-       {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ShortName) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AU(LA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable TyCon
 instance Outputable TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVar
 instance Outputable TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVar) _N_
-        ppr = _A_ 2 _U_ 1122 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVarTemplate
 instance Outputable TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVarTemplate) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable UniType
 instance Outputable UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_ #-}
 instance Text Unique
 instance Text Unique
-       {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-        readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-        showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-        readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-        showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
 
index 925e012..02bb5f7 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Class where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Class where
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
-import InstEnv(InstTemplate, InstTy)
+import Id(Id)
+import InstEnv(InstTemplate)
 import Maybes(Labda)
 import Name(Name)
 import Maybes(Labda)
 import Name(Name)
-import NameTypes(FullName, Provenance, ShortName)
-import Outputable(ExportFlag, NamedThing, Outputable)
+import NameTypes(FullName, ShortName)
+import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PreludePS(_PackedString)
-import SrcLoc(SrcLoc)
 import TyCon(TyCon)
 import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
+import TyVar(TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
 data Class   = MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])]
 data ClassOp   = MkClassOp _PackedString Int UniType
 import UniType(UniType)
 import Unique(Unique)
 data Class   = MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])]
 data ClassOp   = MkClassOp _PackedString Int UniType
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Id 
+data InstTemplate 
+data Labda a 
+data Name 
+data FullName 
+data TyVarTemplate 
+data UniType 
+data Unique 
 cmpClass :: Class -> Class -> Int#
 cmpClass :: Class -> Class -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 derivableClassKeys :: [Unique]
 derivableClassKeys :: [Unique]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 getClassBigSig :: Class -> (TyVarTemplate, [Class], [Id], [ClassOp], [Id], [Id])
 getClassBigSig :: Class -> (TyVarTemplate, [Class], [Id], [ClassOp], [Id], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AALLLLLLAA)" _N_ _N_ #-}
 getClassInstEnv :: Class -> [(UniType, InstTemplate)]
 getClassInstEnv :: Class -> [(UniType, InstTemplate)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [(UniType, InstTemplate)]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> u9; _NO_DEFLT_ } _N_ #-}
 getClassKey :: Class -> Unique
 getClassKey :: Class -> Unique
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> u1; _NO_DEFLT_ } _N_ #-}
 getClassOpId :: Class -> ClassOp -> Id
 getClassOpId :: Class -> ClassOp -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AAAAAASAAA)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: [Id]) (u1 :: Int#) -> case _#_ minusInt# [] [u1, 1#] of { _PRIM_ (u2 :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u0, u2 ] } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Class) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (uc :: _PackedString) (ud :: Int) (ue :: UniType) -> case ud of { _ALG_ I# (uf :: Int#) -> case _#_ minusInt# [] [uf, 1#] of { _PRIM_ (ug :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u8, ug ] }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getClassOpLocalType :: ClassOp -> UniType
 getClassOpLocalType :: ClassOp -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u1 :: _PackedString) (u2 :: Int) (u3 :: UniType) -> u3; _NO_DEFLT_ } _N_ #-}
 getClassOpString :: ClassOp -> _PackedString
 getClassOpString :: ClassOp -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(SAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u1 :: _PackedString) (u2 :: Int) (u3 :: UniType) -> u1; _NO_DEFLT_ } _N_ #-}
 getClassOpTag :: ClassOp -> Int
 getClassOpTag :: ClassOp -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AU(P)A)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u1 :: _PackedString) (u2 :: Int) (u3 :: UniType) -> u2; _NO_DEFLT_ } _N_ #-}
 getClassOps :: Class -> [ClassOp]
 getClassOps :: Class -> [ClassOp]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAAASAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: [ClassOp]) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> u6; _NO_DEFLT_ } _N_ #-}
 getClassSig :: Class -> (TyVarTemplate, [Class], [ClassOp])
 getClassSig :: Class -> (TyVarTemplate, [Class], [ClassOp])
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AALLALAAAA)" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: TyVarTemplate) (u1 :: [Class]) (u2 :: [ClassOp]) -> _!_ _TUP_3 [TyVarTemplate, [Class], [ClassOp]] [u0, u1, u2] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> _!_ _TUP_3 [TyVarTemplate, [Class], [ClassOp]] [u3, u4, u6]; _NO_DEFLT_ } _N_ #-}
 getConstMethodId :: Class -> ClassOp -> UniType -> Id
 getConstMethodId :: Class -> ClassOp -> UniType -> Id
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(AAAAALSAAA)U(LU(P)L)L" {_A_ 4 _U_ 2212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getDefaultMethodId :: Class -> ClassOp -> Id
 getDefaultMethodId :: Class -> ClassOp -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AAAAAAASAA)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: [Id]) (u1 :: Int#) -> case _#_ minusInt# [] [u1, 1#] of { _PRIM_ (u2 :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u0, u2 ] } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Class) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (uc :: _PackedString) (ud :: Int) (ue :: UniType) -> case ud of { _ALG_ I# (uf :: Int#) -> case _#_ minusInt# [] [uf, 1#] of { _PRIM_ (ug :: Int#) -> _APP_  _TYAPP_  _WRKR_ _SPEC_ _ORIG_ PreludeList (!!) [ (Int), _N_ ] { Id } [ u9, ug ] }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getSuperDictSelId :: Class -> Class -> Id
 getSuperDictSelId :: Class -> Class -> Id
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAASLAAAAA)L" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isNumericClass :: Class -> Bool
 isNumericClass :: Class -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isStandardClass :: Class -> Bool
 isStandardClass :: Class -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAAAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isSuperClassOf :: Class -> Class -> Labda [Class]
 isSuperClassOf :: Class -> Class -> Labda [Class]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(AAAAAAAAAS)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Class) (u1 :: [(Class, [Class])]) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ Maybes assocMaybe [ (Class), _N_ ] { [Class] } [ u1, u0 ] _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: Class) (u1 :: Class) -> case u1 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ Maybes assocMaybe [ (Class), _N_ ] { [Class] } [ ub, u0 ]; _NO_DEFLT_ } _N_ #-}
 mkClass :: Name -> TyVarTemplate -> [Class] -> [Id] -> [ClassOp] -> [Id] -> [Id] -> [(UniType, InstTemplate)] -> Class
 mkClass :: Name -> TyVarTemplate -> [Class] -> [Id] -> [ClassOp] -> [Id] -> [Id] -> [(UniType, InstTemplate)] -> Class
-       {-# GHC_PRAGMA _A_ 8 _U_ 12222222 _N_ _N_ _N_ _N_ #-}
 mkClassOp :: _PackedString -> Int -> UniType -> ClassOp
 mkClassOp :: _PackedString -> Int -> UniType -> ClassOp
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: _PackedString) (u1 :: Int) (u2 :: UniType) -> _!_ _ORIG_ Class MkClassOp [] [u0, u1, u2] _N_ #-}
 instance Eq Class
 instance Eq Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Class -> Class -> Bool), (Class -> Class -> Bool)] [_CONSTM_ Eq (==) (Class), _CONSTM_ Eq (/=) (Class)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ eqInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Eq (/=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Eq ClassOp
 instance Eq ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool)] [_CONSTM_ Eq (==) (ClassOp), _CONSTM_ Eq (/=) (ClassOp)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord Class
 instance Ord Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Class}}, (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Class), (Class -> Class -> Class), (Class -> Class -> _CMP_TAG)] [_DFUN_ Eq (Class), _CONSTM_ Ord (<) (Class), _CONSTM_ Ord (<=) (Class), _CONSTM_ Ord (>=) (Class), _CONSTM_ Ord (>) (Class), _CONSTM_ Ord max (Class), _CONSTM_ Ord min (Class), _CONSTM_ Ord _tagCmp (Class)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ ltInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ leInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_  _CONSTM_ Ord (>) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord ClassOp
 instance Ord ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq ClassOp}}, (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> _CMP_TAG)] [_DFUN_ Eq (ClassOp), _CONSTM_ Ord (<) (ClassOp), _CONSTM_ Ord (<=) (ClassOp), _CONSTM_ Ord (>=) (ClassOp), _CONSTM_ Ord (>) (ClassOp), _CONSTM_ Ord max (ClassOp), _CONSTM_ Ord min (ClassOp), _CONSTM_ Ord _tagCmp (ClassOp)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ ltInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ leInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ geInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ geInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ gtInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ gtInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance NamedThing Class
 instance NamedThing Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Class -> ExportFlag), (Class -> Bool), (Class -> (_PackedString, _PackedString)), (Class -> _PackedString), (Class -> [_PackedString]), (Class -> SrcLoc), (Class -> Unique), (Class -> Bool), (Class -> UniType), (Class -> Bool)] [_CONSTM_ NamedThing getExportFlag (Class), _CONSTM_ NamedThing isLocallyDefined (Class), _CONSTM_ NamedThing getOrigName (Class), _CONSTM_ NamedThing getOccurrenceName (Class), _CONSTM_ NamedThing getInformingModules (Class), _CONSTM_ NamedThing getSrcLoc (Class), _CONSTM_ NamedThing getTheUnique (Class), _CONSTM_ NamedThing hasType (Class), _CONSTM_ NamedThing getType (Class), _CONSTM_ NamedThing fromPreludeCore (Class)] _N_
-        getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(LLAAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [ub, uc]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(ALSAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAAAS)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ug; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Unique) } [ _NOREP_S_ "NamedThing.Class.getTheUnique", u0 ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> Bool) } [ _NOREP_S_ "NamedThing.Class.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_  _TYAPP_  _ORIG_ Util panic { (Class -> UniType) } [ _NOREP_S_ "NamedThing.Class.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Class
 instance Outputable Class
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Class) _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(AU(LLLLAA)AAAAAAAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable ClassOp
 instance Outputable ClassOp
-       {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_
-        ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index d75b2bc..999eb7c 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TyCon where
 import Class(Class, ClassOp)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface TyCon where
 import Class(Class, ClassOp)
-import Id(DataCon(..), Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(DataCon(..), Id)
 import InstEnv(InstTemplate)
 import Maybes(Labda)
 import InstEnv(InstTemplate)
 import Maybes(Labda)
-import NameTypes(FullName, Provenance, ShortName)
-import Outputable(ExportFlag, NamedThing, Outputable)
-import PreludePS(_PackedString)
+import NameTypes(FullName)
+import Outputable(NamedThing, Outputable)
 import PrimKind(PrimKind)
 import PrimKind(PrimKind)
-import SrcLoc(SrcLoc)
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
 type Arity = Int
 import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
 type Arity = Int
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Class 
 type DataCon = Id
 type DataCon = Id
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data Id 
+data Labda a 
+data FullName 
+data PrimKind 
 data TyCon   = SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType]
 data TyCon   = SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType]
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data TyVarTemplate 
+data UniType 
+data Unique 
 cmpTyCon :: TyCon -> TyCon -> Int#
 cmpTyCon :: TyCon -> TyCon -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 derivedFor :: Class -> TyCon -> Bool
 derivedFor :: Class -> TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 9 \ (u0 :: Class) (u1 :: TyCon) -> case u1 of { _ALG_ _ORIG_ TyCon DataTyCon (u2 :: Unique) (u3 :: FullName) (u4 :: Int) (u5 :: [TyVarTemplate]) (u6 :: [Id]) (u7 :: [Class]) (u8 :: Bool) -> _APP_  _WRKR_ _SPEC_ _ORIG_ Util isIn [ (Class) ] [ u0, u7 ]; (u9 :: TyCon) -> _!_ False [] [] } _N_ #-}
 eqTyCon :: TyCon -> TyCon -> Bool
 eqTyCon :: TyCon -> TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
 getTyConArity :: TyCon -> Int
 getTyConArity :: TyCon -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyConDataCons :: TyCon -> [Id]
 getTyConDataCons :: TyCon -> [Id]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyConDerivings :: TyCon -> [Class]
 getTyConDerivings :: TyCon -> [Class]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: TyCon) -> case u0 of { _ALG_ _ORIG_ TyCon DataTyCon (u1 :: Unique) (u2 :: FullName) (u3 :: Int) (u4 :: [TyVarTemplate]) (u5 :: [Id]) (u6 :: [Class]) (u7 :: Bool) -> u6; _ORIG_ TyCon SpecTyCon (u8 :: TyCon) (u9 :: [Labda UniType]) -> _APP_  _TYAPP_  _ORIG_ Util panic { [Class] } [ _NOREP_S_ "getTyConDerivings:SpecTyCon" ]; (ua :: TyCon) -> _!_ _NIL_ [Class] [] } _N_ #-}
 getTyConFamilySize :: TyCon -> Labda Int
 getTyConFamilySize :: TyCon -> Labda Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyConKind :: TyCon -> [PrimKind] -> PrimKind
 getTyConKind :: TyCon -> [PrimKind] -> PrimKind
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 8 \ (u0 :: TyCon) (u1 :: [PrimKind]) -> case u0 of { _ALG_ _ORIG_ TyCon PrimTyCon (u2 :: Unique) (u3 :: FullName) (u4 :: Int) (u5 :: [PrimKind] -> PrimKind) -> _APP_  u5 [ u1 ]; (u6 :: TyCon) -> _!_ _ORIG_ PrimKind PtrKind [] [] } _N_ #-}
 getTyConTyVarTemplates :: TyCon -> [TyVarTemplate]
 getTyConTyVarTemplates :: TyCon -> [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isBigTupleTyCon :: TyCon -> Bool
 isBigTupleTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isBoxedTyCon :: TyCon -> Bool
 isBoxedTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isDataTyCon :: TyCon -> Bool
 isDataTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isEnumerationTyCon :: TyCon -> Bool
 isEnumerationTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isLocalGenTyCon :: TyCon -> Bool
 isLocalGenTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isLocalSpecTyCon :: Bool -> TyCon -> Bool
 isLocalSpecTyCon :: Bool -> TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "LS" _N_ _N_ #-}
 isPrimTyCon :: TyCon -> Bool
 isPrimTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isSynTyCon :: TyCon -> Bool
 isSynTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: TyCon) -> case u0 of { _ALG_ _ORIG_ TyCon SynonymTyCon (u1 :: Unique) (u2 :: FullName) (u3 :: Int) (u4 :: [TyVarTemplate]) (u5 :: UniType) (u6 :: Bool) -> _!_ True [] []; _ORIG_ TyCon SpecTyCon (u7 :: TyCon) (u8 :: [Labda UniType]) -> _APP_  _TYAPP_  _ORIG_ Util panic { Bool } [ _NOREP_S_ "isSynTyCon: SpecTyCon" ]; (u9 :: TyCon) -> _!_ False [] [] } _N_ #-}
 isTupleTyCon :: TyCon -> Bool
 isTupleTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isVisibleSynTyCon :: TyCon -> Bool
 isVisibleSynTyCon :: TyCon -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyCon) -> case u0 of { _ALG_ _ORIG_ TyCon SynonymTyCon (u1 :: Unique) (u2 :: FullName) (u3 :: Int) (u4 :: [TyVarTemplate]) (u5 :: UniType) (u6 :: Bool) -> u6; (u7 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Bool } [ _NOREP_S_ "isVisibleSynTyCon" ] } _N_ #-}
 maybeCharLikeTyCon :: TyCon -> Labda Id
 maybeCharLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeDoubleLikeTyCon :: TyCon -> Labda Id
 maybeDoubleLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeFloatLikeTyCon :: TyCon -> Labda Id
 maybeFloatLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeIntLikeTyCon :: TyCon -> Labda Id
 maybeIntLikeTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeSingleConstructorTyCon :: TyCon -> Labda Id
 maybeSingleConstructorTyCon :: TyCon -> Labda Id
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkDataTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> [Id] -> [Class] -> Bool -> TyCon
 mkDataTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> [Id] -> [Class] -> Bool -> TyCon
-       {-# GHC_PRAGMA _A_ 7 _U_ 2222222 _N_ _N_ _F_ _IF_ARGS_ 0 7 XXXXXXX 8 \ (u0 :: Unique) (u1 :: FullName) (u2 :: Int) (u3 :: [TyVarTemplate]) (u4 :: [Id]) (u5 :: [Class]) (u6 :: Bool) -> _!_ _ORIG_ TyCon DataTyCon [] [u0, u1, u2, u3, u4, u5, u6] _N_ #-}
 mkPrimTyCon :: Unique -> FullName -> Int -> ([PrimKind] -> PrimKind) -> TyCon
 mkPrimTyCon :: Unique -> FullName -> Int -> ([PrimKind] -> PrimKind) -> TyCon
-       {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: FullName) (u2 :: Int) (u3 :: [PrimKind] -> PrimKind) -> _!_ _ORIG_ TyCon PrimTyCon [] [u0, u1, u2, u3] _N_ #-}
 mkSpecTyCon :: TyCon -> [Labda UniType] -> TyCon
 mkSpecTyCon :: TyCon -> [Labda UniType] -> TyCon
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: TyCon) (u1 :: [Labda UniType]) -> _!_ _ORIG_ TyCon SpecTyCon [] [u0, u1] _N_ #-}
 mkSynonymTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> UniType -> Bool -> TyCon
 mkSynonymTyCon :: Unique -> FullName -> Int -> [TyVarTemplate] -> UniType -> Bool -> TyCon
-       {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _F_ _IF_ARGS_ 0 6 XXXXXX 7 \ (u0 :: Unique) (u1 :: FullName) (u2 :: Int) (u3 :: [TyVarTemplate]) (u4 :: UniType) (u5 :: Bool) -> _!_ _ORIG_ TyCon SynonymTyCon [] [u0, u1, u2, u3, u4, u5] _N_ #-}
 mkTupleTyCon :: Int -> TyCon
 mkTupleTyCon :: Int -> TyCon
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ TyCon TupleTyCon [] [u0] _N_ #-}
 instance Eq TyCon
 instance Eq TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_  _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Ord TyCon
 instance Ord TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance NamedThing TyCon
 instance NamedThing TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_
-        getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_  _TYAPP_  _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 instance Outputable TyCon
 instance Outputable TyCon
-       {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-}
 
 
index ddf1716..5a5b304 100644 (file)
@@ -384,7 +384,7 @@ maybeSingleConstructorTyCon (TupleTyCon arity)               = Just (mkTupleCon arity
 maybeSingleConstructorTyCon (DataTyCon _ _ _ _ [c] _ _)  = Just c
 maybeSingleConstructorTyCon (DataTyCon _ _ _ _ _   _ _)  = Nothing
 maybeSingleConstructorTyCon (PrimTyCon _ _ _ _)                 = Nothing
 maybeSingleConstructorTyCon (DataTyCon _ _ _ _ [c] _ _)  = Just c
 maybeSingleConstructorTyCon (DataTyCon _ _ _ _ _   _ _)  = Nothing
 maybeSingleConstructorTyCon (PrimTyCon _ _ _ _)                 = Nothing
-maybeSingleConstructorTyCon (SpecTyCon tc tys)           = panic "maybeSingleConstructorTyCon:SpecTyCon"
+maybeSingleConstructorTyCon tycon@(SpecTyCon tc tys)     = pprPanic "maybeSingleConstructorTyCon:SpecTyCon:" (ppr PprDebug tycon)
                                                           -- requires DataCons of TyCon
 \end{code}
 
                                                           -- requires DataCons of TyCon
 \end{code}
 
index c6bcfd2..f26ed3f 100644 (file)
@@ -3,112 +3,40 @@ interface TyVar where
 import NameTypes(ShortName)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import NameTypes(ShortName)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
-import SrcLoc(SrcLoc)
 import UniType(UniType)
 import Unique(Unique)
 import UniType(UniType)
 import Unique(Unique)
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
+data ShortName 
 data TyVar   = PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName
 data TyVar   = PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data TyVarTemplate 
 alphaTyVars :: [TyVarTemplate]
 alphaTyVars :: [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 alpha_tv :: TyVarTemplate
 alpha_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 alpha_tyvar :: TyVar
 alpha_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 beta_tv :: TyVarTemplate
 beta_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 beta_tyvar :: TyVar
 beta_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 cloneTyVar :: TyVar -> Unique -> TyVar
 cloneTyVar :: TyVar -> Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 cloneTyVarFromTemplate :: TyVarTemplate -> Unique -> TyVar
 cloneTyVarFromTemplate :: TyVarTemplate -> Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 7 \ (u0 :: TyVarTemplate) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u2 :: Unique) (u3 :: _PackedString) -> _!_ _ORIG_ TyVar PolySysTyVar [] [u1]; _ORIG_ TyVar UserTyVarTemplate (u4 :: Unique) (u5 :: ShortName) -> _!_ _ORIG_ TyVar UserTyVar [] [u1, u5]; _NO_DEFLT_ } _N_ #-}
 cmpTyVar :: TyVar -> TyVar -> Int#
 cmpTyVar :: TyVar -> TyVar -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 delta_tv :: TyVarTemplate
 delta_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 delta_tyvar :: TyVar
 delta_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 epsilon_tv :: TyVarTemplate
 epsilon_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 epsilon_tyvar :: TyVar
 epsilon_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 eqTyVar :: TyVar -> TyVar -> Bool
 eqTyVar :: TyVar -> TyVar -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
 gamma_tv :: TyVarTemplate
 gamma_tv :: TyVarTemplate
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 gamma_tyvar :: TyVar
 gamma_tyvar :: TyVar
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 instantiateTyVarTemplates :: [TyVarTemplate] -> [Unique] -> ([(TyVarTemplate, UniType)], [TyVar], [UniType])
 instantiateTyVarTemplates :: [TyVarTemplate] -> [Unique] -> ([(TyVarTemplate, UniType)], [TyVar], [UniType])
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _N_ _N_ _N_ #-}
 ltTyVar :: TyVar -> TyVar -> Bool
 ltTyVar :: TyVar -> TyVar -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 mkOpenSysTyVar :: Unique -> TyVar
 mkOpenSysTyVar :: Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Unique) -> _!_ _ORIG_ TyVar OpenSysTyVar [] [u0] _N_ #-}
 mkPolySysTyVar :: Unique -> TyVar
 mkPolySysTyVar :: Unique -> TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Unique) -> _!_ _ORIG_ TyVar PolySysTyVar [] [u0] _N_ #-}
 mkSysTyVarTemplate :: Unique -> _PackedString -> TyVarTemplate
 mkSysTyVarTemplate :: Unique -> _PackedString -> TyVarTemplate
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: _PackedString) -> _!_ _ORIG_ TyVar SysTyVarTemplate [] [u0, u1] _N_ #-}
 mkTemplateTyVars :: [TyVar] -> [TyVarTemplate]
 mkTemplateTyVars :: [TyVar] -> [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mkUserTyVar :: Unique -> ShortName -> TyVar
 mkUserTyVar :: Unique -> ShortName -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: ShortName) -> _!_ _ORIG_ TyVar UserTyVar [] [u0, u1] _N_ #-}
 mkUserTyVarTemplate :: Unique -> ShortName -> TyVarTemplate
 mkUserTyVarTemplate :: Unique -> ShortName -> TyVarTemplate
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Unique) (u1 :: ShortName) -> _!_ _ORIG_ TyVar UserTyVarTemplate [] [u0, u1] _N_ #-}
 instance Eq TyVar
 instance Eq TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool)] [_CONSTM_ Eq (==) (TyVar), _CONSTM_ Eq (/=) (TyVar)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_  _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq TyVarTemplate
 instance Eq TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool)] [_CONSTM_ Eq (==) (TyVarTemplate), _CONSTM_ Eq (/=) (TyVarTemplate)] _N_
-        (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVar
 instance Ord TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVar}}, (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> _CMP_TAG)] [_DFUN_ Eq (TyVar), _CONSTM_ Ord (<) (TyVar), _CONSTM_ Ord (<=) (TyVar), _CONSTM_ Ord (>=) (TyVar), _CONSTM_ Ord (>) (TyVar), _CONSTM_ Ord max (TyVar), _CONSTM_ Ord min (TyVar), _CONSTM_ Ord _tagCmp (TyVar)] _N_
-        (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord TyVarTemplate
 instance Ord TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVarTemplate}}, (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> Bool), (TyVarTemplate -> TyVarTemplate -> TyVarTemplate), (TyVarTemplate -> TyVarTemplate -> TyVarTemplate), (TyVarTemplate -> TyVarTemplate -> _CMP_TAG)] [_DFUN_ Eq (TyVarTemplate), _CONSTM_ Ord (<) (TyVarTemplate), _CONSTM_ Ord (<=) (TyVarTemplate), _CONSTM_ Ord (>=) (TyVarTemplate), _CONSTM_ Ord (>) (TyVarTemplate), _CONSTM_ Ord max (TyVarTemplate), _CONSTM_ Ord min (TyVarTemplate), _CONSTM_ Ord _tagCmp (TyVarTemplate)] _N_
-        (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-        max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-        _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance NamedThing TyVar
 instance NamedThing TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVar -> ExportFlag), (TyVar -> Bool), (TyVar -> (_PackedString, _PackedString)), (TyVar -> _PackedString), (TyVar -> [_PackedString]), (TyVar -> SrcLoc), (TyVar -> Unique), (TyVar -> Bool), (TyVar -> UniType), (TyVar -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVar), _CONSTM_ NamedThing isLocallyDefined (TyVar), _CONSTM_ NamedThing getOrigName (TyVar), _CONSTM_ NamedThing getOccurrenceName (TyVar), _CONSTM_ NamedThing getInformingModules (TyVar), _CONSTM_ NamedThing getSrcLoc (TyVar), _CONSTM_ NamedThing getTheUnique (TyVar), _CONSTM_ NamedThing hasType (TyVar), _CONSTM_ NamedThing getType (TyVar), _CONSTM_ NamedThing fromPreludeCore (TyVar)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVar" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar UserTyVar (u1 :: Unique) (u2 :: ShortName) -> case u2 of { _ALG_ _ORIG_ NameTypes ShortName (u3 :: _PackedString) (u4 :: SrcLoc) -> u4; _NO_DEFLT_ }; (u5 :: TyVar) -> _ORIG_ SrcLoc mkUnknownSrcLoc } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar PolySysTyVar (u1 :: Unique) -> u1; _ORIG_ TyVar PrimSysTyVar (u2 :: Unique) -> u2; _ORIG_ TyVar OpenSysTyVar (u3 :: Unique) -> u3; _ORIG_ TyVar UserTyVar (u4 :: Unique) (u5 :: ShortName) -> u4; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  patError# { (TyVar -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ False [] [] _N_ #-}
 instance NamedThing TyVarTemplate
 instance NamedThing TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVarTemplate -> ExportFlag), (TyVarTemplate -> Bool), (TyVarTemplate -> (_PackedString, _PackedString)), (TyVarTemplate -> _PackedString), (TyVarTemplate -> [_PackedString]), (TyVarTemplate -> SrcLoc), (TyVarTemplate -> Unique), (TyVarTemplate -> Bool), (TyVarTemplate -> UniType), (TyVarTemplate -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVarTemplate), _CONSTM_ NamedThing isLocallyDefined (TyVarTemplate), _CONSTM_ NamedThing getOrigName (TyVarTemplate), _CONSTM_ NamedThing getOccurrenceName (TyVarTemplate), _CONSTM_ NamedThing getInformingModules (TyVarTemplate), _CONSTM_ NamedThing getSrcLoc (TyVarTemplate), _CONSTM_ NamedThing getTheUnique (TyVarTemplate), _CONSTM_ NamedThing hasType (TyVarTemplate), _CONSTM_ NamedThing getType (TyVarTemplate), _CONSTM_ NamedThing fromPreludeCore (TyVarTemplate)] _N_
-        getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ _ORIG_ Outputable NotExported [] [] _N_,
-        isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ True [] [] _N_,
-        getOrigName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_,
-        getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVarTemplate" ] _N_,
-        getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: TyVarTemplate) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u1 :: Unique) (u2 :: _PackedString) -> _ORIG_ SrcLoc mkUnknownSrcLoc; _ORIG_ TyVar UserTyVarTemplate (u3 :: Unique) (u4 :: ShortName) -> case u4 of { _ALG_ _ORIG_ NameTypes ShortName (u5 :: _PackedString) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-        getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: TyVarTemplate) -> case u0 of { _ALG_ _ORIG_ TyVar SysTyVarTemplate (u1 :: Unique) (u2 :: _PackedString) -> u1; _ORIG_ TyVar UserTyVarTemplate (u3 :: Unique) (u4 :: ShortName) -> u3; _NO_DEFLT_ } _N_,
-        hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  patError# { (TyVarTemplate -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_,
-        getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVarTemplate) -> _APP_  _TYAPP_  patError# { (TyVarTemplate -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_,
-        fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVarTemplate) -> _!_ False [] [] _N_ #-}
 instance Outputable TyVar
 instance Outputable TyVar
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVar) _N_
-        ppr = _A_ 2 _U_ 1122 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable TyVarTemplate
 instance Outputable TyVarTemplate
-       {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVarTemplate) _N_
-        ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index acba0fe..b0eff59 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniTyFuns where
 import Bag(Bag)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniTyFuns where
 import Bag(Bag)
-import BasicLit(BasicLit)
-import BinderInfo(BinderInfo)
 import CharSeq(CSeq)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
 import CharSeq(CSeq)
 import Class(Class, ClassOp)
 import CmdLineOpts(GlobalSwitch)
-import CoreSyn(CoreAtom, CoreExpr)
 import Id(Id)
 import IdEnv(IdEnv(..))
 import InstEnv(InstTemplate)
 import Id(Id)
 import IdEnv(IdEnv(..))
 import InstEnv(InstTemplate)
-import MagicUFs(MagicUnfoldingFun)
 import Maybes(Labda)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, PrettyRep)
 import PrimKind(PrimKind)
 import Maybes(Labda)
 import NameTypes(FullName, ShortName)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle, PrettyRep)
 import PrimKind(PrimKind)
-import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance)
-import SplitUniq(SplitUniqSupply)
+import SimplEnv(UnfoldingDetails)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import TyVarEnv(TyVarEnv(..), TypeEnv(..))
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique, UniqueSupply)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import TyVarEnv(TyVarEnv(..), TypeEnv(..))
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique, UniqueSupply)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Bag a 
+data Class 
 type IdEnv a = UniqFM a
 type IdEnv a = UniqFM a
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data UnfoldingDetails  {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data Labda a 
+data PprStyle 
+data PrettyRep 
+data PrimKind 
+data UnfoldingDetails 
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
 type TyVarEnv a = UniqFM a
 type TypeEnv = UniqFM UniType
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data UniType 
+data UniqFM a 
+data UniqueSupply 
 applyNonSynTyCon :: TyCon -> [UniType] -> UniType
 applyNonSynTyCon :: TyCon -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: TyCon) (u1 :: [UniType]) -> _!_ _ORIG_ UniType UniData [] [u0, u1] _N_ #-}
 applySynTyCon :: TyCon -> [UniType] -> UniType
 applySynTyCon :: TyCon -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 applyTy :: UniType -> UniType -> UniType
 applyTy :: UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 applyTyCon :: TyCon -> [UniType] -> UniType
 applyTyCon :: TyCon -> [UniType] -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 applyTypeEnvToThetaTy :: UniqFM UniType -> [(a, UniType)] -> [(a, UniType)]
 applyTypeEnvToThetaTy :: UniqFM UniType -> [(a, UniType)] -> [(a, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 applyTypeEnvToTy :: UniqFM UniType -> UniType -> UniType
 applyTypeEnvToTy :: UniqFM UniType -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 cmpUniTypeMaybeList :: [Labda UniType] -> [Labda UniType] -> Int#
 cmpUniTypeMaybeList :: [Labda UniType] -> [Labda UniType] -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 expandVisibleTySyn :: UniType -> UniType
 expandVisibleTySyn :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarTemplatesFromTy :: UniType -> [TyVarTemplate]
 extractTyVarTemplatesFromTy :: UniType -> [TyVarTemplate]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarsFromTy :: UniType -> [TyVar]
 extractTyVarsFromTy :: UniType -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 extractTyVarsFromTys :: [UniType] -> [TyVar]
 extractTyVarsFromTys :: [UniType] -> [TyVar]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 funResultTy :: UniType -> Int -> UniType
 funResultTy :: UniType -> Int -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getMentionedTyCons :: TyCon -> [TyCon]
 getMentionedTyCons :: TyCon -> [TyCon]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getMentionedTyConsAndClassesFromClass :: Class -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromClass :: Class -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "U(LLLLLSLLLL)" _N_ _N_ #-}
 getMentionedTyConsAndClassesFromTyCon :: TyCon -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromTyCon :: TyCon -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getMentionedTyConsAndClassesFromUniType :: UniType -> (Bag TyCon, Bag Class)
 getMentionedTyConsAndClassesFromUniType :: UniType -> (Bag TyCon, Bag Class)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTauType :: UniType -> UniType
 getTauType :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 4 \ (u0 :: UniType) -> case _APP_  _ORIG_ UniTyFuns splitType [ u0 ] of { _ALG_ _TUP_3 (u1 :: [TyVarTemplate]) (u2 :: [(Class, UniType)]) (u3 :: UniType) -> u3; _NO_DEFLT_ } _N_ #-}
 getTyVar :: [Char] -> UniType -> TyVar
 getTyVar :: [Char] -> UniType -> TyVar
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 getTyVarMaybe :: UniType -> Labda TyVar
 getTyVarMaybe :: UniType -> Labda TyVar
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTyVarTemplateMaybe :: UniType -> Labda TyVarTemplate
 getTyVarTemplateMaybe :: UniType -> Labda TyVarTemplate
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getTypeString :: UniType -> [_PackedString]
 getTypeString :: UniType -> [_PackedString]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataSpecTyCon :: UniType -> (TyCon, [UniType], [Id])
 getUniDataSpecTyCon :: UniType -> (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataSpecTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
 getUniDataSpecTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataTyCon :: UniType -> (TyCon, [UniType], [Id])
 getUniDataTyCon :: UniType -> (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniDataTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
 getUniDataTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 getUniTyDescription :: UniType -> [Char]
 getUniTyDescription :: UniType -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 glueTyArgs :: [UniType] -> UniType -> UniType
 glueTyArgs :: [UniType] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 instanceIsExported :: Class -> UniType -> Bool -> Bool
 instanceIsExported :: Class -> UniType -> Bool -> Bool
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AU(AASLAA)AAAAAAAA)SL" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isDictTy :: UniType -> Bool
 isDictTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isForAllTy :: UniType -> Bool
 isForAllTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isFunType :: UniType -> Bool
 isFunType :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isGroundOrTyVarTy :: UniType -> Bool
 isGroundOrTyVarTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isGroundTy :: UniType -> Bool
 isGroundTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isLeakFreeType :: [TyCon] -> UniType -> Bool
 isLeakFreeType :: [TyCon] -> UniType -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 isPrimType :: UniType -> Bool
 isPrimType :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTauTy :: UniType -> Bool
 isTauTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTyVarTemplateTy :: UniType -> Bool
 isTyVarTemplateTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isTyVarTy :: UniType -> Bool
 isTyVarTy :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isUnboxedDataType :: UniType -> Bool
 isUnboxedDataType :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 kindFromType :: UniType -> PrimKind
 kindFromType :: UniType -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mapOverTyVars :: (TyVar -> UniType) -> UniType -> UniType
 mapOverTyVars :: (TyVar -> UniType) -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 matchTy :: UniType -> UniType -> Labda [(TyVarTemplate, UniType)]
 matchTy :: UniType -> UniType -> Labda [(TyVarTemplate, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 maybeBoxedPrimType :: UniType -> Labda (Id, UniType)
 maybeBoxedPrimType :: UniType -> Labda (Id, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 maybePurelyLocalClass :: Class -> Labda [Int -> Bool -> PrettyRep]
 maybePurelyLocalClass :: Class -> Labda [Int -> Bool -> PrettyRep]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "U(LLLLLSLLLL)" _N_ _N_ #-}
 maybePurelyLocalTyCon :: TyCon -> Labda [Int -> Bool -> PrettyRep]
 maybePurelyLocalTyCon :: TyCon -> Labda [Int -> Bool -> PrettyRep]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 maybePurelyLocalType :: UniType -> Labda [Int -> Bool -> PrettyRep]
 maybePurelyLocalType :: UniType -> Labda [Int -> Bool -> PrettyRep]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 maybeUnpackFunTy :: UniType -> Labda (UniType, UniType)
 maybeUnpackFunTy :: UniType -> Labda (UniType, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 mkSuperDictSelType :: Class -> Class -> UniType
 mkSuperDictSelType :: Class -> Class -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "U(LLLLLLLLLL)L" _N_ _N_ #-}
 pprClassOp :: PprStyle -> ClassOp -> Int -> Bool -> PrettyRep
 pprClassOp :: PprStyle -> ClassOp -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 pprIfaceClass :: (GlobalSwitch -> Bool) -> (Id -> Id) -> UniqFM UnfoldingDetails -> Class -> Int -> Bool -> PrettyRep
 pprIfaceClass :: (GlobalSwitch -> Bool) -> (Id -> Id) -> UniqFM UnfoldingDetails -> Class -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 222122 _N_ _S_ "LLLU(ALLLLLLLAA)" _N_ _N_ #-}
 pprMaybeTy :: PprStyle -> Labda UniType -> Int -> Bool -> PrettyRep
 pprMaybeTy :: PprStyle -> Labda UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "SS" _N_ _N_ #-}
 pprParendUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
 pprParendUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 pprTyCon :: PprStyle -> TyCon -> [[Labda UniType]] -> Int -> Bool -> PrettyRep
 pprTyCon :: PprStyle -> TyCon -> [[Labda UniType]] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "SSL" _N_ _N_ #-}
 pprUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
 pprUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 returnsRealWorld :: UniType -> Bool
 returnsRealWorld :: UniType -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 showTyCon :: PprStyle -> TyCon -> [Char]
 showTyCon :: PprStyle -> TyCon -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 showTypeCategory :: UniType -> Char
 showTypeCategory :: UniType -> Char
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 specMaybeTysSuffix :: [Labda UniType] -> _PackedString
 specMaybeTysSuffix :: [Labda UniType] -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 specialiseTy :: UniType -> [Labda UniType] -> Int -> UniType
 specialiseTy :: UniType -> [Labda UniType] -> Int -> UniType
-       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "SLL" _N_ _N_ #-}
 splitDictType :: UniType -> (Class, UniType)
 splitDictType :: UniType -> (Class, UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 splitForalls :: UniType -> ([TyVarTemplate], UniType)
 splitForalls :: UniType -> ([TyVarTemplate], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 splitTyArgs :: UniType -> ([UniType], UniType)
 splitTyArgs :: UniType -> ([UniType], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 splitType :: UniType -> ([TyVarTemplate], [(Class, UniType)], UniType)
 splitType :: UniType -> ([TyVarTemplate], [(Class, UniType)], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 splitTypeWithDictsAsArgs :: UniType -> ([TyVarTemplate], [UniType], UniType)
 splitTypeWithDictsAsArgs :: UniType -> ([TyVarTemplate], [UniType], UniType)
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 typeMaybeString :: Labda UniType -> [_PackedString]
 typeMaybeString :: Labda UniType -> [_PackedString]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unDictifyTy :: UniType -> UniType
 unDictifyTy :: UniType -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 
 
index a1d880b..f88f703 100644 (file)
@@ -1,74 +1,44 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniType where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniType where
-import Class(Class, ClassOp)
-import Id(Id)
-import InstEnv(InstTemplate)
+import Class(Class)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(FullName, ShortName)
+import NameTypes(ShortName)
 import Outputable(Outputable)
 import Outputable(Outputable)
-import PreludePS(_PackedString)
-import PrimKind(PrimKind)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import Unique(Unique)
 import TyCon(TyCon)
 import TyVar(TyVar, TyVarTemplate)
 import Unique(Unique)
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
+data Class 
 type InstTyEnv = [(TyVarTemplate, UniType)]
 type InstTyEnv = [(TyVarTemplate, UniType)]
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 type RhoType = UniType
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
 type RhoType = UniType
 type SigmaType = UniType
 type TauType = UniType
 type ThetaType = [(Class, UniType)]
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
+data TyCon 
+data TyVar 
+data TyVarTemplate 
 data UniType   = UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType
 alpha :: UniType
 data UniType   = UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType
 alpha :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar alpha_tv] _N_ #-}
 alpha_ty :: UniType
 alpha_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar alpha_tyvar] _N_ #-}
 beta :: UniType
 beta :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar beta_tv] _N_ #-}
 beta_ty :: UniType
 beta_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar beta_tyvar] _N_ #-}
 cmpUniType :: Bool -> UniType -> UniType -> Int#
 cmpUniType :: Bool -> UniType -> UniType -> Int#
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 delta :: UniType
 delta :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar delta_tv] _N_ #-}
 delta_ty :: UniType
 delta_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar delta_tyvar] _N_ #-}
 epsilon :: UniType
 epsilon :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar epsilon_tv] _N_ #-}
 epsilon_ty :: UniType
 epsilon_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar epsilon_tyvar] _N_ #-}
 gamma :: UniType
 gamma :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar gamma_tv] _N_ #-}
 gamma_ty :: UniType
 gamma_ty :: UniType
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar gamma_tyvar] _N_ #-}
 instantiateTauTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
 instantiateTauTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniType instantiateTy _N_ #-}
 instantiateThetaTy :: [(TyVarTemplate, UniType)] -> [(Class, UniType)] -> [(Class, UniType)]
 instantiateThetaTy :: [(TyVarTemplate, UniType)] -> [(Class, UniType)] -> [(Class, UniType)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 instantiateTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
 instantiateTy :: [(TyVarTemplate, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ #-}
 mkDictTy :: Class -> UniType -> UniType
 mkDictTy :: Class -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Class) (u1 :: UniType) -> _!_ _ORIG_ UniType UniDict [] [u0, u1] _N_ #-}
 mkForallTy :: [TyVarTemplate] -> UniType -> UniType
 mkForallTy :: [TyVarTemplate] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mkRhoTy :: [(Class, UniType)] -> UniType -> UniType
 mkRhoTy :: [(Class, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
 mkSigmaTy :: [TyVarTemplate] -> [(Class, UniType)] -> UniType -> UniType
 mkSigmaTy :: [TyVarTemplate] -> [(Class, UniType)] -> UniType -> UniType
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SLL" _N_ _N_ #-}
 mkTyVarTemplateTy :: TyVarTemplate -> UniType
 mkTyVarTemplateTy :: TyVarTemplate -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVarTemplate) -> _!_ _ORIG_ UniType UniTyVarTemplate [] [u0] _N_ #-}
 mkTyVarTy :: TyVar -> UniType
 mkTyVarTy :: TyVar -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _!_ _ORIG_ UniType UniTyVar [] [u0] _N_ #-}
 quantifyTy :: [TyVar] -> UniType -> ([TyVarTemplate], UniType)
 quantifyTy :: [TyVar] -> UniType -> ([TyVarTemplate], UniType)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 instance Eq UniType
 instance Eq UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UniType -> UniType -> Bool), (UniType -> UniType -> Bool)] [_CONSTM_ Eq (==) (UniType), _CONSTM_ Eq (/=) (UniType)] _N_
-        (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-        (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Outputable UniType
 instance Outputable UniType
-       {-# GHC_PRAGMA _M_ UniType {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_
-        ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniTyFuns pprUniType _N_ #-}
 
 
index caf1465..69c68e1 100644 (file)
@@ -1,27 +1,16 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Bag where
 import Outputable(Outputable)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Bag where
 import Outputable(Outputable)
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
+data Bag a 
 bagToList :: Bag a -> [a]
 bagToList :: Bag a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 emptyBag :: Bag a
 emptyBag :: Bag a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ Bag EmptyBag [u0] [] _N_ #-}
 filterBag :: (a -> Bool) -> Bag a -> Bag a
 filterBag :: (a -> Bool) -> Bag a -> Bag a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 isEmptyBag :: Bag a -> Bool
 isEmptyBag :: Bag a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 listToBag :: [a] -> Bag a
 listToBag :: [a] -> Bag a
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 partitionBag :: (a -> Bool) -> Bag a -> (Bag a, Bag a)
 partitionBag :: (a -> Bool) -> Bag a -> (Bag a, Bag a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 snocBag :: Bag a -> a -> Bag a
 snocBag :: Bag a -> a -> Bag a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 unionBags :: Bag a -> Bag a -> Bag a
 unionBags :: Bag a -> Bag a -> Bag a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 1 2 CC 13 _/\_ u0 -> \ (u1 :: Bag u0) (u2 :: Bag u0) -> case u1 of { _ALG_ _ORIG_ Bag EmptyBag  -> u2; (u3 :: Bag u0) -> case u2 of { _ALG_ _ORIG_ Bag EmptyBag  -> u3; (u4 :: Bag u0) -> _!_ _ORIG_ Bag TwoBags [u0] [u1, u2] } } _N_ #-}
 unionManyBags :: [Bag a] -> Bag a
 unionManyBags :: [Bag a] -> Bag a
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 5 _/\_ u0 -> \ (u1 :: [Bag u0]) -> case u1 of { _ALG_ (:) (u2 :: Bag u0) (u3 :: [Bag u0]) -> _!_ _ORIG_ Bag ListOfBags [u0] [u1]; _NIL_  -> _!_ _ORIG_ Bag EmptyBag [u0] []; _NO_DEFLT_ } _N_ #-}
 unitBag :: a -> Bag a
 unitBag :: a -> Bag a
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: u0) -> _!_ _ORIG_ Bag UnitBag [u0] [u1] _N_ #-}
 instance Outputable a => Outputable (Bag a)
 instance Outputable a => Outputable (Bag a)
-       {-# GHC_PRAGMA _M_ Bag {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 92300ab..1882ac1 100644 (file)
@@ -1,16 +1,10 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface BitSet where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface BitSet where
-data BitSet    {-# GHC_PRAGMA MkBS Word# #-}
+data BitSet 
 emptyBS :: BitSet
 emptyBS :: BitSet
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 case _#_ int2Word# [] [0#] of { _PRIM_ (u0 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u0] } _N_ #-}
 listBS :: BitSet -> [Int]
 listBS :: BitSet -> [Int]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 minusBS :: BitSet -> BitSet -> BitSet
 minusBS :: BitSet -> BitSet -> BitSet
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Word#) (u1 :: Word#) -> case _#_ not# [] [u1] of { _PRIM_ (u2 :: Word#) -> case _#_ and# [] [u0, u2] of { _PRIM_ (u3 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u3] } } _N_} _F_ _IF_ARGS_ 0 2 CC 6 \ (u0 :: BitSet) (u1 :: BitSet) -> case u0 of { _ALG_ _ORIG_ BitSet MkBS (u2 :: Word#) -> case u1 of { _ALG_ _ORIG_ BitSet MkBS (u3 :: Word#) -> case _#_ not# [] [u3] of { _PRIM_ (u4 :: Word#) -> case _#_ and# [] [u2, u4] of { _PRIM_ (u5 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u5] } }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 mkBS :: [Int] -> BitSet
 mkBS :: [Int] -> BitSet
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 singletonBS :: Int -> BitSet
 singletonBS :: Int -> BitSet
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 4 \ (u0 :: Int#) -> case _#_ int2Word# [] [1#] of { _PRIM_ (u1 :: Word#) -> case _#_ shiftL# [] [u1, u0] of { _PRIM_ (u2 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u2] } } _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Int) -> case u0 of { _ALG_ I# (u1 :: Int#) -> case _#_ int2Word# [] [1#] of { _PRIM_ (u2 :: Word#) -> case _#_ shiftL# [] [u2, u1] of { _PRIM_ (u3 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u3] } }; _NO_DEFLT_ } _N_ #-}
 unionBS :: BitSet -> BitSet -> BitSet
 unionBS :: BitSet -> BitSet -> BitSet
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Word#) (u1 :: Word#) -> case _#_ or# [] [u0, u1] of { _PRIM_ (u2 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u2] } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: BitSet) (u1 :: BitSet) -> case u0 of { _ALG_ _ORIG_ BitSet MkBS (u2 :: Word#) -> case u1 of { _ALG_ _ORIG_ BitSet MkBS (u3 :: Word#) -> case _#_ or# [] [u2, u3] of { _PRIM_ (u4 :: Word#) -> _!_ _ORIG_ BitSet MkBS [] [u4] }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 
 
index 3d22652..15bcebb 100644 (file)
@@ -2,25 +2,15 @@
 interface CharSeq where
 import PreludePS(_PackedString)
 import Stdio(_FILE)
 interface CharSeq where
 import PreludePS(_PackedString)
 import Stdio(_FILE)
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
+data CSeq 
 cAppend :: CSeq -> CSeq -> CSeq
 cAppend :: CSeq -> CSeq -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: CSeq) (u1 :: CSeq) -> _!_ _ORIG_ CharSeq CAppend [] [u0, u1] _N_ #-}
 cAppendFile :: _FILE -> CSeq -> _State _RealWorld -> ((), _State _RealWorld)
 cAppendFile :: _FILE -> CSeq -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)SL" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 cCh :: Char -> CSeq
 cCh :: Char -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Char) -> _!_ _ORIG_ CharSeq CCh [] [u0] _N_ #-}
 cIndent :: Int -> CSeq -> CSeq
 cIndent :: Int -> CSeq -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: CSeq) -> _!_ _ORIG_ CharSeq CIndent [] [u0, u1] _N_ #-}
 cInt :: Int -> CSeq
 cInt :: Int -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ CharSeq CInt [] [u0] _N_ #-}
 cNL :: CSeq
 cNL :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CharSeq CNewline [] [] _N_ #-}
 cNil :: CSeq
 cNil :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CharSeq CNil [] [] _N_ #-}
 cPStr :: _PackedString -> CSeq
 cPStr :: _PackedString -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: _PackedString) -> _!_ _ORIG_ CharSeq CPStr [] [u0] _N_ #-}
 cShow :: CSeq -> [Char]
 cShow :: CSeq -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 cStr :: [Char] -> CSeq
 cStr :: [Char] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [Char]) -> _!_ _ORIG_ CharSeq CStr [] [u0] _N_ #-}
 
 
index 98e65fe..f5e37f9 100644 (file)
@@ -1,11 +1,8 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Digraph where
 import Maybes(MaybeErr)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Digraph where
 import Maybes(MaybeErr)
-data MaybeErr a b      {-# GHC_PRAGMA Succeeded a | Failed b #-}
+data MaybeErr a b 
 dfs :: (a -> a -> Bool) -> (a -> [a]) -> ([a], [a]) -> [a] -> ([a], [a])
 dfs :: (a -> a -> Bool) -> (a -> [a]) -> ([a], [a]) -> [a] -> ([a], [a])
-       {-# GHC_PRAGMA _A_ 4 _U_ 2211 _N_ _S_ "LLU(LL)S" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 stronglyConnComp :: (a -> a -> Bool) -> [(a, a)] -> [a] -> [[a]]
 stronglyConnComp :: (a -> a -> Bool) -> [(a, a)] -> [a] -> [[a]]
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 topologicalSort :: (a -> a -> Bool) -> [(a, a)] -> [a] -> MaybeErr [a] [[a]]
 topologicalSort :: (a -> a -> Bool) -> [(a, a)] -> [a] -> MaybeErr [a] [[a]]
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 
 
index 4d31462..e70c039 100644 (file)
@@ -2,57 +2,32 @@
 interface FiniteMap where
 import Maybes(Labda)
 import Outputable(Outputable)
 interface FiniteMap where
 import Maybes(Labda)
 import Outputable(Outputable)
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
+data FiniteMap a b 
 type FiniteSet a = FiniteMap a ()
 type FiniteSet a = FiniteMap a ()
-data Labda a   {-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 addListToFM :: Ord a => FiniteMap a b -> [(a, b)] -> FiniteMap a b
 addListToFM :: Ord a => FiniteMap a b -> [(a, b)] -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ }, [ (_PackedString, _PackedString), _N_ ] 1 { _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ } #-}
 addListToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> [(a, b)] -> FiniteMap a b
 addListToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> [(a, b)] -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 4 _U_ 2211 _N_ _S_ "LLLS" _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 211 _N_ _S_ "LLS" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 3 _U_ 211 _N_ _S_ "LLS" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 3 _U_ 211 _N_ _S_ "LLS" _N_ _N_ }, [ TyCon, _N_ ] 1 { _A_ 3 _U_ 211 _N_ _S_ "LLS" _N_ _N_ }, [ (_PackedString, _PackedString), _N_ ] 1 { _A_ 3 _U_ 211 _N_ _S_ "LLS" _N_ _N_ } #-}
 addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
 addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1122 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ }, [ TyCon, _N_ ] 1 { _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ } #-}
 delListFromFM :: Ord a => FiniteMap a b -> [a] -> FiniteMap a b
 delListFromFM :: Ord a => FiniteMap a b -> [a] -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ } #-}
 elemFM :: Ord a => a -> FiniteMap a b -> Bool
 elemFM :: Ord a => a -> FiniteMap a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _SPECIALISE_ [ _PackedString, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ } #-}
 elementOf :: Ord a => a -> FiniteMap a () -> Bool
 elementOf :: Ord a => a -> FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap elemFM { u0 } { () } _N_ #-}
 eltsFM :: FiniteMap a b -> [b]
 eltsFM :: FiniteMap a b -> [b]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 emptyFM :: FiniteMap a b
 emptyFM :: FiniteMap a b
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 2 0 X 1 _/\_ u0 u1 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, u1] [] _N_ #-}
 emptySet :: FiniteMap a ()
 emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
 fmToList :: FiniteMap a b -> [(a, b)]
 fmToList :: FiniteMap a b -> [(a, b)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isEmptyFM :: FiniteMap a b -> Bool
 isEmptyFM :: FiniteMap a b -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isEmptySet :: FiniteMap a () -> Bool
 isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap isEmptyFM { u0 } { () } _N_ #-}
 keysFM :: FiniteMap b a -> [b]
 keysFM :: FiniteMap b a -> [b]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 listToFM :: Ord a => [(a, b)] -> FiniteMap a b
 listToFM :: Ord a => [(a, b)] -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 21 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ (_PackedString, _PackedString), _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ } #-}
 lookupFM :: Ord a => FiniteMap a b -> a -> Labda b
 lookupFM :: Ord a => FiniteMap a b -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 1 _U_ 112 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ (_PackedString, _PackedString), _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ } #-}
 lookupWithDefaultFM :: Ord a => FiniteMap a b -> b -> a -> b
 lookupWithDefaultFM :: Ord a => FiniteMap a b -> b -> a -> b
-       {-# GHC_PRAGMA _A_ 1 _U_ 1112 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 112 _N_ _S_ "SLL" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 3 _U_ 112 _N_ _S_ "SLL" _N_ _N_ } #-}
 minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
 minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ }, [ TyCon, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SL" _N_ _N_ } #-}
 minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
 minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
 mkSet :: Ord a => [a] -> FiniteMap a ()
 mkSet :: Ord a => [a] -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 21 _N_ _N_ _N_ _N_ #-}
 plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
 plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ }, [ TyCon, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SS" _N_ _N_ } #-}
 plusFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
 plusFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 2221 _N_ _N_ _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 221 _N_ _S_ "LSS" _N_ _N_ }, [ CLabel, _N_ ] 1 { _A_ 3 _U_ 221 _N_ _S_ "LSS" _N_ _N_ } #-}
 setToList :: FiniteMap a () -> [a]
 setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
 singletonFM :: a -> b -> FiniteMap a b
 singletonFM :: a -> b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
 union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
 instance Outputable a => Outputable (FiniteMap a b)
 instance Outputable a => Outputable (FiniteMap a b)
-       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _N_ _N_ #-}
 
 
index 03f087a..56caa58 100644 (file)
@@ -715,6 +715,18 @@ pprX sty (Branch key elt sz fm_l fm_r)
              ppr sty key, ppSP, ppInt (IF_GHC(I# sz, sz)), ppSP,
              pprX sty fm_r, ppRparen]
 #endif
              ppr sty key, ppSP, ppInt (IF_GHC(I# sz, sz)), ppSP,
              pprX sty fm_r, ppRparen]
 #endif
+
+#if !defined(COMPILING_GHC)
+instance (Eq key, Eq elt) => Eq (FiniteMap key elt) where
+  fm_1 == fm_2 = (sizeFM   fm_1 == sizeFM   fm_2) &&   -- quick test
+                 (fmToList fm_1 == fmToList fm_2)
+
+{- NO: not clear what The Right Thing to do is:
+instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where
+  fm_1 <= fm_2 = (sizeFM   fm_1 <= sizeFM   fm_2) &&   -- quick test
+                 (fmToList fm_1 <= fmToList fm_2)
+-}
+#endif
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index fd54066..22b0a2a 100644 (file)
@@ -1,5 +1,4 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LiftMonad where
 bogusLiftMonadThing :: Bool
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LiftMonad where
 bogusLiftMonadThing :: Bool
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_ #-}
 
 
index d7e73e2..f4502fd 100644 (file)
@@ -1,9 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface ListSetOps where
 intersectLists :: Eq a => [a] -> [a] -> [a]
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface ListSetOps where
 intersectLists :: Eq a => [a] -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 212 _N_ _N_ _N_ _SPECIALISE_ [ TyVar ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SS" _N_ _N_ } #-}
 minusList :: Eq a => [a] -> [a] -> [a]
 minusList :: Eq a => [a] -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _SPECIALISE_ [ Int ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Id ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ TyVar ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ } #-}
 unionLists :: Eq a => [a] -> [a] -> [a]
 unionLists :: Eq a => [a] -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 212 _N_ _N_ _N_ _SPECIALISE_ [ TyVar ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SS" _N_ _N_ } #-}
 
 
index d4c5c14..0a96c2b 100644 (file)
@@ -3,29 +3,16 @@ interface Maybes where
 data Labda a   = Hamna | Ni a
 data MaybeErr a b   = Succeeded a | Failed b
 allMaybes :: [Labda a] -> Labda [a]
 data Labda a   = Hamna | Ni a
 data MaybeErr a b   = Succeeded a | Failed b
 allMaybes :: [Labda a] -> Labda [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 assocMaybe :: Eq a => [(a, b)] -> a -> Labda b
 assocMaybe :: Eq a => [(a, b)] -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "LSL" _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ [Char], _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ TyVarTemplate, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Name, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Class, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ } #-}
 catMaybes :: [Labda a] -> [a]
 catMaybes :: [Labda a] -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 failMaB :: b -> MaybeErr a b
 failMaB :: b -> MaybeErr a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 2 1 X 2 _/\_ u0 u1 -> \ (u2 :: u1) -> _!_ _ORIG_ Maybes Failed [u0, u1] [u2] _N_ #-}
 failMaybe :: Labda a
 failMaybe :: Labda a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ Maybes Hamna [u0] [] _N_ #-}
 firstJust :: [Labda a] -> Labda a
 firstJust :: [Labda a] -> Labda a
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 mapMaybe :: (a -> Labda b) -> [a] -> Labda [b]
 mapMaybe :: (a -> Labda b) -> [a] -> Labda [b]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 maybeToBool :: Labda a -> Bool
 maybeToBool :: Labda a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 4 _/\_ u0 -> \ (u1 :: Labda u0) -> case u1 of { _ALG_ _ORIG_ Maybes Hamna  -> _!_ False [] []; _ORIG_ Maybes Ni (u2 :: u0) -> _!_ True [] []; _NO_DEFLT_ } _N_ #-}
 mkLookupFun :: (a -> a -> Bool) -> [(a, b)] -> a -> Labda b
 mkLookupFun :: (a -> a -> Bool) -> [(a, b)] -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 returnMaB :: a -> MaybeErr a b
 returnMaB :: a -> MaybeErr a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 2 1 X 2 _/\_ u0 u1 -> \ (u2 :: u0) -> _!_ _ORIG_ Maybes Succeeded [u0, u1] [u2] _N_ #-}
 returnMaybe :: a -> Labda a
 returnMaybe :: a -> Labda a
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: u0) -> _!_ _ORIG_ Maybes Ni [u0] [u1] _N_ #-}
 thenMaB :: MaybeErr a c -> (a -> MaybeErr b c) -> MaybeErr b c
 thenMaB :: MaybeErr a c -> (a -> MaybeErr b c) -> MaybeErr b c
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _F_ _IF_ARGS_ 3 2 CX 6 _/\_ u0 u1 u2 -> \ (u3 :: MaybeErr u0 u2) (u4 :: u0 -> MaybeErr u1 u2) -> case u3 of { _ALG_ _ORIG_ Maybes Succeeded (u5 :: u0) -> _APP_  u4 [ u5 ]; _ORIG_ Maybes Failed (u6 :: u2) -> _!_ _ORIG_ Maybes Failed [u1, u2] [u6]; _NO_DEFLT_ } _N_ #-}
 thenMaybe :: Labda a -> (a -> Labda b) -> Labda b
 thenMaybe :: Labda a -> (a -> Labda b) -> Labda b
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _F_ _IF_ARGS_ 2 2 CX 5 _/\_ u0 u1 -> \ (u2 :: Labda u0) (u3 :: u0 -> Labda u1) -> case u2 of { _ALG_ _ORIG_ Maybes Hamna  -> _!_ _ORIG_ Maybes Hamna [u1] []; _ORIG_ Maybes Ni (u4 :: u0) -> _APP_  u3 [ u4 ]; _NO_DEFLT_ } _N_ #-}
 
 
index 8b67652..d28717d 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Outputable where
 import CharSeq(CSeq)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Outputable where
 import CharSeq(CSeq)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle(..), Pretty(..), PrettyRep)
 import SrcLoc(SrcLoc)
 import CmdLineOpts(GlobalSwitch)
 import PreludePS(_PackedString)
 import Pretty(Delay, PprStyle(..), Pretty(..), PrettyRep)
 import SrcLoc(SrcLoc)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
 import UniType(UniType)
 import Unique(Unique)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
 import UniType(UniType)
 import Unique(Unique)
 class NamedThing a where
        getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(SAAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> ExportFlag) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
        isLocallyDefined :: a -> Bool
        isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(ASAAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> Bool) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
        getOrigName :: a -> (_PackedString, _PackedString)
        getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AASAAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> (_PackedString, _PackedString)) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
        getOccurrenceName :: a -> _PackedString
        getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAASAAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> _PackedString) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
        getInformingModules :: a -> [_PackedString]
        getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAAASAAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> [_PackedString]) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
        getSrcLoc :: a -> SrcLoc
        getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAAAASAAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> SrcLoc) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
        getTheUnique :: a -> Unique
        getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAASAAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> Unique) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
        hasType :: a -> Bool
        hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAASAA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> Bool) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
        getType :: a -> UniType
        getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAAASA)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> UniType) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
        fromPreludeCore :: a -> Bool
        fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "U(AAAAAAAAAS)" {_A_ 1 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: u0 -> Bool) -> u1 _N_} _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
 class Outputable a where
        ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
 data ExportFlag   = ExportAll | ExportAbs | NotExported
 data ExportFlag   = ExportAll | ExportAbs | NotExported
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data GlobalSwitch 
 data PprStyle   = PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char])
 type Pretty = Int -> Bool -> PrettyRep
 data PprStyle   = PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char])
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data PrettyRep 
+data SrcLoc 
+data UniType 
+data Unique 
 getLocalName :: NamedThing a => a -> _PackedString
 getLocalName :: NamedThing a => a -> _PackedString
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AASAAAAAAA)L" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 4 _/\_ u0 -> \ (u1 :: u0 -> (_PackedString, _PackedString)) (u2 :: u0) -> case _APP_  u1 [ u2 ] of { _ALG_ _TUP_2 (u3 :: _PackedString) (u4 :: _PackedString) -> u4; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 1 2 CX 5 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> case u1 of { _ALG_ _TUP_10 (u3 :: u0 -> ExportFlag) (u4 :: u0 -> Bool) (u5 :: u0 -> (_PackedString, _PackedString)) (u6 :: u0 -> _PackedString) (u7 :: u0 -> [_PackedString]) (u8 :: u0 -> SrcLoc) (u9 :: u0 -> Unique) (ua :: u0 -> Bool) (ub :: u0 -> UniType) (uc :: u0 -> Bool) -> case _APP_  u5 [ u2 ] of { _ALG_ _TUP_2 (ud :: _PackedString) (ue :: _PackedString) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _SPECIALISE_ [ ShortName ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(LA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 4 \ (u0 :: _PackedString) -> case _APP_  _WRKR_ _CONSTM_ NamedThing getOrigName (ShortName) [ u0 ] of { _ALG_ _TUP_2 (u1 :: _PackedString) (u2 :: _PackedString) -> u2; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> case _APP_  _WRKR_ _CONSTM_ NamedThing getOrigName (ShortName) [ u1 ] of { _ALG_ _TUP_2 (u3 :: _PackedString) (u4 :: _PackedString) -> u4; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ } #-}
 ifPprDebug :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ifPprDebug :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 12 \ (u0 :: PprStyle) (u1 :: Int -> Bool -> PrettyRep) -> case u0 of { _ALG_ _ORIG_ Pretty PprDebug  -> u1; (u2 :: PprStyle) -> \ (u3 :: Int) (u4 :: Bool) -> _APP_  _WRKR_ _ORIG_ Pretty ppNil [ u3 ] } _N_ #-}
 ifPprInterface :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ifPprInterface :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 12 \ (u0 :: PprStyle) (u1 :: Int -> Bool -> PrettyRep) -> case u0 of { _ALG_ _ORIG_ Pretty PprInterface (u2 :: GlobalSwitch -> Bool) -> u1; (u3 :: PprStyle) -> \ (u4 :: Int) (u5 :: Bool) -> _APP_  _WRKR_ _ORIG_ Pretty ppNil [ u4 ] } _N_ #-}
 ifPprShowAll :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ifPprShowAll :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 12 \ (u0 :: PprStyle) (u1 :: Int -> Bool -> PrettyRep) -> case u0 of { _ALG_ _ORIG_ Pretty PprShowAll  -> u1; (u2 :: PprStyle) -> \ (u3 :: Int) (u4 :: Bool) -> _APP_  _WRKR_ _ORIG_ Pretty ppNil [ u3 ] } _N_ #-}
 ifnotPprForUser :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ifnotPprForUser :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 12 \ (u0 :: PprStyle) (u1 :: Int -> Bool -> PrettyRep) -> case u0 of { _ALG_ _ORIG_ Pretty PprForUser  -> \ (u2 :: Int) (u3 :: Bool) -> _APP_  _WRKR_ _ORIG_ Pretty ppNil [ u2 ]; (u4 :: PprStyle) -> u1 } _N_ #-}
 ifnotPprShowAll :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ifnotPprShowAll :: PprStyle -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 12 \ (u0 :: PprStyle) (u1 :: Int -> Bool -> PrettyRep) -> case u0 of { _ALG_ _ORIG_ Pretty PprShowAll  -> \ (u2 :: Int) (u3 :: Bool) -> _APP_  _WRKR_ _ORIG_ Pretty ppNil [ u2 ]; (u4 :: PprStyle) -> u1 } _N_ #-}
 interpp'SP :: Outputable a => PprStyle -> [a] -> Int -> Bool -> PrettyRep
 interpp'SP :: Outputable a => PprStyle -> [a] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 12122 _N_ _S_ "LLS" _N_ _SPECIALISE_ [ Id ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ }, [ TyVar ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ }, [ UniType ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ }, [ TyVarTemplate ] 1 { _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ }, [ ProtoName ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ }, [ (Id, Id) ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ } #-}
 interppSP :: Outputable a => PprStyle -> [a] -> Int -> Bool -> PrettyRep
 interppSP :: Outputable a => PprStyle -> [a] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 12122 _N_ _S_ "LLS" _N_ _SPECIALISE_ [ Id ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ }, [ TyVar ] 1 { _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ } #-}
 isAconop :: _PackedString -> Bool
 isAconop :: _PackedString -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isAvarid :: _PackedString -> Bool
 isAvarid :: _PackedString -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isAvarop :: _PackedString -> Bool
 isAvarop :: _PackedString -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isConop :: _PackedString -> Bool
 isConop :: _PackedString -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 isExported :: NamedThing a => a -> Bool
 isExported :: NamedThing a => a -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(SAAAAAAAAA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Id ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyCon ] 1 { _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ }, [ Class ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: ExportFlag) -> case u0 of { _ALG_ _ORIG_ Outputable NotExported  -> _!_ False [] []; (u1 :: ExportFlag) -> _!_ True [] [] } _N_} _N_ _N_ } #-}
 isOpLexeme :: NamedThing a => a -> Bool
 isOpLexeme :: NamedThing a => a -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAASAAAAAA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Id ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyCon ] 1 { _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ } #-}
 ltLexical :: (NamedThing a, NamedThing b) => a -> b -> Bool
 ltLexical :: (NamedThing a, NamedThing b) => a -> b -> Bool
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "U(ASSAAAAAAA)U(ALSAAAAAAA)LL" {_A_ 5 _U_ 11122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Id, Id ] 2 { _A_ 2 _U_ 11 _N_ _S_ "U(LAAS)U(LAAS)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyCon, TyCon ] 2 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Class, Class ] 2 { _A_ 2 _U_ 11 _N_ _S_ "U(AU(LLSAAA)AAAAAAAA)U(AU(LLLAAA)AAAAAAAA)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 pprNonOp :: (NamedThing a, Outputable a) => PprStyle -> a -> Int -> Bool -> PrettyRep
 pprNonOp :: (NamedThing a, Outputable a) => PprStyle -> a -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 122222 _N_ _S_ "U(AAASAAAAAA)L" {_A_ 4 _U_ 112222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Id ] 2 { _A_ 2 _U_ 2122 _N_ _S_ "LU(LLLS)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyCon ] 2 { _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ } #-}
 pprOp :: (NamedThing a, Outputable a) => PprStyle -> a -> Int -> Bool -> PrettyRep
 pprOp :: (NamedThing a, Outputable a) => PprStyle -> a -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 122222 _N_ _S_ "U(AAASAAAAAA)L" {_A_ 4 _U_ 112222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Id ] 2 { _A_ 2 _U_ 2122 _N_ _S_ "LU(LLLS)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 instance (Outputable a, Outputable b) => Outputable (a, b)
 instance (Outputable a, Outputable b) => Outputable (a, b)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-}
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-}
 instance Outputable Bool
 instance Outputable Bool
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_
-        ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable a => Outputable [a]
 instance Outputable a => Outputable [a]
-       {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 50f7652..6a05ebe 100644 (file)
@@ -6,76 +6,43 @@ import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import Stdio(_FILE)
 import Unpretty(Unpretty(..))
 import PreludeRatio(Ratio(..))
 import Stdio(_FILE)
 import Unpretty(Unpretty(..))
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data Delay a   {-# GHC_PRAGMA MkDelay a #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data CSeq 
+data Delay a 
+data GlobalSwitch 
 data PprStyle   = PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char])
 type Pretty = Int -> Bool -> PrettyRep
 data PrettyRep   = MkPrettyRep CSeq (Delay Int) Bool Bool
 type Unpretty = CSeq
 codeStyle :: PprStyle -> Bool
 data PprStyle   = PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char])
 type Pretty = Int -> Bool -> PrettyRep
 data PrettyRep   = MkPrettyRep CSeq (Delay Int) Bool Bool
 type Unpretty = CSeq
 codeStyle :: PprStyle -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: PprStyle) -> case u0 of { _ALG_ _ORIG_ Pretty PprForC (u1 :: GlobalSwitch -> Bool) -> _!_ True [] []; _ORIG_ Pretty PprForAsm (u2 :: GlobalSwitch -> Bool) (u3 :: Bool) (u4 :: [Char] -> [Char]) -> _!_ True [] []; (u5 :: PprStyle) -> _!_ False [] [] } _N_ #-}
 pp'SP :: Int -> Bool -> PrettyRep
 pp'SP :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_  _ORIG_ Pretty ppStr [ _NOREP_S_ ", " ] _N_ #-}
 ppAbove :: (Int -> Bool -> PrettyRep) -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ppAbove :: (Int -> Bool -> PrettyRep) -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 1120 _N_ _S_ "SLLA" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppAboves :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
 ppAboves :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: [Int -> Bool -> PrettyRep]) -> case u0 of { _ALG_ (:) (u1 :: Int -> Bool -> PrettyRep) (u2 :: [Int -> Bool -> PrettyRep]) -> _APP_  _TYAPP_  _ORIG_ PreludeList foldr1 { (Int -> Bool -> PrettyRep) } [ _ORIG_ Pretty ppAbove, u0 ]; _NIL_  -> _ORIG_ Pretty ppNil; _NO_DEFLT_ } _N_ #-}
 ppAppendFile :: _FILE -> Int -> (Int -> Bool -> PrettyRep) -> _State _RealWorld -> ((), _State _RealWorld)
 ppAppendFile :: _FILE -> Int -> (Int -> Bool -> PrettyRep) -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1212 _N_ _S_ "U(P)LSL" {_A_ 4 _U_ 2212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppBeside :: (Int -> Bool -> PrettyRep) -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ppBeside :: (Int -> Bool -> PrettyRep) -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 1120 _N_ _S_ "SLLA" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppBesides :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
 ppBesides :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: [Int -> Bool -> PrettyRep]) -> case u0 of { _ALG_ (:) (u1 :: Int -> Bool -> PrettyRep) (u2 :: [Int -> Bool -> PrettyRep]) -> _APP_  _TYAPP_  _ORIG_ PreludeList foldr1 { (Int -> Bool -> PrettyRep) } [ _ORIG_ Pretty ppBeside, u0 ]; _NIL_  -> _ORIG_ Pretty ppNil; _NO_DEFLT_ } _N_ #-}
 ppCat :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
 ppCat :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 ppChar :: Char -> Int -> Bool -> PrettyRep
 ppChar :: Char -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 210 _N_ _S_ "LLA" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppComma :: Int -> Bool -> PrettyRep
 ppComma :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppDouble :: Double -> Int -> Bool -> PrettyRep
 ppDouble :: Double -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 110 _N_ _N_ _N_ _N_ #-}
 ppEquals :: Int -> Bool -> PrettyRep
 ppEquals :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppFloat :: Float -> Int -> Bool -> PrettyRep
 ppFloat :: Float -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 210 _N_ _N_ _N_ _N_ #-}
 ppHang :: (Int -> Bool -> PrettyRep) -> Int -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ppHang :: (Int -> Bool -> PrettyRep) -> Int -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 12222 _N_ _S_ "SLLLL" _N_ _N_ #-}
 ppInt :: Int -> Int -> Bool -> PrettyRep
 ppInt :: Int -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 110 _N_ _S_ "LLA" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppInteger :: Integer -> Int -> Bool -> PrettyRep
 ppInteger :: Integer -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 110 _N_ _N_ _N_ _N_ #-}
 ppInterleave :: (Int -> Bool -> PrettyRep) -> [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
 ppInterleave :: (Int -> Bool -> PrettyRep) -> [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 ppIntersperse :: (Int -> Bool -> PrettyRep) -> [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
 ppIntersperse :: (Int -> Bool -> PrettyRep) -> [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 ppLbrack :: Int -> Bool -> PrettyRep
 ppLbrack :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppLparen :: Int -> Bool -> PrettyRep
 ppLparen :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppNest :: Int -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
 ppNest :: Int -> (Int -> Bool -> PrettyRep) -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LSLE" _N_ _N_ #-}
 ppNil :: Int -> Bool -> PrettyRep
 ppNil :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _S_ "LA" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppPStr :: _PackedString -> Int -> Bool -> PrettyRep
 ppPStr :: _PackedString -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 210 _N_ _S_ "LLA" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 ppRational :: Ratio Integer -> Int -> Bool -> PrettyRep
 ppRational :: Ratio Integer -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 110 _N_ _N_ _N_ _N_ #-}
 ppRbrack :: Int -> Bool -> PrettyRep
 ppRbrack :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppRparen :: Int -> Bool -> PrettyRep
 ppRparen :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppSP :: Int -> Bool -> PrettyRep
 ppSP :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppSemi :: Int -> Bool -> PrettyRep
 ppSemi :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _N_ _N_ _N_ #-}
 ppSep :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
 ppSep :: [Int -> Bool -> PrettyRep] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 ppShow :: Int -> (Int -> Bool -> PrettyRep) -> [Char]
 ppShow :: Int -> (Int -> Bool -> PrettyRep) -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 ppStr :: [Char] -> Int -> Bool -> PrettyRep
 ppStr :: [Char] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 210 _N_ _S_ "LLA" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 prettyToUn :: (Int -> Bool -> PrettyRep) -> CSeq
 prettyToUn :: (Int -> Bool -> PrettyRep) -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 6947486..b57b529 100644 (file)
@@ -1,59 +1,33 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniqFM where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniqFM where
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import Maybes(Labda)
-import NameTypes(ShortName)
 import Outputable(NamedThing)
 import TyVar(TyVar)
 import Outputable(NamedThing)
 import TyVar(TyVar)
-import UniType(UniType)
-import Unique(Unique, u2i)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+import Unique(Unique)
+data Id 
+data TyVar 
+data UniqFM a 
+data Unique 
 addToUFM :: NamedThing a => UniqFM b -> a -> b -> UniqFM b
 addToUFM :: NamedThing a => UniqFM b -> a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 4 _U_ 1222 _N_ _S_ "U(AAAAAASAAA)SLL" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 3 _U_ 222 _N_ _S_ "SSL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 3 _U_ 222 _N_ _S_ "SSL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "SU(U(P)AAA)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 addToUFM_Directly :: UniqFM a -> Unique -> a -> UniqFM a
 addToUFM_Directly :: UniqFM a -> Unique -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "SU(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 delFromUFM :: NamedThing a => UniqFM b -> a -> UniqFM b
 delFromUFM :: NamedThing a => UniqFM b -> a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 delListFromUFM :: NamedThing a => UniqFM b -> [a] -> UniqFM b
 delListFromUFM :: NamedThing a => UniqFM b -> [a] -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ } #-}
 eltsUFM :: UniqFM a -> [a]
 eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 emptyUFM :: UniqFM a
 emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
 filterUFM :: (a -> Bool) -> UniqFM a -> UniqFM a
 filterUFM :: (a -> Bool) -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 intersectUFM :: UniqFM a -> UniqFM a -> UniqFM a
 intersectUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 isNullUFM :: UniqFM a -> Bool
 isNullUFM :: UniqFM a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 5 _/\_ u0 -> \ (u1 :: UniqFM u0) -> case u1 of { _ALG_ _ORIG_ UniqFM EmptyUFM  -> _!_ True [] []; (u2 :: UniqFM u0) -> _!_ False [] [] } _N_ #-}
 listToUFM :: NamedThing a => [(a, b)] -> UniqFM b
 listToUFM :: NamedThing a => [(a, b)] -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ } #-}
 listToUFM_Directly :: [(Unique, a)] -> UniqFM a
 listToUFM_Directly :: [(Unique, a)] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 lookupDirectlyUFM :: UniqFM a -> Unique -> Labda a
 lookupDirectlyUFM :: UniqFM a -> Unique -> Labda a
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "SU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 lookupUFM :: NamedThing a => UniqFM b -> a -> Labda b
 lookupUFM :: NamedThing a => UniqFM b -> a -> Labda b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)SL" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 21 _N_ _S_ "SU(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 mapUFM :: (a -> b) -> UniqFM a -> UniqFM b
 mapUFM :: (a -> b) -> UniqFM a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 minusUFM :: UniqFM a -> UniqFM a -> UniqFM a
 minusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
 plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 plusUFM_C :: (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
 plusUFM_C :: (a -> a -> a) -> UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-}
 singletonDirectlyUFM :: Unique -> a -> UniqFM a
 singletonDirectlyUFM :: Unique -> a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 4 _/\_ u0 -> \ (u1 :: Unique) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u3, u2]; _NO_DEFLT_ } _N_ #-}
 singletonUFM :: NamedThing a => a -> b -> UniqFM b
 singletonUFM :: NamedThing a => a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)LL" {_A_ 3 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 2 3 XXX 6 _/\_ u0 u1 -> \ (u2 :: u0 -> Unique) (u3 :: u0) (u4 :: u1) -> case _APP_  u2 [ u3 ] of { _ALG_ _ORIG_ Unique MkUnique (u5 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [u5, u4]; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 2 3 CXX 7 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: u0) (u4 :: u1) -> case case u2 of { _ALG_ _TUP_10 (u5 :: u0 -> ExportFlag) (u6 :: u0 -> Bool) (u7 :: u0 -> (_PackedString, _PackedString)) (u8 :: u0 -> _PackedString) (u9 :: u0 -> [_PackedString]) (ua :: u0 -> SrcLoc) (ub :: u0 -> Unique) (uc :: u0 -> Bool) (ud :: u0 -> UniType) (ue :: u0 -> Bool) -> _APP_  ub [ u3 ]; _NO_DEFLT_ } of { _ALG_ _ORIG_ Unique MkUnique (uf :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [uf, u4]; _NO_DEFLT_ } _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "U(U(P)AAA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 5 _/\_ u0 -> \ (u1 :: Id) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Id Id (u3 :: Unique) (u4 :: UniType) (u5 :: IdInfo) (u6 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ Unique MkUnique (u7 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u7, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ } #-}
 sizeUFM :: UniqFM a -> Int
 sizeUFM :: UniqFM a -> Int
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 ufmToList :: UniqFM a -> [(Unique, a)]
 ufmToList :: UniqFM a -> [(Unique, a)]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 
 
index 1abe6e0..0a5b629 100644 (file)
@@ -1,61 +1,32 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniqSet where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface UniqSet where
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(NamedThing)
 import PreludePS(_PackedString)
 import TyCon(TyCon)
 import TyVar(TyVar)
 import Name(Name)
 import NameTypes(FullName, ShortName)
 import Outputable(NamedThing)
 import PreludePS(_PackedString)
 import TyCon(TyCon)
 import TyVar(TyVar)
-import UniType(UniType)
-import UniqFM(UniqFM, eltsUFM, emptyUFM, intersectUFM, isNullUFM, minusUFM, plusUFM, singletonUFM)
-import Unique(Unique, u2i)
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+import UniqFM(UniqFM)
+import Unique(Unique)
+data Id 
 type IdSet = UniqFM Id
 type IdSet = UniqFM Id
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
+data Name 
 type NameSet = UniqFM Name
 type NameSet = UniqFM Name
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
+data TyVar 
 type TyVarSet = UniqFM TyVar
 type TyVarSet = UniqFM TyVar
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 type UniqSet a = UniqFM a
 type UniqSet a = UniqFM a
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 elementOfUniqSet :: NamedThing a => a -> UniqFM a -> Bool
 elementOfUniqSet :: NamedThing a => a -> UniqFM a -> Bool
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)LS" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ TyVar ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ }, [ Id ] 1 { _A_ 2 _U_ 12 _N_ _S_ "U(U(P)AAA)S" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Name ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ } #-}
-eltsUFM :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-emptyUFM :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
 emptyUniqSet :: UniqFM a
 emptyUniqSet :: UniqFM a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ UniqFM EmptyUFM [u0] [] _N_ #-}
-intersectUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 intersectUniqSets :: UniqFM a -> UniqFM a -> UniqFM a
 intersectUniqSets :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM intersectUFM _N_ #-}
 isEmptyUniqSet :: UniqFM a -> Bool
 isEmptyUniqSet :: UniqFM a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM isNullUFM _N_ #-}
-isNullUFM :: UniqFM a -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 5 _/\_ u0 -> \ (u1 :: UniqFM u0) -> case u1 of { _ALG_ _ORIG_ UniqFM EmptyUFM  -> _!_ True [] []; (u2 :: UniqFM u0) -> _!_ False [] [] } _N_ #-}
 mapUniqSet :: NamedThing b => (a -> b) -> UniqFM a -> UniqFM b
 mapUniqSet :: NamedThing b => (a -> b) -> UniqFM a -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "LLS" _N_ _SPECIALISE_ [ _N_, TyVar ] 1 { _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ }, [ _N_, Id ] 1 { _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ }, [ _N_, Name ] 1 { _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ } #-}
-minusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 minusUniqSet :: UniqFM a -> UniqFM a -> UniqFM a
 minusUniqSet :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM minusUFM _N_ #-}
 mkUniqSet :: NamedThing a => [a] -> UniqFM a
 mkUniqSet :: NamedThing a => [a] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _SPECIALISE_ [ TyVar ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ Id ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ }, [ Name ] 1 { _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ } #-}
-plusUFM :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-singletonUFM :: NamedThing a => a -> b -> UniqFM b
-       {-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "U(AAAAAASAAA)LL" {_A_ 3 _U_ 122 _N_ _N_ _F_ _IF_ARGS_ 2 3 XXX 6 _/\_ u0 u1 -> \ (u2 :: u0 -> Unique) (u3 :: u0) (u4 :: u1) -> case _APP_  u2 [ u3 ] of { _ALG_ _ORIG_ Unique MkUnique (u5 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [u5, u4]; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 2 3 CXX 7 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: u0) (u4 :: u1) -> case case u2 of { _ALG_ _TUP_10 (u5 :: u0 -> ExportFlag) (u6 :: u0 -> Bool) (u7 :: u0 -> (_PackedString, _PackedString)) (u8 :: u0 -> _PackedString) (u9 :: u0 -> [_PackedString]) (ua :: u0 -> SrcLoc) (ub :: u0 -> Unique) (uc :: u0 -> Bool) (ud :: u0 -> UniType) (ue :: u0 -> Bool) -> _APP_  ub [ u3 ]; _NO_DEFLT_ } of { _ALG_ _ORIG_ Unique MkUnique (uf :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u1] [uf, u4]; _NO_DEFLT_ } _SPECIALISE_ [ Name, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 2 _U_ 12 _N_ _S_ "U(U(P)AAA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: Int#) (u2 :: u0) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u1, u2] _N_} _F_ _IF_ARGS_ 1 2 CX 5 _/\_ u0 -> \ (u1 :: Id) (u2 :: u0) -> case u1 of { _ALG_ _ORIG_ Id Id (u3 :: Unique) (u4 :: UniType) (u5 :: IdInfo) (u6 :: IdDetails) -> case u3 of { _ALG_ _ORIG_ Unique MkUnique (u7 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [u0] [u7, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ } #-}
 singletonUniqSet :: NamedThing a => a -> UniqFM a
 singletonUniqSet :: NamedThing a => a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAAAAASAAA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 1 2 XX 4 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ UniqFM singletonUFM { u0 } { u0 } [ u1, u2, u2 ] _SPECIALISE_ [ TyVar ] 1 { _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ UniqFM singletonUFM [ (TyVar), _N_ ] { TyVar } [ u0, u0 ] _N_ }, [ Id ] 1 { _A_ 1 _U_ 1 _N_ _S_ "U(U(P)LLL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u5 :: Int#) -> _!_ _ORIG_ UniqFM LeafUFM [Id] [u5, u0]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ }, [ Name ] 1 { _A_ 1 _U_ 2 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Name) -> _APP_  _TYAPP_  _SPEC_ _ORIG_ UniqFM singletonUFM [ (Name), _N_ ] { Name } [ u0, u0 ] _N_ } #-}
-u2i :: Unique -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Int#) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u1 :: Int#) -> u1; _NO_DEFLT_ } _N_ #-}
 unionManyUniqSets :: [UniqFM a] -> UniqFM a
 unionManyUniqSets :: [UniqFM a] -> UniqFM a
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unionUniqSets :: UniqFM a -> UniqFM a -> UniqFM a
 unionUniqSets :: UniqFM a -> UniqFM a -> UniqFM a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM plusUFM _N_ #-}
 uniqSetToList :: UniqFM a -> [a]
 uniqSetToList :: UniqFM a -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ UniqFM eltsUFM _N_ #-}
 
 
index 3cc0005..f90bd85 100644 (file)
@@ -1,67 +1,37 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Unpretty where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Unpretty where
-import CharSeq(CSeq, cAppendFile, cInt)
+import CharSeq(CSeq)
 import CmdLineOpts(GlobalSwitch)
 import PreludePS(_PackedString)
 import Pretty(PprStyle(..))
 import Stdio(_FILE)
 import CmdLineOpts(GlobalSwitch)
 import PreludePS(_PackedString)
 import Pretty(PprStyle(..))
 import Stdio(_FILE)
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data CSeq 
+data GlobalSwitch 
 data PprStyle   = PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char])
 type Unpretty = CSeq
 data PprStyle   = PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char])
 type Unpretty = CSeq
-cAppendFile :: _FILE -> CSeq -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)SL" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-cInt :: Int -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ CharSeq CInt [] [u0] _N_ #-}
 uppAbove :: CSeq -> CSeq -> CSeq
 uppAbove :: CSeq -> CSeq -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 uppAboves :: [CSeq] -> CSeq
 uppAboves :: [CSeq] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 uppAppendFile :: _FILE -> Int -> CSeq -> _State _RealWorld -> ((), _State _RealWorld)
 uppAppendFile :: _FILE -> Int -> CSeq -> _State _RealWorld -> ((), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1022 _N_ _S_ "U(P)ASL" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 uppBeside :: CSeq -> CSeq -> CSeq
 uppBeside :: CSeq -> CSeq -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: CSeq) (u1 :: CSeq) -> _!_ _ORIG_ CharSeq CAppend [] [u0, u1] _N_ #-}
 uppBesides :: [CSeq] -> CSeq
 uppBesides :: [CSeq] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 uppCat :: [CSeq] -> CSeq
 uppCat :: [CSeq] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 uppChar :: Char -> CSeq
 uppChar :: Char -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Char) -> _!_ _ORIG_ CharSeq CCh [] [u0] _N_ #-}
 uppComma :: CSeq
 uppComma :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppEquals :: CSeq
 uppEquals :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppInt :: Int -> CSeq
 uppInt :: Int -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ CharSeq CInt [] [u0] _N_ #-}
 uppInteger :: Integer -> CSeq
 uppInteger :: Integer -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ #-}
 uppInterleave :: CSeq -> [CSeq] -> CSeq
 uppInterleave :: CSeq -> [CSeq] -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 uppIntersperse :: CSeq -> [CSeq] -> CSeq
 uppIntersperse :: CSeq -> [CSeq] -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 uppLbrack :: CSeq
 uppLbrack :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppLparen :: CSeq
 uppLparen :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppNest :: Int -> CSeq -> CSeq
 uppNest :: Int -> CSeq -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AS" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: CSeq) -> u0 _N_} _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int) (u1 :: CSeq) -> u1 _N_ #-}
 uppNil :: CSeq
 uppNil :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CharSeq CNil [] [] _N_ #-}
 uppPStr :: _PackedString -> CSeq
 uppPStr :: _PackedString -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: _PackedString) -> _!_ _ORIG_ CharSeq CPStr [] [u0] _N_ #-}
 uppRbrack :: CSeq
 uppRbrack :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppRparen :: CSeq
 uppRparen :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppSP :: CSeq
 uppSP :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppSemi :: CSeq
 uppSemi :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 uppSep :: [CSeq] -> CSeq
 uppSep :: [CSeq] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ Unpretty uppBesides _N_ #-}
 uppShow :: Int -> CSeq -> [Char]
 uppShow :: Int -> CSeq -> [Char]
-       {-# GHC_PRAGMA _A_ 2 _U_ 02 _N_ _S_ "AS" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ CharSeq cShow _N_} _F_ _IF_ARGS_ 0 2 XX 2 \ (u0 :: Int) (u1 :: CSeq) -> _APP_  _ORIG_ CharSeq cShow [ u1 ] _N_ #-}
 uppStr :: [Char] -> CSeq
 uppStr :: [Char] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [Char]) -> _!_ _ORIG_ CharSeq CStr [] [u0] _N_ #-}
 
 
index 0483090..20b3650 100644 (file)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Util where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Util where
-import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelative, ReturnInfo)
-import AbsSyn(Module)
-import Bag(Bag, emptyBag, snocBag)
-import BasicLit(BasicLit, kindOfBasicLit, typeOfBasicLit)
-import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC)
-import CLabelInfo(CLabel)
-import CgBindery(StableLoc, VolatileLoc)
-import CgMonad(EndOfBlockInfo, Sequel, StubFlag)
-import CharSeq(CSeq, cAppend, cCh, cNil, cPStr, cShow, cStr)
-import Class(Class, ClassOp)
-import ClosureInfo(ClosureInfo, LambdaFormInfo, StandardFormInfo)
-import CmdLineOpts(GlobalSwitch, SimplifierSwitch, SwitchResult, switchIsOn)
-import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr, pprCoreBinding, pprCoreExpr)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
-import FiniteMap(FiniteMap, emptyFM)
-import HeapOffs(HeapOffset)
-import HsBinds(Bind, Binds, MonoBinds, Sig)
-import HsCore(UfCostCentre, UfId, UnfoldingCoreAlts, UnfoldingCoreAtom, UnfoldingCoreBinding, UnfoldingCoreDefault, UnfoldingCoreExpr, UnfoldingPrimOp)
-import HsDecls(ClassDecl, ConDecl, DataTypeSig, DefaultDecl, FixityDecl, InstDecl, SpecialisedInstanceSig, TyDecl)
-import HsExpr(ArithSeqInfo, Expr, Qual)
-import HsImpExp(IE, IfaceImportDecl, ImportedInterface, Interface, Renaming)
-import HsLit(Literal)
-import HsMatches(GRHS, GRHSsAndBinds, Match)
-import HsPat(InPat, TypecheckedPat, typeOfPat)
-import HsPragmas(ClassOpPragmas, ClassPragmas, DataPragmas, GenPragmas, ImpStrictness, ImpUnfolding, InstancePragmas, TypePragmas)
-import HsTypes(MonoType, PolyType)
-import Id(Id, IdDetails, cmpId, eqId, getIdKind, getIdUniType)
-import IdEnv(IdEnv(..))
-import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo, nullSpecEnv)
-import Inst(Inst, InstOrigin, OverloadedLit)
-import InstEnv(InstTemplate, InstTy)
-import MagicUFs(MagicUnfoldingFun)
+import CharSeq(CSeq)
 import Maybes(Labda(..))
 import Maybes(Labda(..))
-import Name(Name, cmpName, eqName)
-import NameTypes(FullName, Provenance, ShortName)
-import OrdList(OrdList)
-import Outputable(ExportFlag, NamedThing(..), Outputable(..))
 import PreludePS(_PackedString)
 import PreludePS(_PackedString)
-import PreludeRatio(Ratio(..))
-import Pretty(Delay, PprStyle, Pretty(..), PrettyRep, ppDouble, ppInt, ppInteger, ppNil, ppRational, ppStr)
-import PrimKind(PrimKind)
-import PrimOps(PrimOp, pprPrimOp, tagOf_PrimOp)
-import ProtoName(ProtoName, cmpByLocalName, cmpProtoName, eqByLocalName, eqProtoName)
-import SMRep(SMRep, SMSpecRepKind, SMUpdateKind)
-import SimplEnv(EnclosingCcDetails, FormSummary, IdVal, SimplEnv, UnfoldConApp, UnfoldEnv, UnfoldItem, UnfoldingDetails, UnfoldingGuidance)
-import SimplMonad(SimplCount, TickType)
-import SplitUniq(SplitUniqSupply)
-import SrcLoc(SrcLoc, mkUnknownSrcLoc)
-import StgSyn(StgAtom, StgBinderInfo, StgBinding, StgCaseAlternatives, StgCaseDefault, StgExpr, StgRhs, UpdateFlag)
-import TyCon(TyCon)
-import TyVar(TyVar, TyVarTemplate)
-import TyVarEnv(TyVarEnv(..))
-import UniTyFuns(kindFromType, pprTyCon, pprUniType)
-import UniType(UniType)
-import UniqFM(UniqFM)
-import Unique(Unique, UniqueSupply, cmpUnique, eqUnique, showUnique)
-class OptIdInfo a where
-       noInfo :: a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) -> _APP_  _TYAPP_  patError# { u0 } [ _NOREP_S_ "%DIdInfo.OptIdInfo.noInfo\"" ] _N_ #-}
-       getInfo :: IdInfo -> a
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.getInfo\"", u2 ] _N_ #-}
-       addInfo :: IdInfo -> a -> IdInfo
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) (u3 :: u0) -> _APP_  _TYAPP_  patError# { (IdInfo -> u0 -> IdInfo) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.addInfo\"", u2, u3 ] _N_ #-}
-       ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 6 _U_ 022222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 6 XXXXXX 7 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: PprStyle) (u3 :: Id -> Id) (u4 :: u0) (u5 :: Int) (u6 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.ppInfo\"", u2, u3, u4, u5, u6 ] _N_ #-}
-class NamedThing a where
-       getExportFlag :: a -> ExportFlag
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-}
-       isLocallyDefined :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-}
-       getOrigName :: a -> (_PackedString, _PackedString)
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-}
-       getOccurrenceName :: a -> _PackedString
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-}
-       getInformingModules :: a -> [_PackedString]
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-}
-       getSrcLoc :: a -> SrcLoc
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-}
-       getTheUnique :: a -> Unique
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-}
-       hasType :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-}
-       getType :: a -> UniType
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-}
-       fromPreludeCore :: a -> Bool
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_
-               {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_  _TYAPP_  patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-}
-class Outputable a where
-       ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
-        {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_
-               {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_  _TYAPP_  patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-}
-data AbstractC         {-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode         {-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CExprMacro        {-# GHC_PRAGMA INFO_PTR | ENTRY_CODE | INFO_TAG | EVAL_TAG #-}
-data CStmtMacro        {-# GHC_PRAGMA ARGS_CHK_A_LOAD_NODE | ARGS_CHK_A | ARGS_CHK_B_LOAD_NODE | ARGS_CHK_B | HEAP_CHK | STK_CHK | UPD_CAF | UPD_IND | UPD_INPLACE_NOPTRS | UPD_INPLACE_PTRS | UPD_BH_UPDATABLE | UPD_BH_SINGLE_ENTRY | PUSH_STD_UPD_FRAME | POP_STD_UPD_FRAME | SET_ARITY | CHK_ARITY | SET_TAG #-}
-data MagicId   {-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data RegRelative       {-# GHC_PRAGMA HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset #-}
-data ReturnInfo        {-# GHC_PRAGMA DirectReturn | StaticVectoredReturn Int | DynamicVectoredReturn CAddrMode #-}
-data Module a b        {-# GHC_PRAGMA Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc #-}
-data Bag a     {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-}
-data BasicLit  {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
-data BinderInfo        {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-}
-data DuplicationDanger         {-# GHC_PRAGMA DupDanger | NoDupDanger #-}
-data FunOrArg  {-# GHC_PRAGMA FunOcc | ArgOcc #-}
-data InsideSCC         {-# GHC_PRAGMA InsideSCC | NotInsideSCC #-}
-data CLabel 
-data StableLoc         {-# GHC_PRAGMA NoStableLoc | VirAStkLoc Int | VirBStkLoc Int | LitLoc BasicLit | StableAmodeLoc CAddrMode #-}
-data VolatileLoc       {-# GHC_PRAGMA NoVolatileLoc | TempVarLoc Unique | RegLoc MagicId | VirHpLoc HeapOffset | VirNodeLoc HeapOffset #-}
-data EndOfBlockInfo    {-# GHC_PRAGMA EndOfBlockInfo Int Int Sequel #-}
-data Sequel    {-# GHC_PRAGMA InRetReg | OnStack Int | UpdateCode CAddrMode | CaseAlts CAddrMode (Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel)))) #-}
-data StubFlag  {-# GHC_PRAGMA Stubbed | NotStubbed #-}
-data CSeq      {-# GHC_PRAGMA CNil | CAppend CSeq CSeq | CIndent Int CSeq | CNewline | CStr [Char] | CCh Char | CInt Int | CPStr _PackedString #-}
-data Class     {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-}
-data ClassOp   {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-}
-data ClosureInfo       {-# GHC_PRAGMA MkClosureInfo Id LambdaFormInfo SMRep #-}
-data LambdaFormInfo    {-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
-data StandardFormInfo  {-# GHC_PRAGMA NonStandardThunk | SelectorThunk Id Id Int | VapThunk Id [StgAtom Id] Bool #-}
-data GlobalSwitch
-       {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
-data SimplifierSwitch  {-# GHC_PRAGMA SimplOkToDupCode | SimplFloatLetsExposingWHNF | SimplOkToFloatPrimOps | SimplAlwaysFloatLetsFromLets | SimplDoCaseElim | SimplReuseCon | SimplCaseOfCase | SimplLetToCase | SimplMayDeleteConjurableIds | SimplPedanticBottoms | SimplDoArityExpand | SimplDoFoldrBuild | SimplDoNewOccurAnal | SimplDoInlineFoldrBuild | IgnoreINLINEPragma | SimplDoLambdaEtaExpansion | SimplDoEtaReduction | EssentialUnfoldingsOnly | ShowSimplifierProgress | MaxSimplifierIterations Int | SimplUnfoldingUseThreshold Int | SimplUnfoldingCreationThreshold Int | KeepSpecPragmaIds | KeepUnusedBindings #-}
-data SwitchResult      {-# GHC_PRAGMA SwBool Bool | SwString [Char] | SwInt Int #-}
-data CoreArg a         {-# GHC_PRAGMA TypeArg UniType | ValArg (CoreAtom a) #-}
-data CoreAtom a        {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-}
-data CoreBinding a b   {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-}
-data CoreCaseAlternatives a b  {-# GHC_PRAGMA CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b) #-}
-data CoreCaseDefault a b       {-# GHC_PRAGMA CoNoDefault | CoBindDefault a (CoreExpr a b) #-}
-data CoreExpr a b      {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-}
-data CcKind    {-# GHC_PRAGMA UserCC _PackedString | AutoCC Id | DictCC Id #-}
-data CostCentre        {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
-data IsCafCC   {-# GHC_PRAGMA IsCafCC | IsNotCafCC #-}
-data IsDupdCC  {-# GHC_PRAGMA AnOriginalCC | ADupdCC #-}
-data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-data HeapOffset 
-data Bind a b  {-# GHC_PRAGMA EmptyBind | NonRecBind (MonoBinds a b) | RecBind (MonoBinds a b) #-}
-data Binds a b         {-# GHC_PRAGMA EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) #-}
-data MonoBinds a b     {-# GHC_PRAGMA EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc #-}
-data Sig a     {-# GHC_PRAGMA Sig a (PolyType a) (GenPragmas a) SrcLoc | ClassOpSig a (PolyType a) (ClassOpPragmas a) SrcLoc | SpecSig a (PolyType a) (Labda a) SrcLoc | InlineSig a UnfoldingGuidance SrcLoc | DeforestSig a SrcLoc | MagicUnfoldingSig a _PackedString SrcLoc #-}
-data UfCostCentre a    {-# GHC_PRAGMA UfPreludeDictsCC Bool | UfAllDictsCC _PackedString _PackedString Bool | UfUserCC _PackedString _PackedString _PackedString Bool Bool | UfAutoCC (UfId a) _PackedString _PackedString Bool Bool | UfDictCC (UfId a) _PackedString _PackedString Bool Bool #-}
-data UfId a    {-# GHC_PRAGMA BoringUfId a | SuperDictSelUfId a a | ClassOpUfId a a | DictFunUfId a (PolyType a) | ConstMethodUfId a a (PolyType a) | DefaultMethodUfId a a | SpecUfId (UfId a) [Labda (MonoType a)] | WorkerUfId (UfId a) #-}
-data UnfoldingCoreAlts a       {-# GHC_PRAGMA UfCoAlgAlts [(a, [(a, PolyType a)], UnfoldingCoreExpr a)] (UnfoldingCoreDefault a) | UfCoPrimAlts [(BasicLit, UnfoldingCoreExpr a)] (UnfoldingCoreDefault a) #-}
-data UnfoldingCoreAtom a       {-# GHC_PRAGMA UfCoVarAtom (UfId a) | UfCoLitAtom BasicLit #-}
-data UnfoldingCoreBinding a    {-# GHC_PRAGMA UfCoNonRec (a, PolyType a) (UnfoldingCoreExpr a) | UfCoRec [((a, PolyType a), UnfoldingCoreExpr a)] #-}
-data UnfoldingCoreDefault a    {-# GHC_PRAGMA UfCoNoDefault | UfCoBindDefault (a, PolyType a) (UnfoldingCoreExpr a) #-}
-data UnfoldingCoreExpr a       {-# GHC_PRAGMA UfCoVar (UfId a) | UfCoLit BasicLit | UfCoCon a [PolyType a] [UnfoldingCoreAtom a] | UfCoPrim (UnfoldingPrimOp a) [PolyType a] [UnfoldingCoreAtom a] | UfCoLam [(a, PolyType a)] (UnfoldingCoreExpr a) | UfCoTyLam a (UnfoldingCoreExpr a) | UfCoApp (UnfoldingCoreExpr a) (UnfoldingCoreAtom a) | UfCoTyApp (UnfoldingCoreExpr a) (PolyType a) | UfCoCase (UnfoldingCoreExpr a) (UnfoldingCoreAlts a) | UfCoLet (UnfoldingCoreBinding a) (UnfoldingCoreExpr a) | UfCoSCC (UfCostCentre a) (UnfoldingCoreExpr a) #-}
-data UnfoldingPrimOp a         {-# GHC_PRAGMA UfCCallOp _PackedString Bool Bool [PolyType a] (PolyType a) | UfOtherOp PrimOp #-}
-data ClassDecl a b     {-# GHC_PRAGMA ClassDecl [(a, a)] a a [Sig a] (MonoBinds a b) (ClassPragmas a) SrcLoc #-}
-data ConDecl a         {-# GHC_PRAGMA ConDecl a [MonoType a] SrcLoc #-}
-data DataTypeSig a     {-# GHC_PRAGMA AbstractTypeSig a SrcLoc | SpecDataSig a (MonoType a) SrcLoc #-}
-data DefaultDecl a     {-# GHC_PRAGMA DefaultDecl [MonoType a] SrcLoc #-}
-data FixityDecl a      {-# GHC_PRAGMA InfixL a Int | InfixR a Int | InfixN a Int #-}
-data InstDecl a b      {-# GHC_PRAGMA InstDecl [(a, a)] a (MonoType a) (MonoBinds a b) Bool _PackedString _PackedString [Sig a] (InstancePragmas a) SrcLoc #-}
-data SpecialisedInstanceSig a  {-# GHC_PRAGMA InstSpecSig a (MonoType a) SrcLoc #-}
-data TyDecl a  {-# GHC_PRAGMA TyData [(a, a)] a [a] [ConDecl a] [a] (DataPragmas a) SrcLoc | TySynonym a [a] (MonoType a) TypePragmas SrcLoc #-}
-data ArithSeqInfo a b  {-# GHC_PRAGMA From (Expr a b) | FromThen (Expr a b) (Expr a b) | FromTo (Expr a b) (Expr a b) | FromThenTo (Expr a b) (Expr a b) (Expr a b) #-}
-data Expr a b  {-# GHC_PRAGMA Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id #-}
-data Qual a b  {-# GHC_PRAGMA GeneratorQual b (Expr a b) | FilterQual (Expr a b) #-}
-data IE        {-# GHC_PRAGMA IEVar _PackedString | IEThingAbs _PackedString | IEThingAll _PackedString | IEConWithCons _PackedString [_PackedString] | IEClsWithOps _PackedString [_PackedString] | IEModuleContents _PackedString #-}
-data IfaceImportDecl   {-# GHC_PRAGMA IfaceImportDecl _PackedString [IE] [Renaming] SrcLoc #-}
-data ImportedInterface a b     {-# GHC_PRAGMA ImportAll (Interface a b) [Renaming] | ImportSome (Interface a b) [IE] [Renaming] | ImportButHide (Interface a b) [IE] [Renaming] #-}
-data Interface a b     {-# GHC_PRAGMA MkInterface _PackedString [IfaceImportDecl] [FixityDecl a] [TyDecl a] [ClassDecl a b] [InstDecl a b] [Sig a] SrcLoc #-}
-data Renaming  {-# GHC_PRAGMA MkRenaming _PackedString _PackedString #-}
-data Literal   {-# GHC_PRAGMA CharLit Char | CharPrimLit Char | StringLit _PackedString | StringPrimLit _PackedString | IntLit Integer | FracLit (Ratio Integer) | LitLitLitIn _PackedString | LitLitLit _PackedString UniType | IntPrimLit Integer | FloatPrimLit (Ratio Integer) | DoublePrimLit (Ratio Integer) #-}
-data GRHS a b  {-# GHC_PRAGMA GRHS (Expr a b) (Expr a b) SrcLoc | OtherwiseGRHS (Expr a b) SrcLoc #-}
-data GRHSsAndBinds a b         {-# GHC_PRAGMA GRHSsAndBindsIn [GRHS a b] (Binds a b) | GRHSsAndBindsOut [GRHS a b] (Binds a b) UniType #-}
-data Match a b         {-# GHC_PRAGMA PatMatch b (Match a b) | GRHSMatch (GRHSsAndBinds a b) #-}
-data InPat a   {-# GHC_PRAGMA WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal #-}
-data TypecheckedPat    {-# GHC_PRAGMA WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) #-}
-data ClassOpPragmas a  {-# GHC_PRAGMA NoClassOpPragmas | ClassOpPragmas (GenPragmas a) (GenPragmas a) #-}
-data ClassPragmas a    {-# GHC_PRAGMA NoClassPragmas | SuperDictPragmas [GenPragmas a] #-}
-data DataPragmas a     {-# GHC_PRAGMA DataPragmas [ConDecl a] [[Labda (MonoType a)]] #-}
-data GenPragmas a      {-# GHC_PRAGMA NoGenPragmas | GenPragmas (Labda Int) (Labda UpdateInfo) DeforestInfo (ImpStrictness a) (ImpUnfolding a) [([Labda (MonoType a)], Int, GenPragmas a)] #-}
-data ImpStrictness a   {-# GHC_PRAGMA NoImpStrictness | ImpStrictness Bool [Demand] (GenPragmas a) #-}
-data ImpUnfolding a    {-# GHC_PRAGMA NoImpUnfolding | ImpMagicUnfolding _PackedString | ImpUnfolding UnfoldingGuidance (UnfoldingCoreExpr a) #-}
-data InstancePragmas a         {-# GHC_PRAGMA NoInstancePragmas | SimpleInstancePragma (GenPragmas a) | ConstantInstancePragma (GenPragmas a) [(a, GenPragmas a)] | SpecialisedInstancePragma (GenPragmas a) [([Labda (MonoType a)], Int, InstancePragmas a)] #-}
-data TypePragmas       {-# GHC_PRAGMA NoTypePragmas | AbstractTySynonym #-}
-data MonoType a        {-# GHC_PRAGMA MonoTyVar a | MonoTyCon a [MonoType a] | FunMonoTy (MonoType a) (MonoType a) | ListMonoTy (MonoType a) | TupleMonoTy [PolyType a] | MonoTyVarTemplate a | MonoDict a (MonoType a) #-}
-data PolyType a        {-# GHC_PRAGMA UnoverloadedTy (MonoType a) | OverloadedTy [(a, a)] (MonoType a) | ForAllTy [a] (MonoType a) #-}
-data Id        {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data IdDetails         {-# GHC_PRAGMA LocalId ShortName Bool | SysLocalId ShortName Bool | SpecPragmaId ShortName (Labda SpecInfo) Bool | ImportedId FullName | PreludeId FullName | TopLevId FullName | DataConId FullName Int [TyVarTemplate] [(Class, UniType)] [UniType] TyCon | TupleConId Int | SuperDictSelId Class Class | ClassOpId Class ClassOp | DefaultMethodId Class ClassOp Bool | DictFunId Class UniType Bool | ConstMethodId Class UniType ClassOp Bool | InstId Inst | SpecId Id [Labda UniType] Bool | WorkerId Id #-}
-type IdEnv a = UniqFM a
-data ArgUsage  {-# GHC_PRAGMA ArgUsage Int | UnknownArgUsage #-}
-data ArgUsageInfo      {-# GHC_PRAGMA NoArgUsageInfo | SomeArgUsageInfo [ArgUsage] #-}
-data ArityInfo         {-# GHC_PRAGMA UnknownArity | ArityExactly Int #-}
-data DeforestInfo      {-# GHC_PRAGMA Don'tDeforest | DoDeforest #-}
-data Demand    {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-}
-data DemandInfo        {-# GHC_PRAGMA UnknownDemand | DemandedAsPer Demand #-}
-data FBConsum  {-# GHC_PRAGMA FBGoodConsum | FBBadConsum #-}
-data FBProd    {-# GHC_PRAGMA FBGoodProd | FBBadProd #-}
-data FBType    {-# GHC_PRAGMA FBType [FBConsum] FBProd #-}
-data FBTypeInfo        {-# GHC_PRAGMA NoFBTypeInfo | SomeFBTypeInfo FBType #-}
-data IdInfo    {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-}
-data SpecEnv   {-# GHC_PRAGMA SpecEnv [SpecInfo] #-}
-data SpecInfo  {-# GHC_PRAGMA SpecInfo [Labda UniType] Int Id #-}
-data StrictnessInfo    {-# GHC_PRAGMA NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id) #-}
-data UpdateInfo        {-# GHC_PRAGMA NoUpdateInfo | SomeUpdateInfo [Int] #-}
-data Inst      {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-}
-data InstOrigin        {-# GHC_PRAGMA OccurrenceOf Id SrcLoc | InstanceDeclOrigin SrcLoc | LiteralOrigin Literal SrcLoc | ArithSeqOrigin (ArithSeqInfo Name (InPat Name)) SrcLoc | SignatureOrigin | ClassDeclOrigin SrcLoc | DerivingOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class Bool TyCon SrcLoc | InstanceSpecOrigin (Class -> ([(UniType, InstTemplate)], ClassOp -> SpecEnv)) Class UniType SrcLoc | DefaultDeclOrigin SrcLoc | ValSpecOrigin Name SrcLoc | CCallOrigin SrcLoc [Char] (Labda (Expr Name (InPat Name))) | LitLitOrigin SrcLoc [Char] | UnknownOrigin #-}
-data OverloadedLit     {-# GHC_PRAGMA OverloadedIntegral Integer Id Id | OverloadedFractional (Ratio Integer) Id #-}
-data InstTemplate      {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-}
-data InstTy    {-# GHC_PRAGMA DictTy Class UniType | MethodTy Id [UniType] #-}
-data MagicUnfoldingFun         {-# GHC_PRAGMA MUF (SimplEnv -> [CoreArg Id] -> SplitUniqSupply -> SimplCount -> (Labda (CoreExpr Id Id), SimplCount)) #-}
+import Pretty(Delay, Pretty(..), PrettyRep)
 data Labda a   = Hamna | Ni a
 data Labda a   = Hamna | Ni a
-data Name      {-# GHC_PRAGMA Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString #-}
-data FullName  {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-}
-data Provenance        {-# GHC_PRAGMA ThisModule | InventedInThisModule | ExportedByPreludeCore | OtherPrelude _PackedString | OtherModule _PackedString [_PackedString] | HereInPreludeCore | OtherInstance _PackedString [_PackedString] #-}
-data ShortName         {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-}
-data OrdList a         {-# GHC_PRAGMA SeqList (OrdList a) (OrdList a) | ParList (OrdList a) (OrdList a) | OrdObj a | NoObj #-}
-data ExportFlag        {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-}
-data Delay a   {-# GHC_PRAGMA MkDelay a #-}
-data PprStyle  {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-}
 type Pretty = Int -> Bool -> PrettyRep
 type Pretty = Int -> Bool -> PrettyRep
-data PrettyRep         {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-}
-data PrimKind  {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-       {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
-data SMRep     {-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
-data SMSpecRepKind     {-# GHC_PRAGMA SpecRep | ConstantRep | CharLikeRep | IntLikeRep #-}
-data SMUpdateKind      {-# GHC_PRAGMA SMNormalForm | SMSingleEntry | SMUpdatable #-}
-data EnclosingCcDetails        {-# GHC_PRAGMA NoEnclosingCcDetails | EnclosingCC CostCentre #-}
-data FormSummary       {-# GHC_PRAGMA WhnfForm | BottomForm | OtherForm #-}
-data IdVal     {-# GHC_PRAGMA InlineIt (UniqFM IdVal) (UniqFM UniType) (CoreExpr (Id, BinderInfo) Id) | ItsAnAtom (CoreAtom Id) #-}
-data SimplEnv  {-# GHC_PRAGMA SimplEnv (SimplifierSwitch -> SwitchResult) EnclosingCcDetails (UniqFM UniType) (UniqFM IdVal) UnfoldEnv #-}
-data UnfoldConApp      {-# GHC_PRAGMA UCA Id [UniType] [CoreAtom Id] #-}
-data UnfoldEnv         {-# GHC_PRAGMA UFE (UniqFM UnfoldItem) (UniqFM Id) (FiniteMap UnfoldConApp Id) #-}
-data UnfoldItem        {-# GHC_PRAGMA UnfoldItem Id UnfoldingDetails EnclosingCcDetails #-}
-data UnfoldingDetails  {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-}
-data UnfoldingGuidance         {-# GHC_PRAGMA UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int #-}
-data SimplCount        {-# GHC_PRAGMA SimplCount Int# [(TickType, Int)] #-}
-data TickType  {-# GHC_PRAGMA UnfoldingDone | FoldrBuild | MagicUnfold | ConReused | CaseFloatFromLet | CaseOfCase | LetFloatFromLet | LetFloatFromCase | KnownBranch | Let2Case | CaseMerge | CaseElim | CaseIdentity | AtomicRhs | EtaExpansion | CaseOfError | FoldrConsNil | Foldr_Nil | FoldrFoldr | Foldr_List | FoldrCons | FoldrInline | TyBetaReduction | BetaReduction #-}
-data SplitUniqSupply   {-# GHC_PRAGMA MkSplitUniqSupply Int SplitUniqSupply SplitUniqSupply #-}
-data SrcLoc    {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-}
-data StgAtom a         {-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data StgBinderInfo     {-# GHC_PRAGMA NoStgBinderInfo | StgBinderInfo Bool Bool Bool Bool Bool #-}
-data StgBinding a b    {-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
-data StgCaseAlternatives a b   {-# GHC_PRAGMA StgAlgAlts UniType [(Id, [a], [Bool], StgExpr a b)] (StgCaseDefault a b) | StgPrimAlts UniType [(BasicLit, StgExpr a b)] (StgCaseDefault a b) #-}
-data StgCaseDefault a b        {-# GHC_PRAGMA StgNoDefault | StgBindDefault a Bool (StgExpr a b) #-}
-data StgExpr a b       {-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
-data StgRhs a b        {-# GHC_PRAGMA StgRhsClosure CostCentre StgBinderInfo [b] UpdateFlag [a] (StgExpr a b) | StgRhsCon CostCentre Id [StgAtom b] #-}
-data UpdateFlag        {-# GHC_PRAGMA ReEntrant | Updatable | SingleEntry #-}
-data TyCon     {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data TyVar     {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-}
-data TyVarTemplate     {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-}
-type TyVarEnv a = UniqFM a
-data UniType   {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-}
-data UniqFM a  {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
-data Unique    {-# GHC_PRAGMA MkUnique Int# #-}
-data UniqueSupply      {-# GHC_PRAGMA MkUniqueSupply Int# | MkNewSupply SplitUniqSupply #-}
+data PrettyRep 
+assertPanic :: [Char] -> Int -> a
 assoc :: Eq a => [Char] -> [(a, b)] -> a -> b
 assoc :: Eq a => [Char] -> [(a, b)] -> a -> b
-       {-# GHC_PRAGMA _A_ 4 _U_ 1212 _N_ _S_ "LLSL" _N_ _SPECIALISE_ [ [Char], _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ UniType, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ _PackedString, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ TyVarTemplate, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ TyVar, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ TyCon, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ PrimKind, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ Name, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ Class, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ }, [ Id, _N_ ] 1 { _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ } #-}
-emptyBag :: Bag a
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ Bag EmptyBag [u0] [] _N_ #-}
-snocBag :: Bag a -> a -> Bag a
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
-kindOfBasicLit :: BasicLit -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-typeOfBasicLit :: BasicLit -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-cAppend :: CSeq -> CSeq -> CSeq
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: CSeq) (u1 :: CSeq) -> _!_ _ORIG_ CharSeq CAppend [] [u0, u1] _N_ #-}
-cCh :: Char -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Char) -> _!_ _ORIG_ CharSeq CCh [] [u0] _N_ #-}
-cNil :: CSeq
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ CharSeq CNil [] [] _N_ #-}
-cPStr :: _PackedString -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: _PackedString) -> _!_ _ORIG_ CharSeq CPStr [] [u0] _N_ #-}
-cShow :: CSeq -> [Char]
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
-cStr :: [Char] -> CSeq
-       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [Char]) -> _!_ _ORIG_ CharSeq CStr [] [u0] _N_ #-}
-emptyFM :: FiniteMap a b
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 2 0 X 1 _/\_ u0 u1 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, u1] [] _N_ #-}
-cmpId :: Id -> Id -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-eqId :: Id -> Id -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
-getIdKind :: Id -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 9 \ (u0 :: UniType) -> case u0 of { _ALG_ (u1 :: UniType) -> _APP_  _ORIG_ UniTyFuns kindFromType [ u1 ] } _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Id) -> let {(u5 :: UniType) = case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ }} in _APP_  _ORIG_ UniTyFuns kindFromType [ u5 ] _N_ #-}
-getIdUniType :: Id -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_ #-}
-cmpName :: Name -> Name -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-eqName :: Name -> Name -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_  _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-}
-cmpByLocalName :: ProtoName -> ProtoName -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 cmpPString :: _PackedString -> _PackedString -> Int#
 cmpPString :: _PackedString -> _PackedString -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpProtoName :: ProtoName -> ProtoName -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-eqByLocalName :: ProtoName -> ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-eqProtoName :: ProtoName -> ProtoName -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
-cmpUnique :: Unique -> Unique -> Int#
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _ALWAYS_ \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> 0#; False  -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> -1#; False  -> 1#; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
-eqUnique :: Unique -> Unique -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _ALWAYS_ \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 equivClasses :: (a -> a -> Int#) -> [a] -> [[a]]
 equivClasses :: (a -> a -> Int#) -> [a] -> [[a]]
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 hasNoDups :: Eq a => [a] -> Bool
 hasNoDups :: Eq a => [a] -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _N_ _N_ _SPECIALISE_ [ TyVar ] 1 { _A_ 1 _U_ 1 _N_ _N_ _N_ _N_ } #-}
 isIn :: Eq a => [Char] -> a -> [a] -> Bool
 isIn :: Eq a => [Char] -> a -> [a] -> Bool
-       {-# GHC_PRAGMA _A_ 4 _U_ 1021 _N_ _S_ "LALS" {_A_ 3 _U_ 121 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ _PackedString ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyVarTemplate ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyVar ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyCon ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Name ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Class ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Id ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ BasicLit ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ MagicId ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Unique ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 isSingleton :: [a] -> Bool
 isSingleton :: [a] -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isn'tIn :: Eq a => [Char] -> a -> [a] -> Bool
 isn'tIn :: Eq a => [Char] -> a -> [a] -> Bool
-       {-# GHC_PRAGMA _A_ 4 _U_ 1021 _N_ _S_ "LALS" {_A_ 3 _U_ 121 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyVarTemplate ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyVar ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ TyCon ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ Id ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ MagicId ] 1 { _A_ 3 _U_ 021 _N_ _S_ "ALS" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ }, [ (Id, Id) ] 1 { _A_ 0 _U_ 021 _N_ _N_ _N_ _N_ } #-}
-kindFromType :: UniType -> PrimKind
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 lengthExceeds :: [a] -> Int -> Bool
 lengthExceeds :: [a] -> Int -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SU(P)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mapAccumB :: (b -> c -> a -> (b, c, d)) -> b -> c -> [a] -> (b, c, [d])
 mapAccumB :: (b -> c -> a -> (b, c, d)) -> b -> c -> [a] -> (b, c, [d])
-       {-# GHC_PRAGMA _A_ 4 _U_ 2221 _N_ _S_ "LLLS" _N_ _N_ #-}
 mapAccumL :: (b -> a -> (b, c)) -> b -> [a] -> (b, [c])
 mapAccumL :: (b -> a -> (b, c)) -> b -> [a] -> (b, [c])
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 mapAccumR :: (b -> a -> (b, c)) -> b -> [a] -> (b, [c])
 mapAccumR :: (b -> a -> (b, c)) -> b -> [a] -> (b, [c])
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
-mkUnknownSrcLoc :: SrcLoc
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 nOfThem :: Int -> a -> [a]
 nOfThem :: Int -> a -> [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 naturalMergeSortLe :: (a -> a -> Bool) -> [a] -> [a]
 naturalMergeSortLe :: (a -> a -> Bool) -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
-nullSpecEnv :: SpecEnv
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 panic :: [Char] -> a
 panic :: [Char] -> a
-       {-# GHC_PRAGMA _A_ 0 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
-pprCoreBinding :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreBinding a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222122 _N_ _S_ "LLLLS" _N_ _N_ #-}
-pprCoreExpr :: PprStyle -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> a -> Int -> Bool -> PrettyRep) -> (PprStyle -> b -> Int -> Bool -> PrettyRep) -> CoreExpr a b -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _S_ "LLLLS" _N_ _N_ #-}
-ppDouble :: Double -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 110 _N_ _N_ _N_ _N_ #-}
-ppInt :: Int -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 110 _N_ _S_ "LLA" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-ppInteger :: Integer -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 110 _N_ _N_ _N_ _N_ #-}
-ppNil :: Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 10 _N_ _S_ "LA" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
-ppRational :: Ratio Integer -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 1 _U_ 110 _N_ _N_ _N_ _N_ #-}
-ppStr :: [Char] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 210 _N_ _S_ "LLA" {_A_ 2 _U_ 21 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 pprPanic :: [Char] -> (Int -> Bool -> PrettyRep) -> a
 pprPanic :: [Char] -> (Int -> Bool -> PrettyRep) -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ _!_ _N_ _N_ #-}
-pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 pprTrace :: [Char] -> (Int -> Bool -> PrettyRep) -> a -> a
 pprTrace :: [Char] -> (Int -> Bool -> PrettyRep) -> a -> a
-       {-# GHC_PRAGMA _A_ 2 _U_ 112 _N_ _N_ _N_ _N_ #-}
-switchIsOn :: (a -> SwitchResult) -> a -> Bool
-       {-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-}
-typeOfPat :: TypecheckedPat -> UniType
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-tagOf_PrimOp :: PrimOp -> Int#
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-pprTyCon :: PprStyle -> TyCon -> [[Labda UniType]] -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _S_ "SSL" _N_ _N_ #-}
-pprUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep
-       {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-}
 removeDups :: (a -> a -> Int#) -> [a] -> ([a], [[a]])
 removeDups :: (a -> a -> Int#) -> [a] -> ([a], [[a]])
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
 runs :: (a -> a -> Bool) -> [a] -> [[a]]
 runs :: (a -> a -> Bool) -> [a] -> [[a]]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
-showUnique :: Unique -> _PackedString
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 sortLt :: (a -> a -> Bool) -> [a] -> [a]
 sortLt :: (a -> a -> Bool) -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 transitiveClosure :: (a -> [a]) -> (a -> a -> Bool) -> [a] -> [a]
 transitiveClosure :: (a -> [a]) -> (a -> a -> Bool) -> [a] -> [a]
-       {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 zipEqual :: [a] -> [b] -> [(a, b)]
 zipEqual :: [a] -> [b] -> [(a, b)]
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-}
 
 
index 7f0d406..816cb24 100644 (file)
@@ -797,14 +797,15 @@ From: Carsten Kehler Holst <kehler@cs.chalmers.se>
 To: partain@dcs.gla.ac.uk
 Subject: natural merge sort beats quick sort [ and it is prettier ]
 
 To: partain@dcs.gla.ac.uk
 Subject: natural merge sort beats quick sort [ and it is prettier ]
 
-   Here a piece of Haskell code that I'm rather fond of. See it as an
-attempt to get rid of the ridiculous quick-sort rutine. group is quite
-useful by itself I think it was John's idea originally though I
+Here a piece of Haskell code that I'm rather fond of. See it as an
+attempt to get rid of the ridiculous quick-sort routine. group is
+quite useful by itself I think it was John's idea originally though I
 believe the lazy version is due to me [surprisingly complicated].
 believe the lazy version is due to me [surprisingly complicated].
-gamma [used to be called] called gamma because I got inspired by the Gamma calculus. It
-is not very close to the calculus but does behave less sequential that
-both foldr and foldl. One could imagine a version of gamma that took a
-unit element as well thereby avoiding the problem with empty lists.
+gamma [used to be called] is called gamma because I got inspired by
+the Gamma calculus. It is not very close to the calculus but does
+behave less sequential that both foldr and foldl. One could imagine a
+version of gamma that took a unit element as well thereby avoiding the
+problem with empty lists.
 
 I've tried this code against
 
 
 I've tried this code against
 
@@ -817,7 +818,7 @@ If the list is partially sorted both merge sort and in particular
 natural merge sort wins. If the list is random [ average length of
 rising subsequences = approx 2 ] mergesort still wins and natural
 merge sort is marginally beeten by lennart's soqs. The space
 natural merge sort wins. If the list is random [ average length of
 rising subsequences = approx 2 ] mergesort still wins and natural
 merge sort is marginally beeten by lennart's soqs. The space
-consumption of merge sort is a bit worse than Lennarts quick sort
+consumption of merge sort is a bit worse than Lennart's quick sort
 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
 fpca article ] isn't used because of group.
 
 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
 fpca article ] isn't used because of group.
 
@@ -827,6 +828,7 @@ Carsten
 
 \begin{code}
 group :: (a -> a -> Bool) -> [a] -> [[a]]
 
 \begin{code}
 group :: (a -> a -> Bool) -> [a] -> [[a]]
+
 group p [] = [[]]
 group p (x:xs) = 
    let ((h1:t1):tt1) = group p xs
 group p [] = [[]]
 group p (x:xs) = 
    let ((h1:t1):tt1) = group p xs
@@ -838,8 +840,8 @@ group p (x:xs) =
 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 generalMerge p xs [] = xs
 generalMerge p [] ys = ys
 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 generalMerge p xs [] = xs
 generalMerge p [] ys = ys
-generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
-                             | y `p` x = y : generalMerge p (x:xs) ys
+generalMerge p (x:xs) (y:ys) | x `p` y   = x : generalMerge p xs (y:ys)
+                             | otherwise = y : generalMerge p (x:xs) ys
 
 -- gamma is now called balancedFold
 
 
 -- gamma is now called balancedFold
 
@@ -852,8 +854,11 @@ balancedFold' :: (a -> a -> a) -> [a] -> [a]
 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
 balancedFold' f xs = xs
 
 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
 balancedFold' f xs = xs
 
-generalMergeSort p = balancedFold (generalMerge p) . map (:[])
-generalNaturalMergeSort p = balancedFold (generalMerge p) . group p
+generalMergeSort p [] = []
+generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
+
+generalNaturalMergeSort p [] = []
+generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
 
 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
 
 
 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
 
index 4652a7c..eeb0e97 100644 (file)
@@ -5,5 +5,4 @@ import ProtoName(ProtoName)
 import U_list(U_list)
 data U_atype   = U_atc ProtoName U_list Int
 rdU_atype :: _Addr -> _PackedString -> _State _RealWorld -> (U_atype, _State _RealWorld)
 import U_list(U_list)
 data U_atype   = U_atc ProtoName U_list Int
 rdU_atype :: _Addr -> _PackedString -> _State _RealWorld -> (U_atype, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 890ee5a..d6a71c3 100644 (file)
@@ -5,7 +5,6 @@ import ProtoName(ProtoName)
 import U_hpragma(U_hpragma)
 import U_list(U_list)
 import U_ttype(U_ttype)
 import U_hpragma(U_hpragma)
 import U_list(U_list)
 import U_ttype(U_ttype)
-data U_binding   = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_lbind U_binding U_binding | U_ebind U_list U_binding Int | U_hbind U_list U_binding Int | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int
+data U_binding   = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int
 rdU_binding :: _Addr -> _PackedString -> _State _RealWorld -> (U_binding, _State _RealWorld)
 rdU_binding :: _Addr -> _PackedString -> _State _RealWorld -> (U_binding, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index f8cb66f..80f4eee 100644 (file)
@@ -8,5 +8,4 @@ import U_ttype(U_ttype)
 data U_coresyn
   = U_cobinder ProtoName U_ttype | U_colit U_literal | U_colocal U_coresyn | U_cononrec U_coresyn U_coresyn | U_corec U_list | U_corec_pair U_coresyn U_coresyn | U_covar U_coresyn | U_coliteral U_literal | U_cocon U_coresyn U_list U_list | U_coprim U_coresyn U_list U_list | U_colam U_list U_coresyn | U_cotylam U_list U_coresyn | U_coapp U_coresyn U_list | U_cotyapp U_coresyn U_ttype | U_cocase U_coresyn U_coresyn | U_colet U_coresyn U_coresyn | U_coscc U_coresyn U_coresyn | U_coalg_alts U_list U_coresyn | U_coalg_alt U_coresyn U_list U_coresyn | U_coprim_alts U_list U_coresyn | U_coprim_alt U_literal U_coresyn | U_conodeflt | U_cobinddeflt U_coresyn U_coresyn | U_co_primop _PackedString | U_co_ccall _PackedString Int U_list U_ttype | U_co_casm U_literal Int U_list U_ttype | U_co_preludedictscc U_coresyn | U_co_alldictscc _PackedString _PackedString U_coresyn | U_co_usercc _PackedString _PackedString _PackedString U_coresyn U_coresyn | U_co_autocc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_dictcc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_scc_noncaf | U_co_scc_caf | U_co_scc_nondupd | U_co_scc_dupd | U_co_id _PackedString | U_co_orig_id _PackedString _PackedString | U_co_sdselid ProtoName ProtoName | U_co_classopid ProtoName ProtoName | U_co_defmid ProtoName ProtoName | U_co_dfunid ProtoName U_ttype | U_co_constmid ProtoName ProtoName U_ttype | U_co_specid U_coresyn U_list | U_co_wrkrid U_coresyn
 rdU_coresyn :: _Addr -> _PackedString -> _State _RealWorld -> (U_coresyn, _State _RealWorld)
 data U_coresyn
   = U_cobinder ProtoName U_ttype | U_colit U_literal | U_colocal U_coresyn | U_cononrec U_coresyn U_coresyn | U_corec U_list | U_corec_pair U_coresyn U_coresyn | U_covar U_coresyn | U_coliteral U_literal | U_cocon U_coresyn U_list U_list | U_coprim U_coresyn U_list U_list | U_colam U_list U_coresyn | U_cotylam U_list U_coresyn | U_coapp U_coresyn U_list | U_cotyapp U_coresyn U_ttype | U_cocase U_coresyn U_coresyn | U_colet U_coresyn U_coresyn | U_coscc U_coresyn U_coresyn | U_coalg_alts U_list U_coresyn | U_coalg_alt U_coresyn U_list U_coresyn | U_coprim_alts U_list U_coresyn | U_coprim_alt U_literal U_coresyn | U_conodeflt | U_cobinddeflt U_coresyn U_coresyn | U_co_primop _PackedString | U_co_ccall _PackedString Int U_list U_ttype | U_co_casm U_literal Int U_list U_ttype | U_co_preludedictscc U_coresyn | U_co_alldictscc _PackedString _PackedString U_coresyn | U_co_usercc _PackedString _PackedString _PackedString U_coresyn U_coresyn | U_co_autocc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_dictcc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_scc_noncaf | U_co_scc_caf | U_co_scc_nondupd | U_co_scc_dupd | U_co_id _PackedString | U_co_orig_id _PackedString _PackedString | U_co_sdselid ProtoName ProtoName | U_co_classopid ProtoName ProtoName | U_co_defmid ProtoName ProtoName | U_co_dfunid ProtoName U_ttype | U_co_constmid ProtoName ProtoName U_ttype | U_co_specid U_coresyn U_list | U_co_wrkrid U_coresyn
 rdU_coresyn :: _Addr -> _PackedString -> _State _RealWorld -> (U_coresyn, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index b0b3f9e..b7f7806 100644 (file)
@@ -4,5 +4,4 @@ import PreludePS(_PackedString)
 import U_list(U_list)
 data U_entidt   = U_entid _PackedString | U_enttype _PackedString | U_enttypeall _PackedString | U_enttypecons _PackedString U_list | U_entclass _PackedString U_list | U_entmod _PackedString
 rdU_entidt :: _Addr -> _PackedString -> _State _RealWorld -> (U_entidt, _State _RealWorld)
 import U_list(U_list)
 data U_entidt   = U_entid _PackedString | U_enttype _PackedString | U_enttypeall _PackedString | U_enttypecons _PackedString U_list | U_entclass _PackedString U_list | U_entmod _PackedString
 rdU_entidt :: _Addr -> _PackedString -> _State _RealWorld -> (U_entidt, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 3f76893..7082efb 100644 (file)
@@ -1,7 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface U_finfot where
 import PreludePS(_PackedString)
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface U_finfot where
 import PreludePS(_PackedString)
-data U_finfot   = U_nofinfo | U_finfo _PackedString _PackedString
+data U_finfot   = U_finfo _PackedString _PackedString
 rdU_finfot :: _Addr -> _PackedString -> _State _RealWorld -> (U_finfot, _State _RealWorld)
 rdU_finfot :: _Addr -> _PackedString -> _State _RealWorld -> (U_finfot, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 273b68e..7c04df6 100644 (file)
@@ -6,5 +6,4 @@ import U_coresyn(U_coresyn)
 import U_list(U_list)
 data U_hpragma   = U_no_pragma | U_idata_pragma U_list U_list | U_itype_pragma | U_iclas_pragma U_list | U_iclasop_pragma U_hpragma U_hpragma | U_iinst_simpl_pragma _PackedString U_hpragma | U_iinst_const_pragma _PackedString U_hpragma U_list | U_iinst_spec_pragma _PackedString U_hpragma U_list | U_igen_pragma U_hpragma U_hpragma U_hpragma U_hpragma U_hpragma U_list | U_iarity_pragma Int | U_iupdate_pragma _PackedString | U_ideforest_pragma | U_istrictness_pragma _PackedString U_hpragma | U_imagic_unfolding_pragma _PackedString | U_iunfolding_pragma U_hpragma U_coresyn | U_iunfold_always | U_iunfold_if_args Int Int _PackedString Int | U_iname_pragma_pr ProtoName U_hpragma | U_itype_pragma_pr U_list Int U_hpragma | U_iinst_pragma_3s U_list Int U_hpragma U_list | U_idata_pragma_4s U_list
 rdU_hpragma :: _Addr -> _PackedString -> _State _RealWorld -> (U_hpragma, _State _RealWorld)
 import U_list(U_list)
 data U_hpragma   = U_no_pragma | U_idata_pragma U_list U_list | U_itype_pragma | U_iclas_pragma U_list | U_iclasop_pragma U_hpragma U_hpragma | U_iinst_simpl_pragma _PackedString U_hpragma | U_iinst_const_pragma _PackedString U_hpragma U_list | U_iinst_spec_pragma _PackedString U_hpragma U_list | U_igen_pragma U_hpragma U_hpragma U_hpragma U_hpragma U_hpragma U_list | U_iarity_pragma Int | U_iupdate_pragma _PackedString | U_ideforest_pragma | U_istrictness_pragma _PackedString U_hpragma | U_imagic_unfolding_pragma _PackedString | U_iunfolding_pragma U_hpragma U_coresyn | U_iunfold_always | U_iunfold_if_args Int Int _PackedString Int | U_iname_pragma_pr ProtoName U_hpragma | U_itype_pragma_pr U_list Int U_hpragma | U_iinst_pragma_3s U_list Int U_hpragma U_list | U_idata_pragma_4s U_list
 rdU_hpragma :: _Addr -> _PackedString -> _State _RealWorld -> (U_hpragma, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 7888acb..a04ed6c 100644 (file)
@@ -3,5 +3,4 @@ interface U_list where
 import PreludePS(_PackedString)
 data U_list   = U_lcons _Addr U_list | U_lnil
 rdU_list :: _Addr -> _PackedString -> _State _RealWorld -> (U_list, _State _RealWorld)
 import PreludePS(_PackedString)
 data U_list   = U_lcons _Addr U_list | U_lnil
 rdU_list :: _Addr -> _PackedString -> _State _RealWorld -> (U_list, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 8137154..a85bf0f 100644 (file)
@@ -3,5 +3,4 @@ interface U_literal where
 import PreludePS(_PackedString)
 data U_literal   = U_integer _PackedString | U_intprim _PackedString | U_floatr _PackedString | U_doubleprim _PackedString | U_floatprim _PackedString | U_charr _PackedString | U_charprim _PackedString | U_string _PackedString | U_stringprim _PackedString | U_clitlit _PackedString _PackedString | U_norepi _PackedString | U_norepr _PackedString _PackedString | U_noreps _PackedString
 rdU_literal :: _Addr -> _PackedString -> _State _RealWorld -> (U_literal, _State _RealWorld)
 import PreludePS(_PackedString)
 data U_literal   = U_integer _PackedString | U_intprim _PackedString | U_floatr _PackedString | U_doubleprim _PackedString | U_floatprim _PackedString | U_charr _PackedString | U_charprim _PackedString | U_string _PackedString | U_stringprim _PackedString | U_clitlit _PackedString _PackedString | U_norepi _PackedString | U_norepr _PackedString _PackedString | U_noreps _PackedString
 rdU_literal :: _Addr -> _PackedString -> _State _RealWorld -> (U_literal, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 65171f2..7c9cb13 100644 (file)
@@ -6,5 +6,4 @@ import U_list(U_list)
 import U_treeHACK(U_tree)
 data U_pbinding   = U_pgrhs U_tree U_list U_binding _PackedString Int
 rdU_pbinding :: _Addr -> _PackedString -> _State _RealWorld -> (U_pbinding, _State _RealWorld)
 import U_treeHACK(U_tree)
 data U_pbinding   = U_pgrhs U_tree U_list U_binding _PackedString Int
 rdU_pbinding :: _Addr -> _PackedString -> _State _RealWorld -> (U_pbinding, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 940d424..19aafd6 100644 (file)
@@ -9,7 +9,5 @@ import U_ttype(U_ttype)
 type U_infixTree = (ProtoName, U_tree, U_tree)
 data U_tree   = U_hmodule _PackedString U_list U_list U_binding Int | U_ident ProtoName | U_lit U_literal | U_tuple U_list | U_ap U_tree U_tree | U_lambda U_list U_tree Int | U_let U_binding U_tree | U_casee U_tree U_list | U_ife U_tree U_tree U_tree | U_par U_tree | U_as ProtoName U_tree | U_lazyp U_tree | U_plusp U_tree U_literal | U_wildp | U_restr U_tree U_ttype | U_comprh U_tree U_list | U_qual U_tree U_tree | U_guard U_tree | U_def U_tree | U_tinfixop (ProtoName, U_tree, U_tree) | U_lsection U_tree ProtoName | U_rsection ProtoName U_tree | U_eenum U_tree U_list U_list | U_llist U_list | U_ccall _PackedString _PackedString U_list | U_scc _PackedString U_tree | U_negate U_tree
 rdU_infixTree :: _Addr -> _PackedString -> _State _RealWorld -> ((ProtoName, U_tree, U_tree), _State _RealWorld)
 type U_infixTree = (ProtoName, U_tree, U_tree)
 data U_tree   = U_hmodule _PackedString U_list U_list U_binding Int | U_ident ProtoName | U_lit U_literal | U_tuple U_list | U_ap U_tree U_tree | U_lambda U_list U_tree Int | U_let U_binding U_tree | U_casee U_tree U_list | U_ife U_tree U_tree U_tree | U_par U_tree | U_as ProtoName U_tree | U_lazyp U_tree | U_plusp U_tree U_literal | U_wildp | U_restr U_tree U_ttype | U_comprh U_tree U_list | U_qual U_tree U_tree | U_guard U_tree | U_def U_tree | U_tinfixop (ProtoName, U_tree, U_tree) | U_lsection U_tree ProtoName | U_rsection ProtoName U_tree | U_eenum U_tree U_list U_list | U_llist U_list | U_ccall _PackedString _PackedString U_list | U_scc _PackedString U_tree | U_negate U_tree
 rdU_infixTree :: _Addr -> _PackedString -> _State _RealWorld -> ((ProtoName, U_tree, U_tree), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_tree :: _Addr -> _PackedString -> _State _RealWorld -> (U_tree, _State _RealWorld)
 rdU_tree :: _Addr -> _PackedString -> _State _RealWorld -> (U_tree, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 8dceb92..1f2db9a 100644 (file)
@@ -5,5 +5,4 @@ import ProtoName(ProtoName)
 import U_list(U_list)
 data U_ttype   = U_tname ProtoName U_list | U_namedtvar ProtoName | U_tllist U_ttype | U_ttuple U_list | U_tfun U_ttype U_ttype | U_context U_list U_ttype | U_unidict ProtoName U_ttype | U_unityvartemplate ProtoName | U_uniforall U_list U_ttype | U_ty_maybe_nothing | U_ty_maybe_just U_ttype
 rdU_ttype :: _Addr -> _PackedString -> _State _RealWorld -> (U_ttype, _State _RealWorld)
 import U_list(U_list)
 data U_ttype   = U_tname ProtoName U_list | U_namedtvar ProtoName | U_tllist U_ttype | U_ttuple U_list | U_tfun U_ttype U_ttype | U_context U_list U_ttype | U_unidict ProtoName U_ttype | U_unityvartemplate ProtoName | U_uniforall U_list U_ttype | U_ty_maybe_nothing | U_ty_maybe_just U_ttype
 rdU_ttype :: _Addr -> _PackedString -> _State _RealWorld -> (U_ttype, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 
index 85e484e..a4f5405 100644 (file)
@@ -2,7 +2,7 @@
 interface UgenAll where
 import PreludePS(_PackedString)
 import PreludePrimIO(returnPrimIO, thenPrimIO)
 interface UgenAll where
 import PreludePS(_PackedString)
 import PreludePrimIO(returnPrimIO, thenPrimIO)
-import ProtoName(ProtoName)
+import ProtoName(ProtoName(..))
 import SrcLoc(SrcLoc)
 import U_atype(U_atype(..), rdU_atype)
 import U_binding(U_binding(..), rdU_binding)
 import SrcLoc(SrcLoc)
 import U_atype(U_atype(..), rdU_atype)
 import U_binding(U_binding(..), rdU_binding)
@@ -17,12 +17,13 @@ import U_treeHACK(U_infixTree(..), U_tree(..), rdU_infixTree, rdU_tree)
 import U_ttype(U_ttype(..), rdU_ttype)
 import UgenUtil(ParseTree(..), U_VOID_STAR(..), U_hstring(..), U_long(..), U_numId(..), U_stringId(..), U_unkId(..), UgnM(..), getSrcFileUgn, initUgn, ioToUgnM, mkSrcLocUgn, rdU_VOID_STAR, rdU_hstring, rdU_long, rdU_numId, rdU_stringId, rdU_unkId, returnUgn, setSrcFileUgn, thenUgn)
 infixr 1 `thenPrimIO`
 import U_ttype(U_ttype(..), rdU_ttype)
 import UgenUtil(ParseTree(..), U_VOID_STAR(..), U_hstring(..), U_long(..), U_numId(..), U_stringId(..), U_unkId(..), UgnM(..), getSrcFileUgn, initUgn, ioToUgnM, mkSrcLocUgn, rdU_VOID_STAR, rdU_hstring, rdU_long, rdU_numId, rdU_stringId, rdU_unkId, returnUgn, setSrcFileUgn, thenUgn)
 infixr 1 `thenPrimIO`
+data ProtoName 
 data U_atype   = U_atc ProtoName U_list Int
 data U_atype   = U_atc ProtoName U_list Int
-data U_binding   = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_lbind U_binding U_binding | U_ebind U_list U_binding Int | U_hbind U_list U_binding Int | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int
+data U_binding   = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int
 data U_coresyn
   = U_cobinder ProtoName U_ttype | U_colit U_literal | U_colocal U_coresyn | U_cononrec U_coresyn U_coresyn | U_corec U_list | U_corec_pair U_coresyn U_coresyn | U_covar U_coresyn | U_coliteral U_literal | U_cocon U_coresyn U_list U_list | U_coprim U_coresyn U_list U_list | U_colam U_list U_coresyn | U_cotylam U_list U_coresyn | U_coapp U_coresyn U_list | U_cotyapp U_coresyn U_ttype | U_cocase U_coresyn U_coresyn | U_colet U_coresyn U_coresyn | U_coscc U_coresyn U_coresyn | U_coalg_alts U_list U_coresyn | U_coalg_alt U_coresyn U_list U_coresyn | U_coprim_alts U_list U_coresyn | U_coprim_alt U_literal U_coresyn | U_conodeflt | U_cobinddeflt U_coresyn U_coresyn | U_co_primop _PackedString | U_co_ccall _PackedString Int U_list U_ttype | U_co_casm U_literal Int U_list U_ttype | U_co_preludedictscc U_coresyn | U_co_alldictscc _PackedString _PackedString U_coresyn | U_co_usercc _PackedString _PackedString _PackedString U_coresyn U_coresyn | U_co_autocc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_dictcc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_scc_noncaf | U_co_scc_caf | U_co_scc_nondupd | U_co_scc_dupd | U_co_id _PackedString | U_co_orig_id _PackedString _PackedString | U_co_sdselid ProtoName ProtoName | U_co_classopid ProtoName ProtoName | U_co_defmid ProtoName ProtoName | U_co_dfunid ProtoName U_ttype | U_co_constmid ProtoName ProtoName U_ttype | U_co_specid U_coresyn U_list | U_co_wrkrid U_coresyn
 data U_entidt   = U_entid _PackedString | U_enttype _PackedString | U_enttypeall _PackedString | U_enttypecons _PackedString U_list | U_entclass _PackedString U_list | U_entmod _PackedString
 data U_coresyn
   = U_cobinder ProtoName U_ttype | U_colit U_literal | U_colocal U_coresyn | U_cononrec U_coresyn U_coresyn | U_corec U_list | U_corec_pair U_coresyn U_coresyn | U_covar U_coresyn | U_coliteral U_literal | U_cocon U_coresyn U_list U_list | U_coprim U_coresyn U_list U_list | U_colam U_list U_coresyn | U_cotylam U_list U_coresyn | U_coapp U_coresyn U_list | U_cotyapp U_coresyn U_ttype | U_cocase U_coresyn U_coresyn | U_colet U_coresyn U_coresyn | U_coscc U_coresyn U_coresyn | U_coalg_alts U_list U_coresyn | U_coalg_alt U_coresyn U_list U_coresyn | U_coprim_alts U_list U_coresyn | U_coprim_alt U_literal U_coresyn | U_conodeflt | U_cobinddeflt U_coresyn U_coresyn | U_co_primop _PackedString | U_co_ccall _PackedString Int U_list U_ttype | U_co_casm U_literal Int U_list U_ttype | U_co_preludedictscc U_coresyn | U_co_alldictscc _PackedString _PackedString U_coresyn | U_co_usercc _PackedString _PackedString _PackedString U_coresyn U_coresyn | U_co_autocc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_dictcc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_scc_noncaf | U_co_scc_caf | U_co_scc_nondupd | U_co_scc_dupd | U_co_id _PackedString | U_co_orig_id _PackedString _PackedString | U_co_sdselid ProtoName ProtoName | U_co_classopid ProtoName ProtoName | U_co_defmid ProtoName ProtoName | U_co_dfunid ProtoName U_ttype | U_co_constmid ProtoName ProtoName U_ttype | U_co_specid U_coresyn U_list | U_co_wrkrid U_coresyn
 data U_entidt   = U_entid _PackedString | U_enttype _PackedString | U_enttypeall _PackedString | U_enttypecons _PackedString U_list | U_entclass _PackedString U_list | U_entmod _PackedString
-data U_finfot   = U_nofinfo | U_finfo _PackedString _PackedString
+data U_finfot   = U_finfo _PackedString _PackedString
 data U_hpragma   = U_no_pragma | U_idata_pragma U_list U_list | U_itype_pragma | U_iclas_pragma U_list | U_iclasop_pragma U_hpragma U_hpragma | U_iinst_simpl_pragma _PackedString U_hpragma | U_iinst_const_pragma _PackedString U_hpragma U_list | U_iinst_spec_pragma _PackedString U_hpragma U_list | U_igen_pragma U_hpragma U_hpragma U_hpragma U_hpragma U_hpragma U_list | U_iarity_pragma Int | U_iupdate_pragma _PackedString | U_ideforest_pragma | U_istrictness_pragma _PackedString U_hpragma | U_imagic_unfolding_pragma _PackedString | U_iunfolding_pragma U_hpragma U_coresyn | U_iunfold_always | U_iunfold_if_args Int Int _PackedString Int | U_iname_pragma_pr ProtoName U_hpragma | U_itype_pragma_pr U_list Int U_hpragma | U_iinst_pragma_3s U_list Int U_hpragma U_list | U_idata_pragma_4s U_list
 data U_list   = U_lcons _Addr U_list | U_lnil
 data U_literal   = U_integer _PackedString | U_intprim _PackedString | U_floatr _PackedString | U_doubleprim _PackedString | U_floatprim _PackedString | U_charr _PackedString | U_charprim _PackedString | U_string _PackedString | U_stringprim _PackedString | U_clitlit _PackedString _PackedString | U_norepi _PackedString | U_norepr _PackedString _PackedString | U_noreps _PackedString
 data U_hpragma   = U_no_pragma | U_idata_pragma U_list U_list | U_itype_pragma | U_iclas_pragma U_list | U_iclasop_pragma U_hpragma U_hpragma | U_iinst_simpl_pragma _PackedString U_hpragma | U_iinst_const_pragma _PackedString U_hpragma U_list | U_iinst_spec_pragma _PackedString U_hpragma U_list | U_igen_pragma U_hpragma U_hpragma U_hpragma U_hpragma U_hpragma U_list | U_iarity_pragma Int | U_iupdate_pragma _PackedString | U_ideforest_pragma | U_istrictness_pragma _PackedString U_hpragma | U_imagic_unfolding_pragma _PackedString | U_iunfolding_pragma U_hpragma U_coresyn | U_iunfold_always | U_iunfold_if_args Int Int _PackedString Int | U_iname_pragma_pr ProtoName U_hpragma | U_itype_pragma_pr U_list Int U_hpragma | U_iinst_pragma_3s U_list Int U_hpragma U_list | U_idata_pragma_4s U_list
 data U_list   = U_lcons _Addr U_list | U_lnil
 data U_literal   = U_integer _PackedString | U_intprim _PackedString | U_floatr _PackedString | U_doubleprim _PackedString | U_floatprim _PackedString | U_charr _PackedString | U_charprim _PackedString | U_string _PackedString | U_stringprim _PackedString | U_clitlit _PackedString _PackedString | U_norepi _PackedString | U_norepr _PackedString _PackedString | U_noreps _PackedString
@@ -39,57 +40,30 @@ type U_stringId = _PackedString
 type U_unkId = ProtoName
 type UgnM a = _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
 type U_unkId = ProtoName
 type UgnM a = _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 thenPrimIO :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
 thenPrimIO :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: u0 -> _State _RealWorld -> (u1, _State _RealWorld)) (u4 :: _State _RealWorld) -> case _APP_  u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: u0) (u6 :: _State _RealWorld) -> _APP_  u3 [ u5, u6 ]; _NO_DEFLT_ } _N_ #-}
 rdU_atype :: _Addr -> _PackedString -> _State _RealWorld -> (U_atype, _State _RealWorld)
 rdU_atype :: _Addr -> _PackedString -> _State _RealWorld -> (U_atype, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_binding :: _Addr -> _PackedString -> _State _RealWorld -> (U_binding, _State _RealWorld)
 rdU_binding :: _Addr -> _PackedString -> _State _RealWorld -> (U_binding, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_coresyn :: _Addr -> _PackedString -> _State _RealWorld -> (U_coresyn, _State _RealWorld)
 rdU_coresyn :: _Addr -> _PackedString -> _State _RealWorld -> (U_coresyn, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_entidt :: _Addr -> _PackedString -> _State _RealWorld -> (U_entidt, _State _RealWorld)
 rdU_entidt :: _Addr -> _PackedString -> _State _RealWorld -> (U_entidt, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_finfot :: _Addr -> _PackedString -> _State _RealWorld -> (U_finfot, _State _RealWorld)
 rdU_finfot :: _Addr -> _PackedString -> _State _RealWorld -> (U_finfot, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_hpragma :: _Addr -> _PackedString -> _State _RealWorld -> (U_hpragma, _State _RealWorld)
 rdU_hpragma :: _Addr -> _PackedString -> _State _RealWorld -> (U_hpragma, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_list :: _Addr -> _PackedString -> _State _RealWorld -> (U_list, _State _RealWorld)
 rdU_list :: _Addr -> _PackedString -> _State _RealWorld -> (U_list, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_literal :: _Addr -> _PackedString -> _State _RealWorld -> (U_literal, _State _RealWorld)
 rdU_literal :: _Addr -> _PackedString -> _State _RealWorld -> (U_literal, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_pbinding :: _Addr -> _PackedString -> _State _RealWorld -> (U_pbinding, _State _RealWorld)
 rdU_pbinding :: _Addr -> _PackedString -> _State _RealWorld -> (U_pbinding, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_infixTree :: _Addr -> _PackedString -> _State _RealWorld -> ((ProtoName, U_tree, U_tree), _State _RealWorld)
 rdU_infixTree :: _Addr -> _PackedString -> _State _RealWorld -> ((ProtoName, U_tree, U_tree), _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_tree :: _Addr -> _PackedString -> _State _RealWorld -> (U_tree, _State _RealWorld)
 rdU_tree :: _Addr -> _PackedString -> _State _RealWorld -> (U_tree, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_ttype :: _Addr -> _PackedString -> _State _RealWorld -> (U_ttype, _State _RealWorld)
 rdU_ttype :: _Addr -> _PackedString -> _State _RealWorld -> (U_ttype, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSrcFileUgn :: _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
 getSrcFileUgn :: _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: _PackedString) (u1 :: _State _RealWorld) -> case u1 of { _ALG_ S# (u2 :: State# _RealWorld) -> _!_ _TUP_2 [_PackedString, (_State _RealWorld)] [u0, u1]; _NO_DEFLT_ } _N_ #-}
 initUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _State _RealWorld -> (a, _State _RealWorld)
 initUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_  u2 [ u1, u3 ] _N_ #-}
 ioToUgnM :: (_State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 ioToUgnM :: (_State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "SAL" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _State _RealWorld) -> _APP_  u1 [ u2 ] _N_} _F_ _IF_ARGS_ 1 3 XXX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _PackedString) (u3 :: _State _RealWorld) -> _APP_  u1 [ u3 ] _N_ #-}
 mkSrcLocUgn :: Int -> _PackedString -> _State _RealWorld -> (SrcLoc, _State _RealWorld)
 mkSrcLocUgn :: Int -> _PackedString -> _State _RealWorld -> (SrcLoc, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_VOID_STAR :: _Addr -> _PackedString -> _State _RealWorld -> (_Addr, _State _RealWorld)
 rdU_VOID_STAR :: _Addr -> _PackedString -> _State _RealWorld -> (_Addr, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: _Addr) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [_Addr, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-}
 rdU_hstring :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
 rdU_hstring :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 3 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_long :: Int -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
 rdU_long :: Int -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: Int) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [Int, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-}
 rdU_numId :: _Addr -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
 rdU_numId :: _Addr -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_stringId :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
 rdU_stringId :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_unkId :: _Addr -> _PackedString -> _State _RealWorld -> (ProtoName, _State _RealWorld)
 rdU_unkId :: _Addr -> _PackedString -> _State _RealWorld -> (ProtoName, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnUgn :: b -> a -> _State _RealWorld -> (b, _State _RealWorld)
 returnUgn :: b -> a -> _State _RealWorld -> (b, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _S_ "LLS" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: u1) (u3 :: u0) (u4 :: _State _RealWorld) -> case u4 of { _ALG_ S# (u5 :: State# _RealWorld) -> _!_ _TUP_2 [u1, (_State _RealWorld)] [u2, u4]; _NO_DEFLT_ } _N_ #-}
 setSrcFileUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 setSrcFileUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2102 _N_ _S_ "LSAL" {_A_ 3 _U_ 212 _N_ _N_ _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_  u2 [ u1, u3 ] _N_} _F_ _IF_ARGS_ 1 4 XXXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _PackedString) (u4 :: _State _RealWorld) -> _APP_  u2 [ u1, u4 ] _N_ #-}
 thenUgn :: (b -> _State _RealWorld -> (a, _State _RealWorld)) -> (a -> b -> _State _RealWorld -> (c, _State _RealWorld)) -> b -> _State _RealWorld -> (c, _State _RealWorld)
 thenUgn :: (b -> _State _RealWorld -> (a, _State _RealWorld)) -> (a -> b -> _State _RealWorld -> (c, _State _RealWorld)) -> b -> _State _RealWorld -> (c, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "SSLL" _F_ _ALWAYS_ _/\_ u0 u1 u2 -> \ (u3 :: u1 -> _State _RealWorld -> (u0, _State _RealWorld)) (u4 :: u0 -> u1 -> _State _RealWorld -> (u2, _State _RealWorld)) (u5 :: u1) (u6 :: _State _RealWorld) -> case _APP_  u3 [ u5, u6 ] of { _ALG_ _TUP_2 (u7 :: u0) (u8 :: _State _RealWorld) -> _APP_  u4 [ u7, u5, u8 ]; _NO_DEFLT_ } _N_ #-}
 
 
index d5735cf..2aa2ea1 100644 (file)
@@ -7,7 +7,7 @@ import ProtoName(ProtoName)
 import SrcLoc(SrcLoc)
 infixr 1 `thenPrimIO`
 type ParseTree = _Addr
 import SrcLoc(SrcLoc)
 infixr 1 `thenPrimIO`
 type ParseTree = _Addr
-data ProtoName         {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-}
+data ProtoName 
 type U_VOID_STAR = _Addr
 type U_hstring = _PackedString
 type U_long = Int
 type U_VOID_STAR = _Addr
 type U_hstring = _PackedString
 type U_long = Int
@@ -16,33 +16,18 @@ type U_stringId = _PackedString
 type U_unkId = ProtoName
 type UgnM a = _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 getSrcFileUgn :: _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
 type U_unkId = ProtoName
 type UgnM a = _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 getSrcFileUgn :: _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: _PackedString) (u1 :: _State _RealWorld) -> case u1 of { _ALG_ S# (u2 :: State# _RealWorld) -> _!_ _TUP_2 [_PackedString, (_State _RealWorld)] [u0, u1]; _NO_DEFLT_ } _N_ #-}
 initUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _State _RealWorld -> (a, _State _RealWorld)
 initUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_  u2 [ u1, u3 ] _N_ #-}
 ioToUgnM :: (_State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 ioToUgnM :: (_State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "SAL" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _State _RealWorld) -> _APP_  u1 [ u2 ] _N_} _F_ _IF_ARGS_ 1 3 XXX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _PackedString) (u3 :: _State _RealWorld) -> _APP_  u1 [ u3 ] _N_ #-}
 mkSrcLocUgn :: Int -> _PackedString -> _State _RealWorld -> (SrcLoc, _State _RealWorld)
 mkSrcLocUgn :: Int -> _PackedString -> _State _RealWorld -> (SrcLoc, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_VOID_STAR :: _Addr -> _PackedString -> _State _RealWorld -> (_Addr, _State _RealWorld)
 rdU_VOID_STAR :: _Addr -> _PackedString -> _State _RealWorld -> (_Addr, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: _Addr) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [_Addr, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-}
 rdU_hstring :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
 rdU_hstring :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 3 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_long :: Int -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
 rdU_long :: Int -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: Int) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [Int, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-}
 rdU_numId :: _Addr -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
 rdU_numId :: _Addr -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_stringId :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
 rdU_stringId :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rdU_unkId :: _Addr -> _PackedString -> _State _RealWorld -> (ProtoName, _State _RealWorld)
 rdU_unkId :: _Addr -> _PackedString -> _State _RealWorld -> (ProtoName, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnUgn :: b -> a -> _State _RealWorld -> (b, _State _RealWorld)
 returnUgn :: b -> a -> _State _RealWorld -> (b, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _S_ "LLS" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: u1) (u3 :: u0) (u4 :: _State _RealWorld) -> case u4 of { _ALG_ S# (u5 :: State# _RealWorld) -> _!_ _TUP_2 [u1, (_State _RealWorld)] [u2, u4]; _NO_DEFLT_ } _N_ #-}
 setSrcFileUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
 setSrcFileUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 2102 _N_ _S_ "LSAL" {_A_ 3 _U_ 212 _N_ _N_ _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_  u2 [ u1, u3 ] _N_} _F_ _IF_ARGS_ 1 4 XXXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _PackedString) (u4 :: _State _RealWorld) -> _APP_  u2 [ u1, u4 ] _N_ #-}
 thenPrimIO :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
 thenPrimIO :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: u0 -> _State _RealWorld -> (u1, _State _RealWorld)) (u4 :: _State _RealWorld) -> case _APP_  u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: u0) (u6 :: _State _RealWorld) -> _APP_  u3 [ u5, u6 ]; _NO_DEFLT_ } _N_ #-}
 thenUgn :: (b -> _State _RealWorld -> (a, _State _RealWorld)) -> (a -> b -> _State _RealWorld -> (c, _State _RealWorld)) -> b -> _State _RealWorld -> (c, _State _RealWorld)
 thenUgn :: (b -> _State _RealWorld -> (a, _State _RealWorld)) -> (a -> b -> _State _RealWorld -> (c, _State _RealWorld)) -> b -> _State _RealWorld -> (c, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "SSLL" _F_ _ALWAYS_ _/\_ u0 u1 u2 -> \ (u3 :: u1 -> _State _RealWorld -> (u0, _State _RealWorld)) (u4 :: u0 -> u1 -> _State _RealWorld -> (u2, _State _RealWorld)) (u5 :: u1) (u6 :: _State _RealWorld) -> case _APP_  u3 [ u5, u6 ] of { _ALG_ _TUP_2 (u7 :: u0) (u8 :: _State _RealWorld) -> _APP_  u4 [ u7, u5, u8 ]; _NO_DEFLT_ } _N_ #-}
 
 
index 6c7b19e..680a0b1 100644 (file)
@@ -29,14 +29,18 @@ type binding;
                    gfline      : long; >;
        abind   : < gabindfst   : binding;
                    gabindsnd   : binding; >;
                    gfline      : long; >;
        abind   : < gabindfst   : binding;
                    gabindsnd   : binding; >;
+/*OLD:95/08:
        lbind   : < glbindfst   : binding;
                    glbindsnd   : binding; >;
        lbind   : < glbindfst   : binding;
                    glbindsnd   : binding; >;
-       ebind   : < gebindl     : list;
+*/
+/*OLD:95/08:   ebind   : < gebindl     : list;
                    gebind      : binding;
                    geline      : long; >;
                    gebind      : binding;
                    geline      : long; >;
-       hbind   : < ghbindl     : list;
+*/
+/*OLD: 95/08:  hbind   : < ghbindl     : list;
                    ghbind      : binding;
                    ghline      : long; >;
                    ghbind      : binding;
                    ghline      : long; >;
+*/
        ibind   : < gibindc     : list;
                    gibindid    : unkId;
                    gibindi     : ttype;
        ibind   : < gibindc     : list;
                    gibindid    : unkId;
                    gibindi     : ttype;
@@ -65,6 +69,11 @@ type binding;
                    giebinddef  : binding;
                    giebindfile : stringId;
                    giebindline : long; >;
                    giebinddef  : binding;
                    giebindfile : stringId;
                    giebindline : long; >;
+/* "hiding" is used in a funny way:
+   it has to have the *exact* same structure as "import";
+   because what we do is: create an "import" then change
+   its tag to "hiding".  Yeeps. (WDP 95/08)
+*/
        hiding  : < gihbindmod  : stringId;
                    gihbindexp  : list;
                    gihbindren  : list;
        hiding  : < gihbindmod  : stringId;
                    gihbindexp  : list;
                    gihbindren  : list;
index 9cf60eb..1ac6899 100644 (file)
@@ -7,6 +7,6 @@ import UgenUtil
 import Util
 %}}
 type finfot;
 import Util
 %}}
 type finfot;
-       nofinfo : < >;
+/*OLD:95/08:   nofinfo : < >; */
        finfo   : < fi1: stringId; fi2: stringId; >;
 end;
        finfo   : < fi1: stringId; fi2: stringId; >;
 end;
index d19f628..2700839 100644 (file)
@@ -36,8 +36,9 @@ StackOverflowHook (stack_size)
 #if 0
 /* nothing to add here, really */
 void
 #if 0
 /* nothing to add here, really */
 void
-MallocFailHook (request_size)
+MallocFailHook (request_size, msg)
   I_ request_size;    /* in bytes */
   I_ request_size;    /* in bytes */
+  char *msg;
 {
     fprintf(stderr, "malloc: failed on request for %lu bytes\n", request_size);
 }
 {
     fprintf(stderr, "malloc: failed on request for %lu bytes\n", request_size);
 }
index 7d0ce0f..902f3bd 100644 (file)
@@ -64,7 +64,7 @@
 #define _isconstr(s)   (CharTable[*s]&(_C))
 BOOLEAN isconstr PROTO((char *)); /* fwd decl */
 
 #define _isconstr(s)   (CharTable[*s]&(_C))
 BOOLEAN isconstr PROTO((char *)); /* fwd decl */
 
-unsigned char CharTable[NCHARS] = {
+static unsigned char CharTable[NCHARS] = {
 /* nul */      0,      0,      0,      0,      0,      0,      0,      0,
 /* bs  */      0,      _S,     _S,     _S,     _S,     0,      0,      0,
 /* dle */      0,      0,      0,      0,      0,      0,      0,      0,
 /* nul */      0,      0,      0,      0,      0,      0,      0,      0,
 /* bs  */      0,      _S,     _S,     _S,     _S,     0,      0,      0,
 /* dle */      0,      0,      0,      0,      0,      0,      0,      0,
@@ -115,12 +115,12 @@ char *input_filename = NULL;      /* Always points to a dynamically allocated string
  * have been renamed as hsXXXXX rather than yyXXXXX.  --JSM
  */
 
  * have been renamed as hsXXXXX rather than yyXXXXX.  --JSM
  */
 
-int hslineno = 0;              /* Line number at end of token */
+static int hslineno = 0;       /* Line number at end of token */
 int hsplineno = 0;             /* Line number at end of previous token */
 
 int hsplineno = 0;             /* Line number at end of previous token */
 
-int hscolno = 0;               /* Column number at end of token */
+static int hscolno = 0;                /* Column number at end of token */
 int hspcolno = 0;              /* Column number at end of previous token */
 int hspcolno = 0;              /* Column number at end of previous token */
-int hsmlcolno = 0;             /* Column number for multiple-rule lexemes */
+static int hsmlcolno = 0;      /* Column number for multiple-rule lexemes */
 
 int startlineno = 0;           /* The line number where something starts */
 int endlineno = 0;             /* The line number where something ends */
 
 int startlineno = 0;           /* The line number where something starts */
 int endlineno = 0;             /* The line number where something ends */
@@ -142,12 +142,15 @@ static int nested_comments;       /* For counting comment nesting depth */
 
 /* Essential forward declarations */
 
 
 /* Essential forward declarations */
 
-static VOID hsnewid     PROTO((char *, int));
-static VOID layout_input PROTO((char *, int));
-static VOID cleartext   (NO_ARGS);
-static VOID addtext     PROTO((char *, unsigned));
-static VOID addchar     PROTO((char));
+static void hsnewid     PROTO((char *, int));
+static void layout_input PROTO((char *, int));
+static void cleartext   (NO_ARGS);
+static void addtext     PROTO((char *, unsigned));
+static void addchar     PROTO((char));
 static char *fetchtext  PROTO((unsigned *));
 static char *fetchtext  PROTO((unsigned *));
+static void new_filename PROTO((char *));
+static int  Return      PROTO((int));
+static void hsentercontext PROTO((int));
 
 /* Special file handling for IMPORTS */
 /*  Note: imports only ever go *one deep* (hence no need for a stack) WDP 94/09 */
 
 /* Special file handling for IMPORTS */
 /*  Note: imports only ever go *one deep* (hence no need for a stack) WDP 94/09 */
@@ -817,10 +820,14 @@ NL                        [\n\r]
      * Simple comments and whitespace.  Normally, we would just ignore these, but
      * in case we're processing a string escape, we need to note that we've seen
      * a gap.
      * Simple comments and whitespace.  Normally, we would just ignore these, but
      * in case we're processing a string escape, we need to note that we've seen
      * a gap.
+     *
+     * Note that we cater for a comment line that *doesn't* end in a newline.
+     * This is incorrect, strictly speaking, but seems like the right thing
+     * to do.  Reported by Rajiv Mirani.  (WDP 95/08)
      */
 %}
 
      */
 %}
 
-<Code,GlaExt,StringEsc>"--".*{NL}{WS}* |
+<Code,GlaExt,StringEsc>"--".*{NL}?{WS}* |
 <Code,GlaExt,GhcPragma,UserPragma,StringEsc>{WS}+      { noGap = FALSE; }
 
 %{
 <Code,GlaExt,GhcPragma,UserPragma,StringEsc>{WS}+      { noGap = FALSE; }
 
 %{
@@ -947,11 +954,11 @@ NL                        [\n\r]
    This allows unnamed sources to be piped into the parser.
 */
 
    This allows unnamed sources to be piped into the parser.
 */
 
+extern BOOLEAN acceptPrim;
+
 void
 void
-yyinit()
+yyinit(void)
 {
 {
-    extern BOOLEAN acceptPrim;
-
     input_filename = xstrdup("<stdin>");
 
     /* We must initialize the input buffer _now_, because we call
     input_filename = xstrdup("<stdin>");
 
     /* We must initialize the input buffer _now_, because we call
@@ -964,9 +971,8 @@ yyinit()
        PUSH_STATE(Code);
 }
 
        PUSH_STATE(Code);
 }
 
-void
-new_filename(f) /* This looks pretty dodgy to me (WDP) */
-  char *f;
+static void
+new_filename(char *f) /* This looks pretty dodgy to me (WDP) */
 {
     if (input_filename != NULL)
        free(input_filename);
 {
     if (input_filename != NULL)
        free(input_filename);
@@ -986,8 +992,8 @@ new_filename(f) /* This looks pretty dodgy to me (WDP) */
        forcing insertion of ; or } as appropriate
 */
 
        forcing insertion of ; or } as appropriate
 */
 
-BOOLEAN
-hsshouldindent()
+static BOOLEAN
+hsshouldindent(void)
 {
     return (!forgetindent && INDENTON);
 }
 {
     return (!forgetindent && INDENTON);
 }
@@ -995,7 +1001,7 @@ hsshouldindent()
 
 /* Enter new context and set new indentation level */
 void
 
 /* Enter new context and set new indentation level */
 void
-hssetindent()
+hssetindent(void)
 {
 #ifdef HSP_DEBUG
     fprintf(stderr, "hssetindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
 {
 #ifdef HSP_DEBUG
     fprintf(stderr, "hssetindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
@@ -1024,7 +1030,7 @@ hssetindent()
 
 /* Enter a new context without changing the indentation level */
 void
 
 /* Enter a new context without changing the indentation level */
 void
-hsincindent()
+hsincindent(void)
 {
 #ifdef HSP_DEBUG
     fprintf(stderr, "hsincindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
 {
 #ifdef HSP_DEBUG
     fprintf(stderr, "hsincindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
@@ -1035,16 +1041,15 @@ hsincindent()
 
 /* Turn off indentation processing, usually because an explicit "{" has been seen */
 void
 
 /* Turn off indentation processing, usually because an explicit "{" has been seen */
 void
-hsindentoff()
+hsindentoff(void)
 {
     forgetindent = TRUE;
 }
 
 
 /* Enter a new layout context. */
 {
     forgetindent = TRUE;
 }
 
 
 /* Enter a new layout context. */
-void
-hsentercontext(indent)
-  int indent;
+static void
+hsentercontext(int indent)
 {
     /* Enter new context and set indentation as specified */
     if (++icontexts >= MAX_CONTEXTS) {
 {
     /* Enter new context and set indentation as specified */
     if (++icontexts >= MAX_CONTEXTS) {
@@ -1063,7 +1068,7 @@ hsentercontext(indent)
 
 /* Exit a layout context */
 void
 
 /* Exit a layout context */
 void
-hsendindent()
+hsendindent(void)
 {
     --icontexts;
 #ifdef HSP_DEBUG
 {
     --icontexts;
 #ifdef HSP_DEBUG
@@ -1075,9 +1080,8 @@ hsendindent()
  *     Return checks the indentation level and returns ;, } or the specified token.
  */
 
  *     Return checks the indentation level and returns ;, } or the specified token.
  */
 
-int
-Return(tok)
-  int tok;
+static int
+Return(int tok)
 {
 #ifdef HSP_DEBUG
     extern int yyleng;
 {
 #ifdef HSP_DEBUG
     extern int yyleng;
@@ -1174,12 +1178,11 @@ yylex()
 **********************************************************************/
 
 /* setyyin(file)       open file as new lex input buffer */
 **********************************************************************/
 
 /* setyyin(file)       open file as new lex input buffer */
+extern FILE *yyin;
+
 void
 void
-setyyin(file)
-  char *file;
+setyyin(char *file)
 {
 {
-    extern FILE *yyin;
-
     hsbuf_save = YY_CURRENT_BUFFER;
     if ((yyin = fopen(file, "r")) == NULL) {
        char errbuf[ERR_BUF_SIZE];
     hsbuf_save = YY_CURRENT_BUFFER;
     if ((yyin = fopen(file, "r")) == NULL) {
        char errbuf[ERR_BUF_SIZE];
@@ -1210,10 +1213,8 @@ setyyin(file)
 #endif
 }
 
 #endif
 }
 
-static VOID
-layout_input(text, len)
-char *text;
-int len;
+static void
+layout_input(char *text, int len)
 {
 #ifdef HSP_DEBUG
     fprintf(stderr, "Scanning \"%s\"\n", text);
 {
 #ifdef HSP_DEBUG
     fprintf(stderr, "Scanning \"%s\"\n", text);
@@ -1243,7 +1244,7 @@ int len;
 }
 
 void
 }
 
 void
-setstartlineno()
+setstartlineno(void)
 {
     startlineno = hsplineno;
 #if 1/*etags*/
 {
     startlineno = hsplineno;
 #if 1/*etags*/
@@ -1269,8 +1270,8 @@ static struct {
     char *text;
 } textcache = { 0, 0, NULL };
 
     char *text;
 } textcache = { 0, 0, NULL };
 
-static VOID
-cleartext()
+static void
+cleartext(void)
 {
 /*  fprintf(stderr, "cleartext\n"); */
     textcache.next = 0;
 {
 /*  fprintf(stderr, "cleartext\n"); */
     textcache.next = 0;
@@ -1280,10 +1281,8 @@ cleartext()
     }
 }
 
     }
 }
 
-static VOID
-addtext(text, length)
-char *text;
-unsigned length;
+static void
+addtext(char *text, unsigned length)
 {
 /*  fprintf(stderr, "addtext: %d %s\n", length, text); */
 
 {
 /*  fprintf(stderr, "addtext: %d %s\n", length, text); */
 
@@ -1298,13 +1297,8 @@ unsigned length;
     textcache.next += length;
 }
 
     textcache.next += length;
 }
 
-static VOID
-#ifdef __STDC__
+static void
 addchar(char c)
 addchar(char c)
-#else
-addchar(c)
-  char c;
-#endif
 {
 /*  fprintf(stderr, "addchar: %c\n", c); */
 
 {
 /*  fprintf(stderr, "addchar: %c\n", c); */
 
@@ -1316,8 +1310,7 @@ addchar(c)
 }
 
 static char *
 }
 
 static char *
-fetchtext(length)
-unsigned *length;
+fetchtext(unsigned *length)
 {
 /*  fprintf(stderr, "fetchtext: %d\n", textcache.next); */
 
 {
 /*  fprintf(stderr, "fetchtext: %d\n", textcache.next); */
 
@@ -1338,10 +1331,8 @@ unsigned *length;
        hsnewid         Enters an id of length n into the symbol table.
 */
 
        hsnewid         Enters an id of length n into the symbol table.
 */
 
-static VOID
-hsnewid(name, length)
-char *name;
-int length;
+static void
+hsnewid(char *name, int length)
 {
     char save = name[length];
 
 {
     char save = name[length];
 
@@ -1351,8 +1342,7 @@ int length;
 }
 
 BOOLEAN 
 }
 
 BOOLEAN 
-isconstr(s) /* walks past leading underscores before using the macro */
-  char *s;
+isconstr(char *s) /* walks past leading underscores before using the macro */
 {
     char *temp = s;
 
 {
     char *temp = s;
 
index fb2d934..398104e 100644 (file)
@@ -39,7 +39,7 @@
 *                                                                     *
 **********************************************************************/
 
 *                                                                     *
 **********************************************************************/
 
-BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
+static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
 
 extern BOOLEAN nonstandardFlag;
 extern BOOLEAN etags;
 
 extern BOOLEAN nonstandardFlag;
 extern BOOLEAN etags;
@@ -81,7 +81,7 @@ extern int startlineno;
 *                                                                     *
 **********************************************************************/
 
 *                                                                     *
 **********************************************************************/
 
-list fixlist;
+/* OLD 95/08: list fixlist; */
 static int Fixity = 0, Precedence = 0;
 struct infix;
 
 static int Fixity = 0, Precedence = 0;
 struct infix;
 
@@ -927,7 +927,7 @@ iimport :  importkey modid OPAREN import_list CPAREN
 
 interface:
           INTERFACE modid
 
 interface:
           INTERFACE modid
-               { fixlist = Lnil;
+               { /* OLD 95/08: fixlist = Lnil; */
                  strcpy(iface_name, id_to_string($2));
                }
           WHERE ibody
                  strcpy(iface_name, id_to_string($2));
                }
           WHERE ibody
@@ -1505,10 +1505,7 @@ kexp     :  LAMBDA
 
        /* SCC Expression */
        |  SCC STRING exp
 
        /* SCC Expression */
        |  SCC STRING exp
-               { extern BOOLEAN ignoreSCC;
-                 extern BOOLEAN warnSCC;
-
-                 if (ignoreSCC) {
+               { if (ignoreSCC) {
                    if (warnSCC)
                        fprintf(stderr,
                                "\"%s\", line %d: _scc_ (`set [profiling] cost centre') ignored\n",
                    if (warnSCC)
                        fprintf(stderr,
                                "\"%s\", line %d: _scc_ (`set [profiling] cost centre') ignored\n",
@@ -1567,26 +1564,6 @@ aexp     :  var                                  { $$ = mkident($1); }
        the starting line for definitions.
 */
 
        the starting line for definitions.
 */
 
-/*TESTTEST
-bind   :  opatk
-       |  vark lampats
-               { $$ = mkap($1,$2); }
-       |  opatk varop opat %prec PLUS
-               {
-                 $$ = mkinfixop($2,$1,$3);
-               }
-       ;
-
-opatk  :  dpatk
-       |  opatk conop opat %prec PLUS
-               {
-                 $$ = mkinfixop($2,$1,$3);
-                 precparse($$);
-               }
-       ;
-
-*/
-
 opatk  :  dpatk
        |  opatk op opat %prec PLUS
                {
 opatk  :  dpatk
        |  opatk op opat %prec PLUS
                {
@@ -1676,12 +1653,6 @@ aapatk   :  conk                                         { $$ = mkident($1); }
        ;
 
 
        ;
 
 
-/*
-   The mkpars are so that infix parsing doesn't get confused.
-
-   KH.
-*/
-
 tuple  :  OPAREN exp COMMA texps CPAREN
                { if (ttree($4) == tuple)
                    $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
 tuple  :  OPAREN exp COMMA texps CPAREN
                { if (ttree($4) == tuple)
                    $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
@@ -1692,6 +1663,11 @@ tuple    :  OPAREN exp COMMA texps CPAREN
                { $$ = mktuple(Lnil); }
        ;
 
                { $$ = mktuple(Lnil); }
        ;
 
+/*
+   The mkpar is so that infix parsing doesn't get confused.
+
+   KH.
+*/
 texps  :  exp  { $$ = mkpar($1); }
        |  exp COMMA texps
                { if (ttree($3) == tuple)
 texps  :  exp  { $$ = mkpar($1); }
        |  exp COMMA texps
                { if (ttree($3) == tuple)
@@ -1736,11 +1712,13 @@ quals   :  qual                                 { $$ = lsing($1); }
        ;
 
 qual   :       { inpat = TRUE; } exp { inpat = FALSE; } qualrest
        ;
 
 qual   :       { inpat = TRUE; } exp { inpat = FALSE; } qualrest
-               { if ($4 == NULL)
+               { if ($4 == NULL) {
+                   patternOrExpr(/*wanted:*/ LEGIT_EXPR,$2);
                    $$ = mkguard($2);
                    $$ = mkguard($2);
-                 else
-                   {
-                     checkpatt($2);
+                 } else {
+                   patternOrExpr(/*wanted:*/ LEGIT_PATT,$2);
+                   $$ = mkqual($2,$4);
+/* OLD: WDP 95/08
                      if(ttree($4)==def)
                        {
                          tree prevpatt_save = PREVPATT;
                      if(ttree($4)==def)
                        {
                          tree prevpatt_save = PREVPATT;
@@ -1749,8 +1727,8 @@ qual      :       { inpat = TRUE; } exp { inpat = FALSE; } qualrest
                          PREVPATT = prevpatt_save;
                        }
                      else
                          PREVPATT = prevpatt_save;
                        }
                      else
-                       $$ = mkqual($2,$4);
-                   }
+*/
+                 }
                }
        ;
 
                }
        ;
 
@@ -2062,13 +2040,13 @@ hsperror(s)
     yyerror(s);
 }
 
     yyerror(s);
 }
 
+extern char *yytext;
+extern int yyleng;
+
 void
 yyerror(s)
   char *s;
 {
 void
 yyerror(s)
   char *s;
 {
-    extern char *yytext;
-    extern int yyleng;
-
     /* We want to be able to distinguish 'error'-raised yyerrors
        from yyerrors explicitly coded by the parser hacker.
     */
     /* We want to be able to distinguish 'error'-raised yyerrors
        from yyerrors explicitly coded by the parser hacker.
     */
index 0dfd419..72e2fca 100644 (file)
@@ -14,6 +14,7 @@
 #include "utils.h"
 
 /* partain: special version for strings that may have NULs (etc) in them
 #include "utils.h"
 
 /* partain: special version for strings that may have NULs (etc) in them
+   (used in UgenUtil.lhs)
 */
 long
 get_hstring_len(hs)
 */
 long
 get_hstring_len(hs)
@@ -137,8 +138,7 @@ hash_index(ident)
   The hash function.  Returns 0 for Null strings.
 */
 
   The hash function.  Returns 0 for Null strings.
 */
 
-static unsigned hash_fn(ident)
-char *ident;
+static unsigned hash_fn(char *ident)
 {
   unsigned len = (unsigned) strlen(ident);
   unsigned res;
 {
   unsigned len = (unsigned) strlen(ident);
   unsigned res;
index dc0eaec..d81de59 100644 (file)
@@ -40,7 +40,7 @@ access(const char *fileName, const char *mode)
 {
     FILE *fp = fopen(fileName, mode);
     if (fp != NULL) {
 {
     FILE *fp = fopen(fileName, mode);
     if (fp != NULL) {
-       (VOID) fclose(fp);
+       (void) fclose(fp);
        return 0;
     }
     return 1;
        return 0;
     }
     return 1;
@@ -51,7 +51,7 @@ access(const char *fileName, const char *mode)
 list   imports_dirlist, sys_imports_dirlist; /* The imports lists */
 extern  char HiSuffix[];
 extern  char PreludeHiSuffix[];
 list   imports_dirlist, sys_imports_dirlist; /* The imports lists */
 extern  char HiSuffix[];
 extern  char PreludeHiSuffix[];
-extern BOOLEAN ExplicitHiSuffixGiven;
+/* OLD 95/08: extern BOOLEAN ExplicitHiSuffixGiven; */
 
 #define MAX_MATCH 16
 
 
 #define MAX_MATCH 16
 
@@ -59,11 +59,8 @@ extern BOOLEAN ExplicitHiSuffixGiven;
   This finds a module along the imports directory list.
 */
 
   This finds a module along the imports directory list.
 */
 
-VOID
-find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename)
-  char *module_name;
-  BOOLEAN is_sys_import;
-  char *returned_filename;
+void
+find_module_on_imports_dirlist(char *module_name, BOOLEAN is_sys_import, char *returned_filename)
 {
     char try[FILENAME_SIZE];
 
 {
     char try[FILENAME_SIZE];
 
@@ -77,7 +74,9 @@ find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename)
     BOOLEAN tried_source_dir = FALSE;
 
     char *try_end;
     BOOLEAN tried_source_dir = FALSE;
 
     char *try_end;
-    char *suffix_to_use = (is_sys_import) ? PreludeHiSuffix : HiSuffix;
+    char *suffix_to_use    = (is_sys_import) ? PreludeHiSuffix : HiSuffix;
+    char *suffix_to_report = suffix_to_use; /* save this for reporting, because we
+                                               might change suffix_to_use later */
     int modname_len = strlen(module_name);
 
     /* 
     int modname_len = strlen(module_name);
 
     /* 
@@ -197,13 +196,13 @@ find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename)
     switch ( no_of_matches ) {
     default:
          fprintf(stderr,"Warning: found %d %s files for module \"%s\"\n",
     switch ( no_of_matches ) {
     default:
          fprintf(stderr,"Warning: found %d %s files for module \"%s\"\n",
-                       no_of_matches, suffix_to_use, module_name);
+                       no_of_matches, suffix_to_report, module_name);
          break;
     case 0:
          {
            char disaster_msg[MODNAME_SIZE+1000];
            sprintf(disaster_msg,"can't find interface (%s) file for module \"%s\"%s",
          break;
     case 0:
          {
            char disaster_msg[MODNAME_SIZE+1000];
            sprintf(disaster_msg,"can't find interface (%s) file for module \"%s\"%s",
-                       suffix_to_use, module_name,
+                       suffix_to_report, module_name,
                        (strncmp(module_name, "PreludeGlaIO", 12) == 0)
                        ? "\n(The PreludeGlaIO interface no longer exists);"
                        :(
                        (strncmp(module_name, "PreludeGlaIO", 12) == 0)
                        ? "\n(The PreludeGlaIO interface no longer exists);"
                        :(
index d53131b..9e17a1e 100644 (file)
@@ -81,11 +81,14 @@ enteriscope()
   ninfix = 0;
 }
 
   ninfix = 0;
 }
 
+#if 0
+/* UNUSED */
 void
 exitiscope()
 {
   --iscope;
 }
 void
 exitiscope()
 {
   --iscope;
 }
+#endif
 
 void
 exposeis()
 
 void
 exposeis()
@@ -102,9 +105,7 @@ exposeis()
 
 
 static int
 
 
 static int
-ionelookup(name,iscope)
-  id name;
-  int iscope;
+ionelookup(id name, int iscope)
 {
   int i;
   char *iname = id_to_string(name);
 {
   int i;
   char *iname = id_to_string(name);
@@ -140,15 +141,13 @@ nfixes()
 }
 
 char *
 }
 
 char *
-fixop(n)
-  int n;
+fixop(int n)
 {
        return infixtab[iscope][n].iname;
 }
 
 char *
 {
        return infixtab[iscope][n].iname;
 }
 
 char *
-fixtype(n)
-  int n;
+fixtype(int n)
 {
        switch(infixtab[iscope][n].ifixity) {
        case INFIXL:
 {
        switch(infixtab[iscope][n].ifixity) {
        case INFIXL:
@@ -165,7 +164,8 @@ fixtype(n)
        }
 }
 
        }
 }
 
-
+#if 0
+/* UNUSED? */
 int
 fixity(n)
   int n;
 int
 fixity(n)
   int n;
@@ -175,6 +175,7 @@ fixity(n)
 #endif
   return(n < 0? INFIXL: infixtab[iscope][n].ifixity);
 }
 #endif
   return(n < 0? INFIXL: infixtab[iscope][n].ifixity);
 }
+#endif /* 0 */
 
 
 long int
 
 
 long int
index 0c6e197..ea1accd 100644 (file)
@@ -20,9 +20,7 @@
 **********************************************************************/
 
 int
 **********************************************************************/
 
 int
-main(argc, argv)
-  int argc;
-  char **argv;
+main(int argc, char **argv)
 {
     Lnil = mklnil();   /* The null list -- used in lsing, etc. */
     all = mklnil();            /* This should be the list of all derivable types */
 {
     Lnil = mklnil();   /* The null list -- used in lsing, etc. */
     all = mklnil();            /* This should be the list of all derivable types */
index 719f87c..1300baf 100644 (file)
@@ -18,7 +18,7 @@
 
 /* fwd decls, necessary and otherwise */
 static void ptree   PROTO( (tree) );
 
 /* fwd decls, necessary and otherwise */
 static void ptree   PROTO( (tree) );
-static void plist   PROTO( (void (*)(), list) );
+static void plist   PROTO( (void (*)(/*NOT WORTH IT: void * */), list) );
 static void pid            PROTO( (id) );
 static void pstr    PROTO( (char *) );
 static void pbool   PROTO( (BOOLEAN) );
 static void pid            PROTO( (id) );
 static void pstr    PROTO( (char *) );
 static void pbool   PROTO( (BOOLEAN) );
@@ -68,8 +68,7 @@ tree t;
    char/string lexer comments.  (WDP 94/11)
 */
 static void
    char/string lexer comments.  (WDP 94/11)
 */
 static void
-print_string(str)
-  hstring str;
+print_string(hstring str)
 {
     char *gs;
     char c;
 {
     char *gs;
     char c;
@@ -95,13 +94,12 @@ print_string(str)
 }
 
 static int
 }
 
 static int
-get_character(str)
-  hstring str;
+get_character(hstring str)
 {
     int c = (int)((str->bytes)[0]);
 
     if (str->len != 1) { /* ToDo: assert */
 {
     int c = (int)((str->bytes)[0]);
 
     if (str->len != 1) { /* ToDo: assert */
-       fprintf(stderr, "get_character: length != 1? (%d: %s)\n", str->len, str->bytes);
+       fprintf(stderr, "get_character: length != 1? (%ld: %s)\n", str->len, str->bytes);
     }
 
     if (c < 0) {
     }
 
     if (c < 0) {
@@ -112,8 +110,7 @@ get_character(str)
 }
 
 static void
 }
 
 static void
-pliteral(t)
-   literal t;
+pliteral(literal t)
 {
     switch(tliteral(t)) {
       case integer:
 {
     switch(tliteral(t)) {
       case integer:
@@ -188,7 +185,7 @@ again:
       case par:                t = gpare(t); goto again;
       case hmodule:
                      PUTTAG('M');
       case par:                t = gpare(t); goto again;
       case hmodule:
                      PUTTAG('M');
-                     printf("#%u\t",ghmodline(t));
+                     printf("#%lu\t",ghmodline(t));
                      pid(ghname(t));
                      pstr(input_filename);
                      prbind(ghmodlist(t));
                      pid(ghname(t));
                      pstr(input_filename);
                      prbind(ghmodlist(t));
@@ -229,7 +226,7 @@ again:
 
       case lambda: 
                      PUTTAG('l');
 
       case lambda: 
                      PUTTAG('l');
-                     printf("#%u\t",glamline(t));
+                     printf("#%lu\t",glamline(t));
                      plist(ptree,glampats(t));
                      ptree(glamexpr(t));
                      break;
                      plist(ptree,glampats(t));
                      ptree(glamexpr(t));
                      break;
@@ -357,7 +354,7 @@ again:
 
 static void
 plist(fun, l)
 
 static void
 plist(fun, l)
-  void (*fun)();
+  void (*fun)(/* NOT WORTH IT: void * */);
   list l;
 {
        if (tlist(l) == lcons) {
   list l;
 {
        if (tlist(l) == lcons) {
@@ -374,7 +371,7 @@ pid(i)
   id i;
 {
   if(hashIds)
   id i;
 {
   if(hashIds)
-       printf("!%u\t", hash_index(i));
+       printf("!%lu\t", hash_index(i));
   else
        printf("#%s\t", id_to_string(i));
 }
   else
        printf("#%s\t", id_to_string(i));
 }
@@ -393,7 +390,7 @@ prbind(b)
        switch(tbinding(b)) {
        case tbind: 
                          PUTTAG('t');
        switch(tbinding(b)) {
        case tbind: 
                          PUTTAG('t');
-                         printf("#%u\t",gtline(b));
+                         printf("#%lu\t",gtline(b));
                          plist(pttype, gtbindc(b));
                          plist(pid, gtbindd(b));
                          pttype(gtbindid(b));
                          plist(pttype, gtbindc(b));
                          plist(pid, gtbindd(b));
                          pttype(gtbindid(b));
@@ -402,19 +399,19 @@ prbind(b)
                          break;
        case nbind      : 
                          PUTTAG('n');
                          break;
        case nbind      : 
                          PUTTAG('n');
-                         printf("#%u\t",gnline(b));
+                         printf("#%lu\t",gnline(b));
                          pttype(gnbindid(b));
                          pttype(gnbindas(b));
                          ppragma(gnpragma(b));
                          break;
        case pbind      : 
                          PUTTAG('p');
                          pttype(gnbindid(b));
                          pttype(gnbindas(b));
                          ppragma(gnpragma(b));
                          break;
        case pbind      : 
                          PUTTAG('p');
-                         printf("#%u\t",gpline(b));
+                         printf("#%lu\t",gpline(b));
                          plist(ppbinding, gpbindl(b));
                          break;
        case fbind      : 
                          PUTTAG('f');
                          plist(ppbinding, gpbindl(b));
                          break;
        case fbind      : 
                          PUTTAG('f');
-                         printf("#%u\t",gfline(b));
+                         printf("#%lu\t",gfline(b));
                          plist(ppbinding, gfbindl(b));
                          break;
        case abind      : 
                          plist(ppbinding, gfbindl(b));
                          break;
        case abind      : 
@@ -424,7 +421,7 @@ prbind(b)
                          break;
        case cbind      :
                          PUTTAG('$');
                          break;
        case cbind      :
                          PUTTAG('$');
-                         printf("#%u\t",gcline(b));
+                         printf("#%lu\t",gcline(b));
                          plist(pttype,gcbindc(b));
                          pttype(gcbindid(b));
                          prbind(gcbindw(b));
                          plist(pttype,gcbindc(b));
                          pttype(gcbindid(b));
                          prbind(gcbindw(b));
@@ -432,7 +429,7 @@ prbind(b)
                          break;
        case ibind      :
                          PUTTAG('%');
                          break;
        case ibind      :
                          PUTTAG('%');
-                         printf("#%u\t",giline(b));
+                         printf("#%lu\t",giline(b));
                          plist(pttype,gibindc(b));
                          pid(gibindid(b));
                          pttype(gibindi(b));
                          plist(pttype,gibindc(b));
                          pid(gibindid(b));
                          pttype(gibindi(b));
@@ -441,14 +438,14 @@ prbind(b)
                          break;
        case dbind      :
                          PUTTAG('D');
                          break;
        case dbind      :
                          PUTTAG('D');
-                         printf("#%u\t",gdline(b));
+                         printf("#%lu\t",gdline(b));
                          plist(pttype,gdbindts(b));
                          break;
 
        /* signature(-like) things, including user pragmas */
        case sbind      :
                          PUTTAGSTR("St");
                          plist(pttype,gdbindts(b));
                          break;
 
        /* signature(-like) things, including user pragmas */
        case sbind      :
                          PUTTAGSTR("St");
-                         printf("#%u\t",gsline(b));
+                         printf("#%lu\t",gsline(b));
                          plist(pid,gsbindids(b));
                          pttype(gsbindid(b));
                          ppragma(gspragma(b));
                          plist(pid,gsbindids(b));
                          pttype(gsbindid(b));
                          ppragma(gspragma(b));
@@ -456,41 +453,41 @@ prbind(b)
 
        case vspec_uprag:
                          PUTTAGSTR("Ss");
 
        case vspec_uprag:
                          PUTTAGSTR("Ss");
-                         printf("#%u\t",gvspec_line(b));
+                         printf("#%lu\t",gvspec_line(b));
                          pid(gvspec_id(b));
                          plist(pttype,gvspec_tys(b));
                          break;
        case ispec_uprag:
                          PUTTAGSTR("SS");
                          pid(gvspec_id(b));
                          plist(pttype,gvspec_tys(b));
                          break;
        case ispec_uprag:
                          PUTTAGSTR("SS");
-                         printf("#%u\t",gispec_line(b));
+                         printf("#%lu\t",gispec_line(b));
                          pid(gispec_clas(b));
                          pttype(gispec_ty(b));
                          break;
        case inline_uprag:
                          PUTTAGSTR("Si");
                          pid(gispec_clas(b));
                          pttype(gispec_ty(b));
                          break;
        case inline_uprag:
                          PUTTAGSTR("Si");
-                         printf("#%u\t",ginline_line(b));
+                         printf("#%lu\t",ginline_line(b));
                          pid(ginline_id(b));
                          plist(pid,ginline_howto(b));
                          break;
        case deforest_uprag:
                          PUTTAGSTR("Sd");
                          pid(ginline_id(b));
                          plist(pid,ginline_howto(b));
                          break;
        case deforest_uprag:
                          PUTTAGSTR("Sd");
-                         printf("#%u\t",gdeforest_line(b));
+                         printf("#%lu\t",gdeforest_line(b));
                          pid(gdeforest_id(b));
                          break;
        case magicuf_uprag:
                          PUTTAGSTR("Su");
                          pid(gdeforest_id(b));
                          break;
        case magicuf_uprag:
                          PUTTAGSTR("Su");
-                         printf("#%u\t",gmagicuf_line(b));
+                         printf("#%lu\t",gmagicuf_line(b));
                          pid(gmagicuf_id(b));
                          pid(gmagicuf_str(b));
                          break;
        case abstract_uprag:
                          PUTTAGSTR("Sa");
                          pid(gmagicuf_id(b));
                          pid(gmagicuf_str(b));
                          break;
        case abstract_uprag:
                          PUTTAGSTR("Sa");
-                         printf("#%u\t",gabstract_line(b));
+                         printf("#%lu\t",gabstract_line(b));
                          pid(gabstract_id(b));
                          break;
        case dspec_uprag:
                          PUTTAGSTR("Sd");
                          pid(gabstract_id(b));
                          break;
        case dspec_uprag:
                          PUTTAGSTR("Sd");
-                         printf("#%u\t",gdspec_line(b));
+                         printf("#%lu\t",gdspec_line(b));
                          pid(gdspec_id(b));
                          plist(pttype,gdspec_tys(b));
                          break;
                          pid(gdspec_id(b));
                          plist(pttype,gdspec_tys(b));
                          break;
@@ -499,14 +496,14 @@ prbind(b)
 
        case mbind:       
                          PUTTAG('7');
 
        case mbind:       
                          PUTTAG('7');
-                         printf("#%u\t",gmline(b));
+                         printf("#%lu\t",gmline(b));
                          pid(gmbindmodn(b));
                          plist(pentid,gmbindimp(b));
                          plist(prename,gmbindren(b));
                          break;
        case import:      
                          PUTTAG('e');
                          pid(gmbindmodn(b));
                          plist(pentid,gmbindimp(b));
                          plist(prename,gmbindren(b));
                          break;
        case import:      
                          PUTTAG('e');
-                         printf("#%u\t",giebindline(b));
+                         printf("#%lu\t",giebindline(b));
                          pstr(giebindfile(b));
                          pid(giebindmod(b));
                          plist(pentid,giebindexp(b));
                          pstr(giebindfile(b));
                          pid(giebindmod(b));
                          plist(pentid,giebindexp(b));
@@ -515,7 +512,7 @@ prbind(b)
                          break;
        case hiding:      
                          PUTTAG('h');
                          break;
        case hiding:      
                          PUTTAG('h');
-                         printf("#%u\t",gihbindline(b));
+                         printf("#%lu\t",gihbindline(b));
                          pstr(gihbindfile(b));
                          pid(gihbindmod(b));
                          plist(pentid,gihbindexp(b));
                          pstr(gihbindfile(b));
                          pid(gihbindmod(b));
                          plist(pentid,gihbindexp(b));
@@ -597,7 +594,7 @@ patype(a)
        switch (tatype(a)) {
        case atc        : 
                          PUTTAG('1');
        switch (tatype(a)) {
        case atc        : 
                          PUTTAG('1');
-                         printf("#%u\t",gatcline(a));
+                         printf("#%lu\t",gatcline(a));
                          pid(gatcid(a));
                          plist(pttype, gatctypel(a));
                          break;
                          pid(gatcid(a));
                          plist(pttype, gatctypel(a));
                          break;
@@ -659,7 +656,7 @@ pfixes()
                        PUTTAG('L');
                        pstr(fixop(i));
                        pstr(fixtype(i));
                        PUTTAG('L');
                        pstr(fixop(i));
                        pstr(fixtype(i));
-                       printf("#%u\t",precedence(i));
+                       printf("#%lu\t",precedence(i));
                }
        }
        PUTTAG('N');
                }
        }
        PUTTAG('N');
@@ -672,7 +669,7 @@ ppbinding(p)
 {
        switch(tpbinding(p)) {
        case pgrhs      : PUTTAG('W');
 {
        switch(tpbinding(p)) {
        case pgrhs      : PUTTAG('W');
-                         printf("#%u\t",ggline(p));
+                         printf("#%lu\t",ggline(p));
                          pid(ggfuncname(p));
                          ptree(ggpat(p));
                          plist(pgrhses,ggdexprs(p));
                          pid(ggfuncname(p));
                          ptree(ggpat(p));
                          plist(pgrhses,ggdexprs(p));
index 6719ccb..e64f978 100644 (file)
@@ -37,8 +37,12 @@ extern BOOLEAN hashIds, etags;
 
 /* Forward Declarations */
 
 
 /* Forward Declarations */
 
-char *ineg    PROTO((char *));
-tree unparen  PROTO((tree));
+char *ineg                 PROTO((char *));
+static tree unparen        PROTO((tree));
+static void is_conapp_patt  PROTO((int, tree, tree));
+static void rearrangeprec   PROTO((tree, tree));
+static void error_if_expr_wanted PROTO((int, char *));
+static void error_if_patt_wanted PROTO((int, char *));
 
 tree  fns[MAX_CONTEXTS] = { NULL };
 short samefn[MAX_CONTEXTS] = { 0 };
 
 tree  fns[MAX_CONTEXTS] = { NULL };
 short samefn[MAX_CONTEXTS] = { 0 };
@@ -46,6 +50,8 @@ tree  prevpatt[MAX_CONTEXTS] = { NULL };
 
 BOOLEAN inpat = FALSE;
 
 
 BOOLEAN inpat = FALSE;
 
+static BOOLEAN  checkorder2 PROTO((binding, BOOLEAN));
+static BOOLEAN  checksig PROTO((BOOLEAN, binding));
 
 /*
   check infix value in range 0..9
 
 /*
   check infix value in range 0..9
@@ -74,12 +80,14 @@ checkfixity(vals)
   Check Previous Pattern usage
 */
 
   Check Previous Pattern usage
 */
 
+/* UNUSED:
 void
 checkprevpatt()
 {
   if (PREVPATT == NULL)
     hsperror("\"'\" used before a function definition");
 }
 void
 checkprevpatt()
 {
   if (PREVPATT == NULL)
     hsperror("\"'\" used before a function definition");
 }
+*/
 
 void
 checksamefn(fn)
 
 void
 checksamefn(fn)
@@ -99,6 +107,8 @@ checksamefn(fn)
   Check that a list of types is a list of contexts
 */
 
   Check that a list of types is a list of contexts
 */
 
+#if 0
+/* UNUSED */
 void
 checkcontext(context)
   list context;
 void
 checkcontext(context)
   list context;
@@ -122,6 +132,7 @@ checkcontext(context)
       context = ltl(context);
     }
 }
       context = ltl(context);
     }
 }
+#endif /* 0 */
 
 void
 checkinpat()
 
 void
 checkinpat()
@@ -130,15 +141,21 @@ checkinpat()
     hsperror("syntax error");
 }
 
     hsperror("syntax error");
 }
 
+/* ------------------------------------------------------------------------
+*/
+
 void
 void
-checkpatt(e)
-  tree e;
+patternOrExpr(int wanted, tree e)
+  /* see utils.h for what args are */
 {
   switch(ttree(e))
     {
 {
   switch(ttree(e))
     {
-      case ident:
+      case ident: /* a pattern or expr */
+       break;
+
       case wildp:
       case wildp:
-        break;
+       error_if_expr_wanted(wanted, "wildcard in expression");
+       break;
 
       case lit:
        switch (tliteral(glit(e))) {
 
       case lit:
        switch (tliteral(glit(e))) {
@@ -148,24 +165,31 @@ checkpatt(e)
          case doubleprim:
          case floatprim:
          case string:
          case doubleprim:
          case floatprim:
          case string:
+         case stringprim:
          case charr:
          case charprim:
          case charr:
          case charprim:
-         case stringprim:
-           break;
-         default:
-           hsperror("not a valid literal pattern");
+           break; /* pattern or expr */
+
+         case clitlit:
+           error_if_patt_wanted(wanted, "``literal-literal'' in pattern");
+
+         default: /* the others only occur in pragmas */
+           hsperror("not a valid literal pattern or expression");
        }
        break;
 
       case negate:
        }
        break;
 
       case negate:
-       if (ttree(gnexp(e)) != lit) {
-           hsperror("syntax error: \"-\" applied to a non-literal");
-       } else {
-           literal l = glit(gnexp(e));
-
-           if (tliteral(l) != integer && tliteral(l) != floatr) {
-             hsperror("syntax error: \"-\" applied to a non-number");
-           }
+       { tree sub = gnexp(e);
+         if (ttree(sub) != lit) {
+             error_if_patt_wanted(wanted, "\"-\" applied to a non-literal");
+         } else {
+             literal l = glit(sub);
+
+             if (tliteral(l) != integer && tliteral(l) != floatr) {
+               error_if_patt_wanted(wanted, "\"-\" applied to a non-number");
+             }
+         }
+         patternOrExpr(wanted, sub);
        }
        break;
 
        }
        break;
 
@@ -174,109 +198,177 @@ checkpatt(e)
          tree f = gfun(e);
          tree a = garg(e);
 
          tree f = gfun(e);
          tree a = garg(e);
 
-         checkconap(f, a);
+         is_conapp_patt(wanted, f, a); /* does nothing unless wanted == LEGIT_PATT */
+         patternOrExpr(wanted, f);
+         patternOrExpr(wanted, a);
        }
        break;
 
       case as:
        }
        break;
 
       case as:
-       checkpatt(gase(e));
+       error_if_expr_wanted(wanted, "`as'-pattern instead of an expression");
+       patternOrExpr(wanted, gase(e));
        break;
 
       case lazyp:
        break;
 
       case lazyp:
-       checkpatt(glazyp(e));
+       error_if_expr_wanted(wanted, "irrefutable pattern instead of an expression");
+       patternOrExpr(wanted, glazyp(e));
        break;
 
       case plusp:
        break;
 
       case plusp:
-       checkpatt(gplusp(e));
+       patternOrExpr(wanted, gplusp(e));
        break;
 
       case tinfixop:
        {
        break;
 
       case tinfixop:
        {
-         tree f = ginfun((struct Sap *)e),
+         tree f  = ginfun((struct Sap *)e),
               a1 = ginarg1((struct Sap *)e),
               a2 = ginarg2((struct Sap *)e);
 
          struct Splusp *e_plus;
 
               a1 = ginarg1((struct Sap *)e),
               a2 = ginarg2((struct Sap *)e);
 
          struct Splusp *e_plus;
 
-         checkpatt(a1);
-
-         if (ttree(f) == ident && strcmp(id_to_string(gident(f)),"+")==0)
-           {
-             if(ttree(a2) != lit || tliteral((literal) ttree(a2)) != integer)
-               hsperror("syntax error: non-integer in (n+k) pattern");
-
-             if(ttree(a1) == wildp || (ttree(a1) == ident && !isconstr(gident(a1))))
-               {
-                 e->tag = plusp;
-                 e_plus = (struct Splusp *) e;
-                 *Rgplusp(e_plus) = a1;
-                 *Rgplusi(e_plus) = glit(a2);
-               }
-             else
-               hsperror("syntax error: non-variable in (n+k) pattern");
-           }
-         else
-           {
-             if(ttree(f) == ident && !isconstr(gident(f)))
-               hsperror("syntax error: variable application in pattern");
-             checkpatt(a2);
-           }
+         patternOrExpr(wanted, a1);
+         patternOrExpr(wanted, a2);
+
+         if (wanted == LEGIT_PATT) {
+            if (ttree(f) == ident && strcmp(id_to_string(gident(f)),"+")==0) {
+
+                if(ttree(a2) != lit || tliteral((literal) ttree(a2)) != integer)
+                  hsperror("non-integer in (n+k) pattern");
+
+                if(ttree(a1) == wildp || (ttree(a1) == ident && !isconstr(gident(a1))))
+                  {
+                    e->tag = plusp;
+                    e_plus = (struct Splusp *) e;
+                    *Rgplusp(e_plus) = a1;
+                    *Rgplusi(e_plus) = glit(a2);
+                  }
+                else
+                  hsperror("non-variable in (n+k) pattern");
+
+            } else {
+                if(ttree(f) == ident && !isconstr(gident(f)))
+                  hsperror("variable application in pattern");
+            }
+         }
        }
        break;
 
       case tuple:
        {
        }
        break;
 
       case tuple:
        {
-         list tup = gtuplelist(e);
-         while (tlist(tup) == lcons)
-           {
-             checkpatt(lhd(tup));
-             tup = ltl(tup);
-           }
+         list tup;
+         for (tup = gtuplelist(e); tlist(tup) == lcons; tup = ltl(tup)) {
+             patternOrExpr(wanted, lhd(tup));
+         }
        }
        break;
 
        }
        break;
 
-      case par:
-       checkpatt(gpare(e));
+      case par: /* parenthesised */
+       patternOrExpr(wanted, gpare(e));
        break;
 
       case llist:
        {
        break;
 
       case llist:
        {
-         list l = gllist(e);
-         while (tlist(l) == lcons)
-           {
-             checkpatt(lhd(l));
-             l = ltl(l);
-           }
+         list l;
+         for (l = gllist(e); tlist(l) == lcons; l = ltl(l)) {
+             patternOrExpr(wanted, lhd(l));
+         }
        }
        break;
 
 #ifdef DPH
       case proc:
         {
        }
        break;
 
 #ifdef DPH
       case proc:
         {
-          list pids = gprocid(e);
-         while (tlist(pids) == lcons)
-           {
-             checkpatt(lhd(pids));
-             pids = ltl(pids);
-           }
-         checkpatt(gprocdata(e));
+          list pids;
+         for (pids = gprocid(e); tlist(pids) == lcons; pids = ltl(pids)) {
+             patternOrExpr(wanted, lhd(pids));
+         }
+         patternOrExpr(wanted, gprocdata(e));
        }
        break;
 #endif /* DPH */
 
        }
        break;
 #endif /* DPH */
 
+      case lambda:
+      case let:
+      case casee:
+      case ife:
+      case restr:
+      case comprh:
+      case lsection:
+      case rsection:
+      case eenum:
+      case ccall:
+      case scc:
+       error_if_patt_wanted(wanted, "unexpected construct in a pattern");
+       break;
+
       default:
       default:
-       hsperror("not a pattern");
+       hsperror("not a pattern or expression");
       }
 }
 
       }
 }
 
+static void
+is_conapp_patt(int wanted, tree f, tree a)
+{
+  if (wanted == LEGIT_EXPR)
+     return; /* that was easy */
+
+  switch(ttree(f))
+    {
+      case ident:
+        if (isconstr(gident(f)))
+         {
+           patternOrExpr(wanted, a);
+           return;
+         }
+       {
+         char errbuf[ERR_BUF_SIZE];
+         sprintf(errbuf,"not a constructor application -- %s",gident(f));
+         hsperror(errbuf);
+       }
 
 
-BOOLEAN /* return TRUE if LHS is a pattern; FALSE if a function */
-is_patt_or_fun(e, outer_level)
-  tree e;
-  BOOLEAN outer_level;
-       /* only needed because x+y is a *function* at
-          the "outer level", but an n+k *pattern* at
-          any "inner" level.  Sigh. */
+      case ap:
+       is_conapp_patt(wanted, gfun(f), garg(f));
+       patternOrExpr(wanted, a);
+       return;
+
+      case par:
+       is_conapp_patt(wanted, gpare(f), a);
+       break;
+
+      case tuple:
+       {
+          char errbuf[ERR_BUF_SIZE];
+          sprintf(errbuf,"tuple pattern `applied' to arguments (missing comma?)");
+          hsperror(errbuf);
+       }
+       break;
+
+      default:
+       hsperror("not a constructor application");
+      }
+}
+
+static void
+error_if_expr_wanted(int wanted, char *msg)
+{
+    if (wanted == LEGIT_EXPR)
+       hsperror(msg);
+}
+
+static void
+error_if_patt_wanted(int wanted, char *msg)
+{
+    if (wanted == LEGIT_PATT)
+       hsperror(msg);
+}
+
+/* ---------------------------------------------------------------------- */
+
+static BOOLEAN /* return TRUE if LHS is a pattern; FALSE if a function */
+is_patt_or_fun(tree e, BOOLEAN outer_level)
+    /* "outer_level" only needed because x+y is a *function* at
+       the "outer level", but an n+k *pattern* at
+       any "inner" level.  Sigh. */
 {
   switch(ttree(e))
     {
 {
   switch(ttree(e))
     {
@@ -308,7 +400,7 @@ is_patt_or_fun(e, outer_level)
 #ifdef DPH
       case proc:
 #endif
 #ifdef DPH
       case proc:
 #endif
-       checkpatt(e);
+       patternOrExpr(LEGIT_PATT, e);
        return TRUE;
 
       case ident:
        return TRUE;
 
       case ident:
@@ -327,7 +419,7 @@ is_patt_or_fun(e, outer_level)
          tree fn = function(e);
 
 /*fprintf(stderr,"ap:f=%d %s (%d),a=%d %s\n",ttree(gfun(e)),(ttree(gfun(e)) == ident) ? (gident(gfun(e))) : "",ttree(fn),ttree(garg(e)),(ttree(garg(e)) == ident) ? (gident(garg(e))) : "");*/
          tree fn = function(e);
 
 /*fprintf(stderr,"ap:f=%d %s (%d),a=%d %s\n",ttree(gfun(e)),(ttree(gfun(e)) == ident) ? (gident(gfun(e))) : "",ttree(fn),ttree(garg(e)),(ttree(garg(e)) == ident) ? (gident(garg(e))) : "");*/
-         checkpatt(a);
+         patternOrExpr(LEGIT_PATT, a);
 
          if(ttree(fn) == ident)
            return(isconstr(gident(fn)));
 
          if(ttree(fn) == ident)
            return(isconstr(gident(fn)));
@@ -348,8 +440,8 @@ is_patt_or_fun(e, outer_level)
          struct Splusp *e_plus;
 
          /* Even function definitions must have pattern arguments */
          struct Splusp *e_plus;
 
          /* Even function definitions must have pattern arguments */
-         checkpatt(a1);
-         checkpatt(a2);
+         patternOrExpr(LEGIT_PATT, a1);
+         patternOrExpr(LEGIT_PATT, a2);
 
          if (ttree(f) == ident)
            {
 
          if (ttree(f) == ident)
            {
@@ -404,7 +496,7 @@ function(e)
   switch (ttree(e))
     {
       case ap:
   switch (ttree(e))
     {
       case ap:
-        checkpatt(garg(e));
+        patternOrExpr(LEGIT_PATT, garg(e));
         return(function(gfun(e)));
 
       case par:
         return(function(gfun(e)));
 
       case par:
@@ -416,7 +508,7 @@ function(e)
 }
 
 
 }
 
 
-tree
+static tree
 unparen(e)
   tree e;
 {
 unparen(e)
   tree e;
 {
@@ -426,46 +518,6 @@ unparen(e)
   return(e);
 }
 
   return(e);
 }
 
-void
-checkconap(f, a)
-  tree f, a;
-{
-  switch(ttree(f))
-    {
-      case ident:
-        if (isconstr(gident(f)))
-         {
-           checkpatt(a);
-           return;
-         }
-       {
-         char errbuf[ERR_BUF_SIZE];
-         sprintf(errbuf,"syntax error: not a constructor application -- %s",gident(f));
-         hsperror(errbuf);
-       }
-
-      case ap:
-       checkconap(gfun(f), garg(f));
-       checkpatt(a);
-       return;
-
-      case par:
-       checkconap(gpare(f), a);
-       break;
-
-      case tuple:
-       {
-          char errbuf[ERR_BUF_SIZE];
-          sprintf(errbuf,"syntax error: tuple pattern `applied' to arguments (missing comma?)");
-          hsperror(errbuf);
-       }
-       break;
-
-      default:
-       hsperror("syntax error: not a constructor application");
-      }
-}
-
 
 /*
   Extend a function by adding a new definition to its list of bindings.
 
 /*
   Extend a function by adding a new definition to its list of bindings.
@@ -501,22 +553,21 @@ binding rule;
 */
 
 void
 */
 
 void
-precparse(t)
-  tree t;
+precparse(tree t)
 {
 #if 0
 {
 #if 0
-#ifdef HSP_DEBUG
+# ifdef HSP_DEBUG
   fprintf(stderr,"precparse %x\n",ttree(t));
   fprintf(stderr,"precparse %x\n",ttree(t));
-#endif
+# endif
 #endif
   if(ttree(t) == tinfixop)
     {
       tree left =  ginarg1((struct Sap *)t);
 
 #if 0
 #endif
   if(ttree(t) == tinfixop)
     {
       tree left =  ginarg1((struct Sap *)t);
 
 #if 0
-#ifdef HSP_DEBUG
+# ifdef HSP_DEBUG
       fprintf(stderr,"precparse:t=");ptree(t);printf("\nleft=");ptree(left);printf("\n");
       fprintf(stderr,"precparse:t=");ptree(t);printf("\nleft=");ptree(left);printf("\n");
-#endif
+# endif
 #endif
 
       if(ttree(left) == negate)
 #endif
 
       if(ttree(left) == negate)
@@ -542,10 +593,10 @@ precparse(t)
                       *ttabpos    = infixlookup(tid);
 
 #if 0
                       *ttabpos    = infixlookup(tid);
 
 #if 0
-#ifdef HSP_DEBUG
+# ifdef HSP_DEBUG
          fprintf(stderr,"precparse: lid=%s; tid=%s,ltab=%d,ttab=%d\n",
                  id_to_string(lid),id_to_string(tid),pprecedence(lefttabpos),pprecedence(ttabpos));
          fprintf(stderr,"precparse: lid=%s; tid=%s,ltab=%d,ttab=%d\n",
                  id_to_string(lid),id_to_string(tid),pprecedence(lefttabpos),pprecedence(ttabpos));
-#endif
+# endif
 #endif
 
          if (pprecedence(lefttabpos) < pprecedence(ttabpos))
 #endif
 
          if (pprecedence(lefttabpos) < pprecedence(ttabpos))
@@ -577,9 +628,8 @@ precparse(t)
   The recursive call to precparse ensures this filters down as necessary.
 */
 
   The recursive call to precparse ensures this filters down as necessary.
 */
 
-void
-rearrangeprec(t1,t2)
-  tree t1, t2;
+static void
+rearrangeprec(tree t1, tree t2)
 {
   tree arg3 = ginarg2((struct Sap *)t2);
   id id1 = gident(ginfun((struct Sap *)t1)),
 {
   tree arg3 = ginarg2((struct Sap *)t2);
   id id1 = gident(ginfun((struct Sap *)t1)),
@@ -633,6 +683,8 @@ ineg(i)
   return(p);
 }
 
   return(p);
 }
 
+#if 0
+/* UNUSED: at the moment */
 void
 checkmodname(import,interface)
   id import, interface;
 void
 checkmodname(import,interface)
   id import, interface;
@@ -644,6 +696,7 @@ checkmodname(import,interface)
       hsperror(errbuf);
     }
 }
       hsperror(errbuf);
     }
 }
+#endif /* 0 */
 
 /*
   Check the ordering of declarations in a cbody.
 
 /*
   Check the ordering of declarations in a cbody.
@@ -661,7 +714,7 @@ checkorder(decls)
   checkorder2(decls,TRUE);
 }
 
   checkorder2(decls,TRUE);
 }
 
-BOOLEAN
+static BOOLEAN
 checkorder2(decls,sigs)
   binding decls;
   BOOLEAN sigs;
 checkorder2(decls,sigs)
   binding decls;
   BOOLEAN sigs;
@@ -681,7 +734,7 @@ checkorder2(decls,sigs)
 }
 
 
 }
 
 
-BOOLEAN
+static BOOLEAN
 checksig(sig,decl)
   BOOLEAN sig;
   binding decl;
 checksig(sig,decl)
   BOOLEAN sig;
   binding decl;
index dd8715d..decf7e3 100644 (file)
@@ -61,7 +61,12 @@ type tree;
        qual    : < gqpat       : tree;
                    gqexp       : tree; >;
        guard   : < ggexp       : tree; >;
        qual    : < gqpat       : tree;
                    gqexp       : tree; >;
        guard   : < ggexp       : tree; >;
-       def     : < ggdef       : tree; >;
+       def     : < ggdef       : tree; >; /* unused, I believe WDP 95/08 */
+/* "tinfixop" is an odd bird:
+    we clobber its tag into another "tree", thus marking
+    that tree as infixery.  We do not create tinfixops 
+    per se. (WDP 95/08)
+*/
        tinfixop: < gdummy      : infixTree; >;
        lsection: < glsexp      : tree; 
                    glsop       : unkId; >;
        tinfixop: < gdummy      : infixTree; >;
        lsection: < glsexp      : tree; 
                    glsop       : unkId; >;
index 185dc64..1be4394 100644 (file)
@@ -15,7 +15,7 @@
 /*  Imported Values */
 extern list Lnil;
 
 /*  Imported Values */
 extern list Lnil;
 
-VOID is_context_format PROTO((ttype)); /* forward */
+static void is_context_format PROTO((ttype)); /* forward */
 
 /* 
     partain: see also the comment by "decl" in hsparser.y.
 
 /* 
     partain: see also the comment by "decl" in hsparser.y.
@@ -102,7 +102,7 @@ type2context(t)
 /* is_context_format is the same as "type2context" except that it just performs checking */
 /* ttype is either "tycon" [class] or "tycon (named)tvar" [class var] */
 
 /* is_context_format is the same as "type2context" except that it just performs checking */
 /* ttype is either "tycon" [class] or "tycon (named)tvar" [class var] */
 
-VOID
+static void
 is_context_format(t)
   ttype t;
 {
 is_context_format(t)
   ttype t;
 {
index 5f72496..7245626 100644 (file)
@@ -56,14 +56,17 @@ int minAcceptablePragmaVersion = 5;  /* 0.26 or greater ONLY */
 int maxAcceptablePragmaVersion = 5;  /* 0.26+ */
 int thisIfacePragmaVersion = 0;
 
 int maxAcceptablePragmaVersion = 5;  /* 0.26+ */
 int thisIfacePragmaVersion = 0;
 
-char   *input_file_dir;        /* The directory where the input file is.        */
+static char *input_file_dir; /* The directory where the input file is. */
 
 char HiSuffix[64] = ".hi";             /* can be changed with -h flag */
 char PreludeHiSuffix[64] = ".hi";      /* can be changed with -g flag */
 
 
 char HiSuffix[64] = ".hi";             /* can be changed with -h flag */
 char PreludeHiSuffix[64] = ".hi";      /* can be changed with -g flag */
 
-BOOLEAN ExplicitHiSuffixGiven = 0;
+/* OLD 95/08: BOOLEAN ExplicitHiSuffixGiven = 0; */
 static BOOLEAN verbose = FALSE;                /* Set for verbose messages. */
 
 static BOOLEAN verbose = FALSE;                /* Set for verbose messages. */
 
+/* Forward decls */
+static void who_am_i PROTO((void));
+
 /**********************************************************************
 *                                                                     *
 *                                                                     *
 /**********************************************************************
 *                                                                     *
 *                                                                     *
@@ -116,7 +119,7 @@ process_args(argc,argv)
 
            case 'h':
                    strcpy(HiSuffix, *argv+1);
 
            case 'h':
                    strcpy(HiSuffix, *argv+1);
-                   ExplicitHiSuffixGiven = 1;
+/*OLD 95/08:       ExplicitHiSuffixGiven = 1; */
                    keep_munging_option = FALSE;
                    break;
 
                    keep_munging_option = FALSE;
                    break;
 
@@ -228,8 +231,8 @@ error(s)
        exit(1);
 }
 
        exit(1);
 }
 
-void
-who_am_i()
+static void
+who_am_i(void)
 {
   fprintf(stderr,"Glasgow Haskell parser, version %s\n", PARSER_VERSION);
 }
 {
   fprintf(stderr,"Glasgow Haskell parser, version %s\n", PARSER_VERSION);
 }
@@ -258,9 +261,7 @@ lconc(l1, l2)
 }
 
 list
 }
 
 list
-lapp(l1, l2)
-  list l1;
-  VOID_STAR l2;
+lapp(list l1, VOID_STAR l2)
 {
        list t;
 
 {
        list t;
 
index e43303e..3b5b2ed 100644 (file)
@@ -34,14 +34,14 @@ extern list sys_imports_dirlist;
 extern char HiSuffix[];
 extern char PreludeHiSuffix[];
 
 extern char HiSuffix[];
 extern char PreludeHiSuffix[];
 
-extern void process_args PROTO((int, char **));
+void process_args PROTO((int, char **));
 
 /* end of util.c stuff */
 
 
 /* end of util.c stuff */
 
-extern list mklcons    PROTO((void *h, list t)); /* if we have PROTO, we have "void *" */
-extern list lapp       PROTO((list l1, void *l2));
-extern list lconc      PROTO((list l1, list l2));
-extern list mktruecase PROTO((tree t));
+list mklcons   PROTO((void *h, list t)); /* if we have PROTO, we have "void *" */
+list lapp      PROTO((list l1, void *l2));
+list lconc     PROTO((list l1, list l2));
+list mktruecase        PROTO((tree t));
 
 #define lsing(l) mklcons(l, Lnil)              /* Singleton Lists */
 #define ldub(l1, l2) mklcons(l1, lsing(l2))    /* Two-element Lists */
 
 #define lsing(l) mklcons(l, Lnil)              /* Singleton Lists */
 #define ldub(l1, l2) mklcons(l1, lsing(l2))    /* Two-element Lists */
@@ -50,91 +50,90 @@ extern list mktruecase      PROTO((tree t));
 #define SAMEFN samefn[icontexts]
 #define PREVPATT prevpatt[icontexts]
 
 #define SAMEFN samefn[icontexts]
 #define PREVPATT prevpatt[icontexts]
 
-extern tree *Rginfun PROTO((struct Sap *));
-extern tree *Rginarg1 PROTO((struct Sap *));
-extern tree *Rginarg2 PROTO((struct Sap *));
+tree *Rginfun PROTO((struct Sap *));
+tree *Rginarg1 PROTO((struct Sap *));
+tree *Rginarg2 PROTO((struct Sap *));
 
 #define ginfun(xx) *Rginfun(xx)
 #define ginarg1(xx) *Rginarg1(xx)
 #define ginarg2(xx) *Rginarg2(xx)
 
 
 #define ginfun(xx) *Rginfun(xx)
 #define ginarg1(xx) *Rginarg1(xx)
 #define ginarg2(xx) *Rginarg2(xx)
 
-extern id installid PROTO((char *));              /* Create a new identifier */
-extern hstring installHstring PROTO((int, char *)); /* Create a new literal string */
+id installid PROTO((char *));             /* Create a new identifier */
+hstring installHstring PROTO((int, char *)); /* Create a new literal string */
 
 
-extern id install_literal PROTO((char *));
-extern char    *id_to_string PROTO((id));
+id     install_literal PROTO((char *));
+char   *id_to_string PROTO((id));
 
 
-extern struct infix *infixlookup();
+struct infix *infixlookup PROTO((id));
 
 /* partain additions */
 
 
 /* partain additions */
 
-extern char    *xmalloc PROTO((unsigned)); /* just a GNU-style error-checking malloc */
-extern int      printf  PROTO((const char *, ...));
-extern int      fprintf PROTO((FILE *, const char *, ...));
-/*varies (sun/alpha): extern int        fputc   PROTO((char, FILE *)); */
-extern int      fputs   PROTO((const char *, FILE *));
-extern int      sscanf  PROTO((const char *, const char *, ...));
-extern long     strtol  PROTO((const char *, char **, int));
-extern size_t   fread   PROTO((void *, size_t, size_t, FILE *));
-extern int      fclose  PROTO((FILE *));
-extern int      isatty  PROTO((int));
+char   *xmalloc PROTO((unsigned)); /* just a GNU-style error-checking malloc */
+int     printf  PROTO((const char *, ...));
+int     fprintf PROTO((FILE *, const char *, ...));
+/*varies (sun/alpha): int fputc   PROTO((char, FILE *)); */
+int     fputs   PROTO((const char *, FILE *));
+int     sscanf  PROTO((const char *, const char *, ...));
+long    strtol  PROTO((const char *, char **, int));
+size_t  fread   PROTO((void *, size_t, size_t, FILE *));
+int     fclose  PROTO((FILE *));
+int     isatty  PROTO((int));
 /*extern ???       _filbuf */
 /*extern ???    _flsbuf */
 
 /*extern ???       _filbuf */
 /*extern ???    _flsbuf */
 
-extern void     format_string PROTO((FILE *, unsigned char *, int));
-extern tree     mkbinop PROTO((char *, tree, tree));
-extern tree     mkinfixop PROTO((char *, tree, tree));
-extern list     type2context PROTO((ttype));
-extern pbinding  createpat PROTO((list, binding));
-extern void     process_args PROTO((int, char **));
-extern void     hash_init PROTO((void));
-extern void     print_hash_table PROTO((void));
-extern long int         hash_index PROTO((id));
-extern void     yyinit PROTO((void));
-extern int      yyparse PROTO((void));
-extern int      yylex PROTO((void));
-extern void     setyyin PROTO((char *));
-extern void     yyerror PROTO((char *));
-extern void     error PROTO((char *));
-extern void     hsperror PROTO((char *));
-extern void     enteriscope PROTO((void));
-extern void     exposeis PROTO((void));
-extern void     makeinfix PROTO((id, int, int));
-extern int      nfixes PROTO((void));
-extern long int         precedence PROTO((int));
-extern int      pprecedence PROTO((struct infix *));
-extern void     rearrangeprec PROTO((tree, tree));
-extern int      pfixity PROTO((struct infix *));
-extern void     hsincindent PROTO((void));
-extern void     hssetindent PROTO((void));
-extern void     hsentercontext PROTO((int));
-extern void     hsendindent PROTO((void));
-extern void     hsindentoff PROTO((void));
-
-extern int      checkfixity PROTO((char *));
-extern void     checksamefn PROTO((char *));
-extern void     checkcontext PROTO((list));
-extern void     checkinpat PROTO((void));
-extern void     checkpatt PROTO((tree));
-extern BOOLEAN  lhs_is_patt PROTO((tree));
-extern tree     function PROTO((tree));
-extern void     checkconap PROTO((tree, tree));
-extern void     extendfn PROTO((binding, binding));
-extern void     precparse PROTO((tree));
-extern void     checkorder PROTO((binding));
-extern BOOLEAN  checkorder2 PROTO((binding, BOOLEAN));
-extern BOOLEAN  checksig PROTO((BOOLEAN, binding));
-extern void     checkprec PROTO((tree, id, BOOLEAN));
-extern BOOLEAN  isconstr PROTO((char *));
-extern void     setstartlineno PROTO((void));
-extern void     pprogram PROTO((tree));
-extern void     who_am_i PROTO((void));
-extern void     new_filename PROTO((char *));
-extern int      Return PROTO((int));
+void    format_string PROTO((FILE *, unsigned char *, int));
+tree    mkbinop PROTO((char *, tree, tree));
+tree    mkinfixop PROTO((char *, tree, tree));
+list    type2context PROTO((ttype));
+pbinding createpat PROTO((list, binding));
+void    process_args PROTO((int, char **));
+void    hash_init PROTO((void));
+void    print_hash_table PROTO((void));
+long int hash_index PROTO((id));
+void    yyinit PROTO((void));
+int     yyparse PROTO((void));
+int     yylex PROTO((void));
+void    setyyin PROTO((char *));
+void    yyerror PROTO((char *));
+void    error PROTO((char *));
+void    hsperror PROTO((char *));
+void    enteriscope PROTO((void));
+void    exposeis PROTO((void));
+void    makeinfix PROTO((id, int, int));
+int     nfixes PROTO((void));
+long int precedence PROTO((int));
+int     pprecedence PROTO((struct infix *));
+int     pfixity PROTO((struct infix *));
+void    pprogram PROTO((tree));
+void    hsincindent PROTO((void));
+void    hssetindent PROTO((void));
+void    hsendindent PROTO((void));
+void    hsindentoff PROTO((void));
+
+int     checkfixity PROTO((char *));
+void    checksamefn PROTO((char *));
+void    checkinpat PROTO((void));
+
+void    patternOrExpr PROTO((int,tree));
+/* the "int" arg says what we want; it is one of: */
+#define LEGIT_PATT 1
+#define LEGIT_EXPR 2
+
+BOOLEAN        lhs_is_patt PROTO((tree));
+tree   function PROTO((tree));
+void   extendfn PROTO((binding, binding));
+void   precparse PROTO((tree));
+void   checkorder PROTO((binding));
+void   checkprec PROTO((tree, id, BOOLEAN));
+BOOLEAN        isconstr PROTO((char *));
+void   setstartlineno PROTO((void));
+void   find_module_on_imports_dirlist PROTO((char *, BOOLEAN, char *));
+char   *fixop PROTO((int));
+char   *fixtype PROTO((int));
 
 /* mattson additions */
 
 /* mattson additions */
-extern char *xstrdup PROTO((char *));          /* Duplicate a string */
-extern char *xstrndup PROTO((char *, unsigned));/* Duplicate a substring */
-extern char *xrealloc PROTO((char *, unsigned));/* Re-allocate a string */
+char *xstrdup PROTO((char *));           /* Duplicate a string */
+char *xstrndup PROTO((char *, unsigned)); /* Duplicate a substring */
+char *xrealloc PROTO((char *, unsigned)); /* Re-allocate a string */
 
 #endif /* __UTILS_H */
 
 #endif /* __UTILS_H */
similarity index 100%
rename from ANNOUNCE-0.26
rename to ghc/docs/ANNOUNCE-0.26
diff --git a/ghc/docs/ANNOUNCE-0.27 b/ghc/docs/ANNOUNCE-0.27
new file mode 100644 (file)
index 0000000..843b3e2
--- /dev/null
@@ -0,0 +1,72 @@
+A binary-only from-working-sources no-guarantees snapshot of the
+Glasgow Haskell compiler (GHC) for i386-unknown-linuxaout and
+i386-unknown-solaris2 platforms is now available from
+ftp://ftp.dcs.glasgow.ac.uk/pub/haskell/glasgow/ghc-0.27-<platform>.tar.gz.
+(The files ghc-0.26-docs-and-examples.tar.gz and
+ghc-0.26-ps-docs.tar.gz [PostScript] may also be of interest.)
+
+This pseudo-release adds profiling and concurrent-Haskell support for
+i386-*-linuxaout.  It is the first GHC that works on i386-*-solaris2
+machines (sequential, profiling, and concurrent support provided).
+
+As 0.27 is a snapshot and not a "proper" release, it may have serious,
+show-stopping bugs in it.  If you *need* what 0.27 provides, use it;
+otherwise, you should stick with 0.26.
+
+It should be relatively straightforward to tweak
+ghc/driver/ghc-asm.(l)prl to support Linux ELF format; ditto for other
+Unices on x86 platforms.  Please let us know if you make such changes.
+
+GCC 2.7.x is required; GCC 2.6.x will *not* work.
+
+Binaries (.o files and executables) produced by GHC 0.27 cannot be
+intermixed with those from GHC 0.26 or 0.25; you'll need to recompile
+everything.
+
+The -concurrent stuff *definitely* has at least one bug we haven't
+been able to catch.  Concurrent programs that show
+readily-reproducible buggy behavior would be most welcome.
+
+The profiling libraries for *solaris2 are huge, for reasons we don't
+understand.  If you need to scrap them for space reasons, see the end
+of the installation notes below.  Insights into the problem would also
+be most appreciated.
+
+Please report any bugs to glasgow-haskell-bugs@dcs.glasgow.ac.uk.
+
+Will Partain
+AQUA project (slave)
+
+Dated: 95/12/20
+
+=== INSTALLATION NOTES ==============================================
+
+Ignore the installation instructions in any documentation.  This is
+the stuff that applies for this distribution.
+
+Unpack the distribution.
+
+Move "ghc-0.27-<platform>" to wherever you like.
+
+Make a link to ghc-0.27-<platform>/ghc/driver/ghc, so that "ghc" will
+be in your PATH.
+
+Change the hardwired paths in ghc/driver/ghc and in
+ghc/utils/hscpp/hscpp to point to where things are on your system.
+(Also: ghc/utils/mkdependHS/mkdependHS, if you want to use it.)
+Notably: where "perl" is (first line of each script), where $TopPwd is
+(ghc script), where your gcc cpp ($OrigCpp) is (hscpp and mkdependHS
+scripts).  *Don't* set any environment variables to do this.
+
+GHC should then work.  Try "ghc -v" on something simple, to make sure
+it compiles and links a program correctly.
+
+If you don't want the profiling libraries (e.g., to save disk space), do:
+
+    cd ghc
+    rm runtime/*_p.a lib/*_p.a
+
+If you don't want to concurrent-Haskell libraries (e.g., same reason), do:
+
+    cd ghc
+    rm runtime/*_mc.a lib/*_mc.a
index 6bbeb25..799f3e0 100644 (file)
@@ -6,10 +6,11 @@
 #define NoInstallTargetForSubdirs
 #define NoTagTargetForSubdirs
 
 #define NoInstallTargetForSubdirs
 #define NoTagTargetForSubdirs
 
-SUBDIRS = add_to_compiler \
-         users_guide \
-         install_guide \
-         release_notes
+SUBDIRS = add_to_compiler      \
+         users_guide           \
+         install_guide         \
+         release_notes         \
+         state_interface
 
 XCOMM    developers_guide ?
 XCOMM    interfaces ?
 
 XCOMM    developers_guide ?
 XCOMM    interfaces ?
index 2e61e5a..4af96e6 100644 (file)
@@ -30,12 +30,12 @@ non-strict functional language'' \cite{peyton-jones91b}.
 
 The reader interested in the final code-generation parts of the
 compiler, from Core syntax to STG syntax\srcloc{stgSyn/CoreToStg.lhs}
 
 The reader interested in the final code-generation parts of the
 compiler, from Core syntax to STG syntax\srcloc{stgSyn/CoreToStg.lhs}
-to Abstract~C,\srcloc{codeGen/} should consult Peyton Jones's recent
+to Abstract~C\srcloc{codeGen/}, should consult Peyton Jones's recent
 paper, ``Implementing lazy functional languages on stock hardware: the
 Spineless Tagless G-machine'' \cite{peyton-jones92a}.
 
 Further note: We have found that the STG
 syntax\srcloc{stgSyn/StgSyn.lhs} is the better medium for a few
 paper, ``Implementing lazy functional languages on stock hardware: the
 Spineless Tagless G-machine'' \cite{peyton-jones92a}.
 
 Further note: We have found that the STG
 syntax\srcloc{stgSyn/StgSyn.lhs} is the better medium for a few
-transformations.\srcloc{stgSyn/SimplStg.lhs} This is fine---STG syntax
+transformations\srcloc{stgSyn/SimplStg.lhs}. This is fine---STG syntax
 is a just-as-manipulable functional language as Core syntax, even if
 it's a bit messier.
 is a just-as-manipulable functional language as Core syntax, even if
 it's a bit messier.
index 11b80d0..a5b8d09 100644 (file)
@@ -53,44 +53,41 @@ As we saw with the ``abstract syntax'' (in
 Section~\ref{sec:AbsSyntax}), the Core syntax is also {\em
 parameterised}, this time with respect to binders and bound-variables
 (or ``bindees'').  The definition of a Core expression
 Section~\ref{sec:AbsSyntax}), the Core syntax is also {\em
 parameterised}, this time with respect to binders and bound-variables
 (or ``bindees'').  The definition of a Core expression
-begins:\srcloc{coreSyn/CoreSyn.lhs}
-\begin{tightcode}
+begins\srcloc{coreSyn/CoreSyn.lhs}:
+\begin{mytightcode}
 data CoreExpr binder bindee
      = CoVar       bindee
      | CoLit       CoreLiteral
      ...
 type PlainCoreBinder = Id
 type PlainCoreBindee = Id
 data CoreExpr binder bindee
      = CoVar       bindee
      | CoLit       CoreLiteral
      ...
 type PlainCoreBinder = Id
 type PlainCoreBindee = Id
-type PlainCoreExpr = CoreExpr PlainCoreBinder PlainCoreBindee
-\end{tightcode}
+type PlainCoreExpr = CoreExpr PlainCoreBinder PlainCoreBindee\end{mytightcode}
 Most back-end passes use the parameterisation shown above, namely
 Most back-end passes use the parameterisation shown above, namely
-@PlainCoreExprs@,\srcloc{coreSyn/PlainCore.lhs} parameterised on @Id@
+@PlainCoreExprs@\srcloc{coreSyn/PlainCore.lhs}, parameterised on @Id@
 for both binders and bindees.
 
 An example of a pass that uses a different parameterisation is
 for both binders and bindees.
 
 An example of a pass that uses a different parameterisation is
-occurrence analysis,\srcloc{simplCore/OccurAnal.lhs} which gathers
+occurrence analysis\srcloc{simplCore/OccurAnal.lhs}, which gathers
 up info about the {\em occurrences} of bound variables.  It uses:
 up info about the {\em occurrences} of bound variables.  It uses:
-\begin{tightcode}
+\begin{mytightcode}
 data BinderInfo            {\dcd\rm-- various things to record about binders...}
 type TaggedBinder   tag = (Id, tag)
 type TaggedCoreExpr tag = CoreExpr (TaggedBinder tag) Id
 
 data BinderInfo            {\dcd\rm-- various things to record about binders...}
 type TaggedBinder   tag = (Id, tag)
 type TaggedCoreExpr tag = CoreExpr (TaggedBinder tag) Id
 
-substAnalyseExpr :: PlainCoreExpr -> TaggedCoreExpr BinderInfo
-\end{tightcode}
+substAnalyseExpr :: PlainCoreExpr -> TaggedCoreExpr BinderInfo\end{mytightcode}
 The pass's expression-mangling function then has the unsurprising type
 shown above.
 
 Core syntax has a ``twin'' datatype that is also sometimes useful:
 The pass's expression-mangling function then has the unsurprising type
 shown above.
 
 Core syntax has a ``twin'' datatype that is also sometimes useful:
-{\em annotated} Core syntax.\srcloc{coreSyn/AnnCoreSyn.lhs} This is a
+{\em annotated} Core syntax\srcloc{coreSyn/AnnCoreSyn.lhs}. This is a
 datatype identical in form to Core syntax, but such that every
 ``node'' of a Core expression can be annotated with some information
 of your choice.  As an example, the type of a pass that attaches a
 @Set@ of free variables to every subexpression in a Core expression
 datatype identical in form to Core syntax, but such that every
 ``node'' of a Core expression can be annotated with some information
 of your choice.  As an example, the type of a pass that attaches a
 @Set@ of free variables to every subexpression in a Core expression
-might be:\srcloc{coreSyn/FreeVars.lhs}
-\begin{tightcode}
+might be\srcloc{coreSyn/FreeVars.lhs}:
+\begin{mytightcode}
 freeVars :: PlainCoreExpr -> AnnCoreExpr Id Id (Set Id)
 freeVars :: PlainCoreExpr -> AnnCoreExpr Id Id (Set Id)
-       {\dcd\rm-- parameterised on binders, bindees, and annotation}
-\end{tightcode}
+       {\dcd\rm-- parameterised on binders, bindees, and annotation}\end{mytightcode}
 
 \subsection{Unboxing and other Core syntax details}
 \label{sec:unboxing}
 
 \subsection{Unboxing and other Core syntax details}
 \label{sec:unboxing}
index affd2fa..5c3c41d 100644 (file)
@@ -20,10 +20,10 @@ This is misleading in that what
 goes into the typechecker is quite different from what comes out.
 
 Let's first consider this fragment of the abstract-syntax
 goes into the typechecker is quite different from what comes out.
 
 Let's first consider this fragment of the abstract-syntax
-definition,\srcloc{abstractSyn/HsExpr.lhs} for Haskell explicit-list
+definition\srcloc{abstractSyn/HsExpr.lhs}, for Haskell explicit-list
 expressions (Haskell report, section~3.5
 \cite{hudak91a}):\nopagebreak[4]
 expressions (Haskell report, section~3.5
 \cite{hudak91a}):\nopagebreak[4]
-\begin{tightcode}
+\begin{mytightcode}
 data Expr var pat =
   ...
   | ExplicitList       [Expr var pat]
 data Expr var pat =
   ...
   | ExplicitList       [Expr var pat]
@@ -32,8 +32,7 @@ data Expr var pat =
 
 type ProtoNameExpr     = Expr ProtoName ProtoNamePat
 type RenamedExpr        = Expr Name RenamedPat
 
 type ProtoNameExpr     = Expr ProtoName ProtoNamePat
 type RenamedExpr        = Expr Name RenamedPat
-type TypecheckedExpr   = Expr Id TypecheckedPat
-\end{tightcode}
+type TypecheckedExpr   = Expr Id TypecheckedPat\end{mytightcode}
 an @ExplicitList@ appears only in typechecker input; an @ExplicitListOut@
 is the corresponding construct that appears
 only in the output, with the inferred type information attached.
 an @ExplicitList@ appears only in typechecker input; an @ExplicitListOut@
 is the corresponding construct that appears
 only in the output, with the inferred type information attached.
@@ -64,7 +63,7 @@ try @ghc -noC -ddump-tc Foo.hs@, to see what comes out of the typechecker.
 \subsubsection{Basic datatypes in the compiler}
 
 None of the internal datatypes in the example just given are
 \subsubsection{Basic datatypes in the compiler}
 
 None of the internal datatypes in the example just given are
-particularly interesting except @Ids@.\srcloc{basicTypes/Id.lhs} A
+particularly interesting except @Ids@\srcloc{basicTypes/Id.lhs}. A
 program variable, which enters the typechecker as a string, emerges as
 an @Id@.
 
 program variable, which enters the typechecker as a string, emerges as
 an @Id@.
 
@@ -77,19 +76,18 @@ Let us take a cursory look at @Ids@, as a representative example of
 these basic data types.  (Don't be too scared---@Ids@ are the hairiest
 entities in the whole compiler!)
 Here we go:
 these basic data types.  (Don't be too scared---@Ids@ are the hairiest
 entities in the whole compiler!)
 Here we go:
-\begin{tightcode}\codeallowbreaks{}
-data Id
+\begin{mytightcode}
+\codeallowbreaks{}data Id
   = Id Unique     {\dcd\rm-- key for fast comparison}
        UniType    {\dcd\rm-- Id's type; used all the time;}
        IdInfo     {\dcd\rm-- non-essential info about this Id;}
        PragmaInfo  {\dcd\rm-- user-specified pragmas about this Id;}
   = Id Unique     {\dcd\rm-- key for fast comparison}
        UniType    {\dcd\rm-- Id's type; used all the time;}
        IdInfo     {\dcd\rm-- non-essential info about this Id;}
        PragmaInfo  {\dcd\rm-- user-specified pragmas about this Id;}
-       IdDetails   {\dcd\rm-- stuff about individual kinds of Ids.}
-\end{tightcode}
+       IdDetails   {\dcd\rm-- stuff about individual kinds of Ids.}\end{mytightcode}
 
 So, every @Id@ comes with:
 \begin{enumerate}
 \item
 
 So, every @Id@ comes with:
 \begin{enumerate}
 \item
-A @Unique@,\srcloc{basicTypes/Unique.lhs} essentially a unique
+A @Unique@\srcloc{basicTypes/Unique.lhs}, essentially a unique
 @Int@, for fast comparison;
 \item
 A @UniType@ (more on them below... section~\ref{sec:UniType}) giving the variable's
 @Int@, for fast comparison;
 \item
 A @UniType@ (more on them below... section~\ref{sec:UniType}) giving the variable's
@@ -109,8 +107,8 @@ would be: that @Id@'s unfolding; or its arity.
 \end{enumerate}
 
 Then the fun begins with @IdDetails@...
 \end{enumerate}
 
 Then the fun begins with @IdDetails@...
-\begin{tightcode}\codeallowbreaks{}
-data IdDetails
+\begin{mytightcode}
+\codeallowbreaks{}data IdDetails
 
   {\dcd\rm---------------- Local values}
 
 
   {\dcd\rm---------------- Local values}
 
@@ -138,8 +136,7 @@ data IdDetails
 
   | TupleCon Int                        {\dcd\rm-- its arity}
 
 
   | TupleCon Int                        {\dcd\rm-- its arity}
 
-  {\dcd\rm-- There are quite a few more flavours of {\tt IdDetails}...}
-\end{tightcode}
+  {\dcd\rm-- There are quite a few more flavours of {\tt IdDetails}...}\end{mytightcode}
 
 % A @ShortName@,\srcloc{basicTypes/NameTypes.lhs} which includes a name string
 % and a source-line location for the name's binding occurrence;
 
 % A @ShortName@,\srcloc{basicTypes/NameTypes.lhs} which includes a name string
 % and a source-line location for the name's binding occurrence;
@@ -171,10 +168,10 @@ construct it just from the arity.
 \subsubsection{@UniTypes@, representing types in the compiler}
 \label{sec:UniType}
 
 \subsubsection{@UniTypes@, representing types in the compiler}
 \label{sec:UniType}
 
-Let us look further at @UniTypes@.\srcloc{uniType/} Their definition
+Let us look further at @UniTypes@\srcloc{uniType/}. Their definition
 is:
 is:
-\begin{tightcode}\codeallowbreaks{}
-data UniType
+\begin{mytightcode}
+\codeallowbreaks{}data UniType
   = UniTyVar    TyVar
 
   | UniFun      UniType                {\dcd\rm-- function type}
   = UniTyVar    TyVar
 
   | UniFun      UniType                {\dcd\rm-- function type}
@@ -194,8 +191,7 @@ data UniType
   | UniTyVarTemplate TyVarTemplate
 
   | UniForall   TyVarTemplate
   | UniTyVarTemplate TyVarTemplate
 
   | UniForall   TyVarTemplate
-               UniType
-\end{tightcode}
+               UniType\end{mytightcode}
 When the typechecker processes a source module, it adds @UniType@
 information to all the basic entities (e.g., @Ids@), among other
 places (see Section~\ref{sec:second-order} for more details).  These
 When the typechecker processes a source module, it adds @UniType@
 information to all the basic entities (e.g., @Ids@), among other
 places (see Section~\ref{sec:second-order} for more details).  These
@@ -205,13 +201,12 @@ The following example shows several things about @UniTypes@.
 If a programmer wrote @(Eq a) => a -> [a]@, it would be represented
 as:\footnote{The internal structures of @Ids@,
 @Classes@, @TyVars@, and @TyCons@ are glossed over here...}
 If a programmer wrote @(Eq a) => a -> [a]@, it would be represented
 as:\footnote{The internal structures of @Ids@,
 @Classes@, @TyVars@, and @TyCons@ are glossed over here...}
-\begin{tightcode}\codeallowbreaks{}
-UniForall {\dcd$\alpha$}
+\begin{mytightcode}
+\codeallowbreaks{}UniForall {\dcd$\alpha$}
       (UniFun (UniDict {\dcd\em Eq} (UniTyVar {\dcd$\alpha$}))
               (UniFun (UniTyVarTemplate {\dcd$\alpha$})
                       (UniData {\dcd\em listTyCon}
       (UniFun (UniDict {\dcd\em Eq} (UniTyVar {\dcd$\alpha$}))
               (UniFun (UniTyVarTemplate {\dcd$\alpha$})
                       (UniData {\dcd\em listTyCon}
-                              [UniTyVarTemplate {\dcd$\alpha$}])))
-\end{tightcode}
+                              [UniTyVarTemplate {\dcd$\alpha$}])))\end{mytightcode}
 From this example we see:
 \begin{itemize}
 \item
 From this example we see:
 \begin{itemize}
 \item
@@ -241,8 +236,8 @@ synonyms (@UniSyns@) keep both the unexpanded and expanded forms handy.
 about @Ids@ is now hidden in the
 @IdInfo@\srcloc{basicTypes/IdInfo.lhs} datatype.  It looks something
 like:
 about @Ids@ is now hidden in the
 @IdInfo@\srcloc{basicTypes/IdInfo.lhs} datatype.  It looks something
 like:
-\begin{tightcode}\codeallowbreaks{}
-data IdInfo
+\begin{mytightcode}
+\codeallowbreaks{}data IdInfo
   = NoIdInfo            {\dcd\rm-- OK, we know nothing...}
 
   | MkIdInfo
   = NoIdInfo            {\dcd\rm-- OK, we know nothing...}
 
   | MkIdInfo
@@ -259,8 +254,7 @@ data IdInfo
                         {\dcd\rm-- (used to match up workers/wrappers)}
       UnfoldingInfo     {\dcd\rm-- its unfolding}
       UpdateInfo        {\dcd\rm-- which args should be updated}
                         {\dcd\rm-- (used to match up workers/wrappers)}
       UnfoldingInfo     {\dcd\rm-- its unfolding}
       UpdateInfo        {\dcd\rm-- which args should be updated}
-      SrcLocation       {\dcd\rm-- source location of definition}
-\end{tightcode}
+      SrcLocation       {\dcd\rm-- source location of definition}\end{mytightcode}
 As you can see, we may accumulate a lot of information about an Id!
 (The types for all the sub-bits are given in the same place...)
 
 As you can see, we may accumulate a lot of information about an Id!
 (The types for all the sub-bits are given in the same place...)
 
@@ -286,15 +280,14 @@ Much of the abstract-syntax datatypes are given
 over to output-only translation machinery.  Here are a few more
 fragments of the @Expr@ type, all of which appear only in typechecker
 output:
 over to output-only translation machinery.  Here are a few more
 fragments of the @Expr@ type, all of which appear only in typechecker
 output:
-\begin{tightcode}
+\begin{mytightcode}
 data Expr var pat =
   ...
   | DictLam    [DictVar]       (Expr var pat)
   | DictApp    (Expr var pat)  [DictVar]
   | Dictionary [DictVar]       [Id]
   | SingleDict DictVar
 data Expr var pat =
   ...
   | DictLam    [DictVar]       (Expr var pat)
   | DictApp    (Expr var pat)  [DictVar]
   | Dictionary [DictVar]       [Id]
   | SingleDict DictVar
-  ...
-\end{tightcode}
+  ...\end{mytightcode}
 You needn't worry about this stuff:
 After the desugarer gets through with such constructs, there's nothing
 left but @Ids@, tuples, tupling functions, etc.,---that is, ``plain
 You needn't worry about this stuff:
 After the desugarer gets through with such constructs, there's nothing
 left but @Ids@, tuples, tupling functions, etc.,---that is, ``plain
index c5dfcf6..ab52723 100644 (file)
@@ -44,9 +44,9 @@ at least a veneer of uniformity.
 
 \item
 To hook your pass into the compiler, either add something directly to
 
 \item
 To hook your pass into the compiler, either add something directly to
-the @Main@ module of the compiler,\srcloc{main/Main.lhs} or into the
-Core-to-Core simplification driver,\srcloc{simplCore/SimplCore.lhs} or
-into the STG-to-STG driver.\srcloc{simplStg/SimplStg.lhs}
+the @Main@ module of the compiler\srcloc{main/Main.lhs}, or into the
+Core-to-Core simplification driver\srcloc{simplCore/SimplCore.lhs}, or
+into the STG-to-STG driver\srcloc{simplStg/SimplStg.lhs}.
 
 Also add something to the compilation-system
 driver\srcloc{ghc/driver/ghc.lprl}
 
 Also add something to the compilation-system
 driver\srcloc{ghc/driver/ghc.lprl}
@@ -97,26 +97,26 @@ We encourage you to use a monadic style, where appropriate, in
 the code you add to the compiler.  To this end, here is a list of
 monads already in use in the compiler:
 \begin{description}
 the code you add to the compiler.  To this end, here is a list of
 monads already in use in the compiler:
 \begin{description}
-\item[@UniqueSupply@ monad:] \srcloc{basicTypes/Unique.lhs}
+\item[@UniqueSupply@ monad:]\srcloc{basicTypes/Unique.lhs}%
 To carry a name supply around; do a @getUnique@ when you
 need one.  Used in several parts of the compiler.
 
 To carry a name supply around; do a @getUnique@ when you
 need one.  Used in several parts of the compiler.
 
-\item[Typechecker monad:] \srcloc{typecheck/TcMonad.lhs}
+\item[Typechecker monad:]\srcloc{typecheck/TcMonad.lhs}%
 Quite a complicated monad; carries around a substitution, some
 source-location information, and a @UniqueSupply@; also plumbs
 typechecker success/failure back up to the right place.
 
 Quite a complicated monad; carries around a substitution, some
 source-location information, and a @UniqueSupply@; also plumbs
 typechecker success/failure back up to the right place.
 
-\item[Desugarer monad:] \srcloc{deSugar/DsMonad.lhs}
+\item[Desugarer monad:]\srcloc{deSugar/DsMonad.lhs}%
 Carries around a @UniqueSupply@ and source-location information (to
 put in pattern-matching-failure error messages).
 
 Carries around a @UniqueSupply@ and source-location information (to
 put in pattern-matching-failure error messages).
 
-\item[Code-generator monad:] \srcloc{codeGen/CgMonad.lhs}
+\item[Code-generator monad:]\srcloc{codeGen/CgMonad.lhs}%
 Carries around an environment that maps variables to addressing modes
 (e.g., ``in this block, @f@ is at @Node@ offset 3''); also, carries
 around stack- and heap-usage information.  Quite tricky plumbing, in
 part so that the ``Abstract~C'' output will be produced lazily.
 
 Carries around an environment that maps variables to addressing modes
 (e.g., ``in this block, @f@ is at @Node@ offset 3''); also, carries
 around stack- and heap-usage information.  Quite tricky plumbing, in
 part so that the ``Abstract~C'' output will be produced lazily.
 
-\item[Monad for underlying I/O machinery:] \srcloc{ghc/lib/io/GlaIOMonad.lhs}
+\item[Monad for underlying I/O machinery:]\srcloc{ghc/lib/io/GlaIOMonad.lhs}%
 This is the basis of our I/O implementation.  See the paper about it
 \cite{peyton-jones92b}.
 \end{description}
 This is the basis of our I/O implementation.  See the paper about it
 \cite{peyton-jones92b}.
 \end{description}
@@ -265,30 +265,32 @@ various ways in which the program text is represented as it makes its
 way through the compiler.  These are notable in that you are allowed
 to see/make-use-of all of their constructors:
 \begin{description}
 way through the compiler.  These are notable in that you are allowed
 to see/make-use-of all of their constructors:
 \begin{description}
-\item[Prefix form:]\srcloc{reader/PrefixSyn.lhs}  You shouldn't need
-this. 
+\item[Prefix form:]\srcloc{reader/PrefixSyn.lhs}%
+You shouldn't need this. 
 
 
-\item[Abstract Haskell syntax:]\srcloc{abstractSyn/AbsSyn.lhs}  Access
-via the @AbsSyn@ interface.  An example of what you should {\em not}
+\item[Abstract Haskell syntax:]\srcloc{abstractSyn/AbsSyn.lhs}%
+Access via the @AbsSyn@ interface.  An example of what you should {\em not}
 do is import the @AbsSynFuns@ (or @HsBinds@ or ...) interface
 directly.  @AbsSyn@ tells you what you're supposed to see.
 
 do is import the @AbsSynFuns@ (or @HsBinds@ or ...) interface
 directly.  @AbsSyn@ tells you what you're supposed to see.
 
-\item[Core syntax:]\srcloc{coreSyn/*Core.lhs}  Core syntax is
-parameterised, and you should access it {\em via one of the
+\item[Core syntax:]\srcloc{coreSyn/*Core.lhs}%
+Core syntax is parameterised, and you should access it {\em via one of the
 parameterisations}.  The most common is @PlainCore@; another is
 @TaggedCore@.  Don't use @CoreSyn@, though.
 
 parameterisations}.  The most common is @PlainCore@; another is
 @TaggedCore@.  Don't use @CoreSyn@, though.
 
-\item[STG syntax:]\srcloc{stgSyn/StgSyn.lhs} Access via the @StgSyn@ interface.
+\item[STG syntax:]\srcloc{stgSyn/StgSyn.lhs}%
+Access via the @StgSyn@ interface.
 
 
-\item[Abstract~C syntax:]\srcloc{absCSyn/AbsCSyn.lhs} Access via the
-@AbsCSyn@ interface.
+\item[Abstract~C syntax:]\srcloc{absCSyn/AbsCSyn.lhs}%
+Access via the @AbsCSyn@ interface.
 \end{description}
 
 The second major group of datatypes are the ``basic entity''
 datatypes; these are notable in that you don't need to know their
 representation to use them.  Several have already been mentioned:
 \begin{description}
 \end{description}
 
 The second major group of datatypes are the ``basic entity''
 datatypes; these are notable in that you don't need to know their
 representation to use them.  Several have already been mentioned:
 \begin{description}
-\item[UniTypes:]\srcloc{uniType/AbsUniType.lhs} This is a gigantic
+\item[UniTypes:]\srcloc{uniType/AbsUniType.lhs}%
+This is a gigantic
 interface onto the world of @UniTypes@; accessible via the
 @AbsUniType@ interface.  You should import operations on all the {\em
 pieces} of @UniTypes@ (@TyVars@, @TyVarTemplates@, @TyCons@,
 interface onto the world of @UniTypes@; accessible via the
 @AbsUniType@ interface.  You should import operations on all the {\em
 pieces} of @UniTypes@ (@TyVars@, @TyVarTemplates@, @TyCons@,
@@ -299,12 +301,13 @@ pieces} of @UniTypes@ (@TyVars@, @TyVarTemplates@, @TyCons@,
 behind @AbsUniType@'s back!}  (Otherwise, we won't discover the
 shortcomings of the interface...)
 
 behind @AbsUniType@'s back!}  (Otherwise, we won't discover the
 shortcomings of the interface...)
 
-\item[Identifiers:]\srcloc{basicTypes/Id.lhs}  Interface: @Id@.
+\item[Identifiers:]\srcloc{basicTypes/Id.lhs}%
+Interface: @Id@.
 
 
-\item[``Core'' literals:]\srcloc{basicTypes/CoreLit.lhs}  These are
-the unboxed literals used in Core syntax onwards.  Interface: @CoreLit@.
+\item[``Core'' literals:]\srcloc{basicTypes/CoreLit.lhs}%
+These are the unboxed literals used in Core syntax onwards.  Interface: @CoreLit@.
 
 
-\item[Environments:]\srcloc{envs/GenericEnv.lhs}
+\item[Environments:]\srcloc{envs/GenericEnv.lhs}%
 A generic environment datatype, plus a generally useful set of
 operations, is provided via the @GenericEnv@ interface.  We encourage
 you to use this, rather than roll your own; then your code will
 A generic environment datatype, plus a generally useful set of
 operations, is provided via the @GenericEnv@ interface.  We encourage
 you to use this, rather than roll your own; then your code will
@@ -312,13 +315,14 @@ benefit when we speed up the generic code.  All of the typechecker's
 environment stuff (of which there is plenty) is built on @GenericEnv@,
 so there are plenty of examples to follow.
 
 environment stuff (of which there is plenty) is built on @GenericEnv@,
 so there are plenty of examples to follow.
 
-\item[@Uniques@:]\srcloc{basicTypes/Unique.lhs} Essentially @Ints@.
+\item[@Uniques@:]\srcloc{basicTypes/Unique.lhs}%
+Essentially @Ints@.
 When you need something unique for fast comparisons.  Interface:
 @Unique@.  This interface also provides a simple @UniqueSupply@ monad;
 often just the thing...
 
 When you need something unique for fast comparisons.  Interface:
 @Unique@.  This interface also provides a simple @UniqueSupply@ monad;
 often just the thing...
 
-\item[Wired-in standard prelude knowledge:]\srcloc{prelude/} The
-compiler has to know a lot about the standard prelude.  What it knows
+\item[Wired-in standard prelude knowledge:]\srcloc{prelude/}%
+The compiler has to know a lot about the standard prelude.  What it knows
 is in the @compiler/prelude@ directory; all the rest of the compiler
 gets its prelude knowledge through the @AbsPrel@ interface.
 
 is in the @compiler/prelude@ directory; all the rest of the compiler
 gets its prelude knowledge through the @AbsPrel@ interface.
 
index 32e0c4a..73f51c4 100644 (file)
@@ -24,12 +24,12 @@ Figure~\ref{fig:overview}, respectively.
 
 The front end, discussed further in Section~\ref{sec:front-end}, is
 the part that may report errors back to the user.  The two main pieces
 
 The front end, discussed further in Section~\ref{sec:front-end}, is
 the part that may report errors back to the user.  The two main pieces
-are a {\em renamer},\srcloc{renamer/} which handles naming issues,
+are a {\em renamer}\srcloc{renamer/}, which handles naming issues,
 including support of the Haskell module system, and the {\em
 including support of the Haskell module system, and the {\em
-typechecker}.\srcloc{typecheck/}
+typechecker}\srcloc{typecheck/}.
 
 The front end operates on a collection of data types that we call
 
 The front end operates on a collection of data types that we call
-``abstract syntax.''\srcloc{abstractSyn/}  These types
+``abstract syntax\srcloc{abstractSyn/}.''  These types
 match the Haskell language, construct for construct.  For example,
 if you write @... [ x | x <- [1..n] ] ...@, the typechecker
 will actually see something like:
 match the Haskell language, construct for construct.  For example,
 if you write @... [ x | x <- [1..n] ] ...@, the typechecker
 will actually see something like:
@@ -48,7 +48,7 @@ lucidly, in terms of the original program text.
 A conventional desugaring pass\srcloc{deSugar/} (basically Wadler's
 Chapter~5 of Peyton Jones's 1987 implementation book
 \cite{peyton-jones87b}) converts the typechecker's abstract-syntax output
 A conventional desugaring pass\srcloc{deSugar/} (basically Wadler's
 Chapter~5 of Peyton Jones's 1987 implementation book
 \cite{peyton-jones87b}) converts the typechecker's abstract-syntax output
-(with types attached) into the ``CoreSyntax''\srcloc{coreSyn/} data
+(with types attached) into the ``CoreSyntax\srcloc{coreSyn/}'' data
 type.  This data type is little more than the second-order polymorphic
 lambda calculus and is intended to be the {\em lingua franca} of the
 compiler's back end, including almost all of the optimisation passes.
 type.  This data type is little more than the second-order polymorphic
 lambda calculus and is intended to be the {\em lingua franca} of the
 compiler's back end, including almost all of the optimisation passes.
@@ -63,7 +63,7 @@ after the intended Spineless Tagless G-machine\footnote{Oops!  Make
 that ``shared term graph'' language!  (Who's fooling who here,
 Simon?)} target architecture), then some STG-to-STG transformations,
 and finally out of the functional world\srcloc{codeGen/} into
 that ``shared term graph'' language!  (Who's fooling who here,
 Simon?)} target architecture), then some STG-to-STG transformations,
 and finally out of the functional world\srcloc{codeGen/} into
-``Abstract~C,''\srcloc{absCSyn/} a datatype intended as an adequate
+``Abstract~C\srcloc{absCSyn/},'' a datatype intended as an adequate
 launching pad into both portable C and into get-your-hands-{\em
 really}-dirty native-code generation for a particular instruction-set
 architecture.  We can generate C, or native-code for SPARCs and DEC
 launching pad into both portable C and into get-your-hands-{\em
 really}-dirty native-code generation for a particular instruction-set
 architecture.  We can generate C, or native-code for SPARCs and DEC
index 39a82c6..e125426 100644 (file)
 %
 \newcommand{\onlyIfSrcLocs}[1]{#1}
 %
 %
 \newcommand{\onlyIfSrcLocs}[1]{#1}
 %
+% Aran Lunzer told me to do this magic:
+\def\mytightcode{\codeaux{\leftmargin=0pt}}%
+\let\endmytightcode\endcodeaux
+% what he told me:
+%% CODE environment
+%% ----------------
+%% To get a single line of spacing above and below a code segment, with
+%% zero added indention (like a verbatim environment), and consistent appearance
+%% whether or not you use \codeallowbreaks:
+%% 
+%%     \def\code{\codeaux{\leftmargin=0pt}}
+%% 
+%% Then for a normal, unbreakable section:
+%% 
+%%     \begin{code}
+%%     first line of code
+%%     ...
+%%     last line of code\end{code}
+%% 
+%% And for a breakable section:
+%% 
+%%     \begin{code}
+%%     \codeallowbreaks{}first line of code
+%%     ...
+%%     last line of code\end{code}
+%% 
+%% 
+%% srcloc marginpars
+%% -----------------
+%% 
+%% To ensure that marginpars appear on the same line as their associated text,
+%% especially in a description list, add a \mbox{} to their definition:
+%% 
+%%     \renewcommand{\srcloc}[1]{\mbox{}\marginpar{\footnotesize\tt #1}}
+%% 
+%% This empty mbox doesn't introduce anything visible, but can screw up your
+%% spacing unless you are careful.  So...
+%% 
+%% Usage in a description list:
+%% 
+%%     \item[item description:]\srcloc{no spaces around!}%
+%%     Here is the item text.
+%% 
+%% In the middle of a sentence:
+%% 
+%%     And now for something\srcloc{completely} different.
+%% 
+%% Near a period or colon (MUST come before the punctuation):
+%% 
+%%     Hello, good evening, and welcome\srcloc{foo}.  Here is the fnord.
+%
 \begin{document}
 \title{How to Add an Optimisation Pass\\
 to the Glasgow Haskell compiler\\
 \begin{document}
 \title{How to Add an Optimisation Pass\\
 to the Glasgow Haskell compiler\\
@@ -58,7 +109,7 @@ directories.  We assume you already know Haskell.}
 
 Besides the documents listed in the References below, there are
 several internal compiler documents that come with the GHC
 
 Besides the documents listed in the References below, there are
 several internal compiler documents that come with the GHC
-distribution.\srcloc{ghc/docs/README}
+distribution\srcloc{ghc/docs/README}.
 
 If you are hacking GHC, you should be on the @glasgow-haskell-users@
 mailing list.  Send mail to
 
 If you are hacking GHC, you should be on the @glasgow-haskell-users@
 mailing list.  Send mail to
index 920783a..4e2cf15 100644 (file)
@@ -50,7 +50,7 @@
 %*                                                             *
 %****************************************************************
 
 %*                                                             *
 %****************************************************************
 
-\newcommand{\srcloc}[1]{\marginpar{\footnotesize\tt #1}}
+\newcommand{\srcloc}[1]{\mbox{}\marginpar{\footnotesize\tt #1}}
 %
 % to avoid src-location marginpars, put this in your doc's pre-amble.
 %\renewcommand{\srcloc}[1]{}
 %
 % to avoid src-location marginpars, put this in your doc's pre-amble.
 %\renewcommand{\srcloc}[1]{}
diff --git a/ghc/docs/state_interface/Jmakefile b/ghc/docs/state_interface/Jmakefile
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/ghc/docs/state_interface/state-interface.verb b/ghc/docs/state_interface/state-interface.verb
new file mode 100644 (file)
index 0000000..3767205
--- /dev/null
@@ -0,0 +1,1046 @@
+\documentstyle[a4wide,grasp]{article}
+\renewcommand{\textfraction}{0.1}
+\renewcommand{\floatpagefraction}{0.9}
+\renewcommand{\dblfloatpagefraction}{0.9}
+
+\sloppy
+
+
+\begin{document}
+
+\title{GHC prelude: types and operations}
+\author{Simon L Peyton Jones \and John Launchbury \and Will Partain}
+
+\maketitle
+\tableofcontents
+
+This ``state interface document'' corresponds to Glasgow Haskell
+version~0.23.
+
+\section{Really primitive stuff}
+
+This section defines all the types which are primitive in Glasgow Haskell, and the
+operations provided for them.
+
+A primitive type is one which cannot be defined in Haskell, and which is 
+therefore built into the language and compiler.
+Primitive types are always unboxed; that is, a value of primitive type cannot be 
+bottom.
+
+Primitive values are often represented by a simple bit-pattern, such as @Int#@, 
+@Float#@, @Double#@.  But this is not necessarily the case: a primitive value 
+might be represented by a pointer to a heap-allocated object.  Examples include 
+@Array#@, the type of primitive arrays.  You might think this odd: doesn't being 
+heap-allocated mean that it has a box?  No, it does not.  A primitive array is 
+heap-allocated because it is too big a value to fit in a register, and would be 
+too expensive to copy around; in a sense, it is accidental that it is represented 
+by a pointer.  If a pointer represents a primitive value, then it really does 
+point to that value: no unevaluated thunks, no indirections...nothing can be at 
+the other end of the pointer than the primitive value.
+
+This section also describes a few non-primitive types, which are needed 
+to express the result types of some primitive operations.
+
+\subsection{Character and numeric types}
+
+There are the following obvious primitive types:
+@
+type Char#
+type Int#      -- see also Word# and Addr#, later
+type Float#
+type Double#
+@
+If you want to know their exact equivalents in C, see
+@ghc/includes/StgTypes.lh@ in the GHC source.
+
+Literals for these types may be written as follows:
+@
+1#             an Int#
+1.2#           a Float#
+1.34##         a Double#
+'a'#           a Char#; for weird characters, use '\o<octal>'#
+"a"#           an Addr# (a `char *')
+@
+
+\subsubsection{Comparison operations}
+@
+{gt,ge,eq,ne,lt,le}Char# :: Char# -> Char# -> Bool
+    -- ditto for Int#, Word#, Float#, Double#, and Addr#
+@
+
+\subsubsection{Unboxed-character operations}
+@
+ord# :: Char# -> Int#
+chr# :: Int# -> Char#
+@
+
+\subsubsection{Unboxed-@Int@ operations}
+@
+{plus,minus,times,quot,div,rem}Int# :: Int# -> Int# -> Int#
+negateInt# :: Int# -> Int#
+@
+NB: No error/overflow checking!
+
+\subsubsection{Unboxed-@Float@ and @Double@ operations}
+@
+{plus,minus,times,divide}Float# :: Float# -> Float# -> Float#
+negateFloat# :: Float# -> Float#
+
+float2Int#     :: Float# -> Int#   -- just a cast, no checking!
+int2Float#     :: Int# -> Float#
+
+expFloat#      :: Float# -> Float#
+logFloat#      :: Float# -> Float#
+sqrtFloat#     :: Float# -> Float#
+sinFloat#      :: Float# -> Float#
+cosFloat#      :: Float# -> Float#
+tanFloat#      :: Float# -> Float#
+asinFloat#     :: Float# -> Float#
+acosFloat#     :: Float# -> Float#
+atanFloat#     :: Float# -> Float#
+sinhFloat#     :: Float# -> Float#
+coshFloat#     :: Float# -> Float#
+tanhFloat#     :: Float# -> Float#
+powerFloat#    :: Float# -> Float# -> Float#
+@
+There's an exactly-matching set of unboxed-@Double@ ops; replace
+@Float#@ with @Double#@ in the list above.  There are two
+coercion functions for @Float#@/@Double#@:
+@
+float2Double#  :: Float# -> Double#
+double2Float#  :: Double# -> Float#
+@
+The primitive versions of @encodeFloat@/@decodeFloat@:
+@
+encodeFloat#   :: Int# -> Int# -> ByteArray#   -- Integer mantissa
+               -> Int#                         -- Int exponent
+               -> Float#
+
+decodeFloat#   :: Float#
+               -> _ReturnIntAndGMP
+@
+(And the same for @Double#@s.)
+
+\subsection{Operations on/for @Integers@ (interface to GMP)}
+\label{sect:horrid-Integer-pairing-types}
+
+We implement @Integers@ (arbitrary-precision integers) using the GNU
+multiple-precision (GMP) package.
+
+The data type for @Integer@ must mirror that for @MP_INT@ in @gmp.h@
+(see @gmp.info@).  It comes out as:
+@
+data Integer = J# Int# Int# ByteArray#
+@
+So, @Integer@ is really just a ``pairing'' type for a particular
+collection of primitive types.
+
+The operations in the GMP return other combinations of
+GMP-plus-something, so we need ``pairing'' types for those, too:
+@
+type _ReturnGMP       = Integer        -- synonym
+data _Return2GMPs     = _Return2GMPs Int# Int# ByteArray#
+                                    Int# Int# ByteArray#
+data _ReturnIntAndGMP = _ReturnIntAndGMP Int#
+                                        Int# Int# ByteArray#
+
+-- ????? something to return a string of bytes (in the heap?)
+@
+The primitive ops to support @Integers@ use the ``pieces'' of the
+representation, and are as follows:
+@
+negateInteger# :: Int# -> Int# -> ByteArray# -> Integer
+
+{plus,minus,times}Integer# :: Int# -> Int# -> ByteArray#
+                          -> Int# -> Int# -> ByteArray#
+                          -> Integer
+
+cmpInteger# :: Int# -> Int# -> ByteArray#
+           -> Int# -> Int# -> ByteArray#
+           -> Int# -- -1 for <; 0 for ==; +1 for >
+
+divModInteger#, quotRemInteger#
+       :: Int# -> Int# -> ByteArray#
+       -> Int# -> Int# -> ByteArray#
+       -> _Return2GMPs
+
+integer2Int# :: Int# -> Int# -> ByteArray#
+            -> Int# 
+
+int2Integer#  :: Int#  -> Integer -- NB: no error-checking on these two!
+word2Integer# :: Word# -> Integer
+
+addr2Integer# :: Addr# -> Integer
+       -- the Addr# is taken to be a `char *' string
+       -- to be converted into an Integer
+@
+
+
+\subsection{Words and addresses}
+
+A @Word#@ is used for bit-twiddling operations.  It is the same size as
+an @Int#@, but has no sign nor any arithmetic operations.
+@
+type Word#     -- Same size/etc as Int# but *unsigned*
+type Addr#     -- A pointer from outside the "Haskell world" (from C, probably);
+               -- described under "arrays"
+@
+@Word#@s and @Addr#@s have the usual comparison operations.
+Other unboxed-@Word@ ops (bit-twiddling and coercions):
+@
+and#, or# :: Word# -> Word# -> Word#
+
+not# :: Word# -> Word#
+
+shiftL#, shiftRA#, shiftRL# :: Word# -> Int# -> Word#
+       -- shift left, right arithmetic, right logical
+
+iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
+       -- same shift ops, but on Int#s
+
+int2Word#      :: Int#  -> Word# -- just a cast, really
+word2Int#      :: Word# -> Int#
+@
+
+Unboxed-@Addr@ ops (C casts, really):
+@
+int2Addr#      :: Int#  -> Addr#
+addr2Int#      :: Addr# -> Int#
+@
+Operations for indexing off of C pointers (@Addr#@s) to snatch values
+are listed under ``arrays''.
+
+\subsection{Arrays}
+
+The type @Array# elt@ is the type of primitive,
+unboxed arrays of values of type @elt@.  
+@
+type Array# elt
+@
+@Array#@ is more primitive than a Haskell
+array --- indeed, Haskell arrays are implemented using @Array#@ ---
+in that an @Array#@ is indexed only by @Int#@s, starting at zero.  It is also
+more primitive by virtue of being unboxed.  That doesn't mean that it isn't
+a heap-allocated object --- of course, it is.  Rather, being unboxed means
+that it is represented by a pointer to the array itself, and not to a thunk
+which will evaluate to the array (or to bottom).
+The components of an @Array#@ are themselves boxed.
+
+The type @ByteArray#@ is similar to @Array#@, except that it contains
+just a string of (non-pointer) bytes.
+@
+type ByteArray#
+@
+Arrays of these types are useful when a Haskell program wishes to
+construct a value to pass to a C procedure.  It is also possible to
+use them to build (say) arrays of unboxed characters for internal use
+in a Haskell program.  Given these uses, @ByteArray#@ is deliberately
+a bit vague about the type of its components.  Operations are provided
+to extract values of type @Char#@, @Int#@, @Float#@, @Double#@, and
+@Addr#@ from arbitrary offsets within a @ByteArray#@.  (For type @Foo#@,
+the $i$th offset gets you the $i$th @Foo#@, not the @Foo#@ at byte-position $i$.  Mumble.)
+(If you want a @Word#@, grab an @Int#@, then coerce it.)
+
+Lastly, we have static byte-arrays, of type @Addr#@ [mentioned
+previously].  (Remember the duality between arrays and pointers in C.)
+Arrays of this types are represented by a pointer to an array in the
+world outside Haskell, so this pointer is not followed by the garbage
+collector.  In other respects they are just like @ByteArray#@.  They
+are only needed in order to pass values from C to Haskell.
+
+\subsubsection{Reading and writing.}
+
+Primitive arrays are linear, and indexed starting at zero.
+
+The size and indices of a @ByteArray#@, @Addr#@, and
+@MutableByteArray#@ are all in bytes.  It's up to the program to
+calculate the correct byte offset from the start of the array.  This
+allows a @ByteArray#@ to contain a mixture of values of different
+type, which is often needed when preparing data for and unpicking
+results from C.  (Umm... not true of indices... WDP 95/09)
+
+{\em Should we provide some @sizeOfDouble#@ constants?}
+
+Out-of-range errors on indexing should be caught by the code which
+uses the primitive operation; the primitive operations themselves do
+{\em not} check for out-of-range indexes. The intention is that the
+primitive ops compile to one machine instruction or thereabouts.
+
+We use the terms ``reading'' and ``writing'' to refer to accessing {\em mutable} 
+arrays (see Section~\ref{sect:mutable}), and ``indexing'' 
+to refer to reading a value from an {\em immutable} 
+array.
+
+If you want to read/write a @Word#@, read an @Int#@ and coerce.
+
+Immutable byte arrays are straightforward to index (all indices in bytes):
+@
+indexCharArray#   :: ByteArray# -> Int# -> Char#
+indexIntArray#    :: ByteArray# -> Int# -> Int#
+indexAddrArray#   :: ByteArray# -> Int# -> Addr#
+indexFloatArray#  :: ByteArray# -> Int# -> Float#
+indexDoubleArray# :: ByteArray# -> Int# -> Double#
+
+indexCharOffAddr#   :: Addr# -> Int# -> Char#
+indexIntOffAddr#    :: Addr# -> Int# -> Int#
+indexFloatOffAddr#  :: Addr# -> Int# -> Float#
+indexDoubleOffAddr# :: Addr# -> Int# -> Double#
+indexAddrOffAddr#   :: Addr# -> Int# -> Addr#  -- Get an Addr# from an Addr# offset
+@
+The last of these, @indexAddrOffAddr#@, extracts an @Addr#@ using an offset
+from another @Addr#@, thereby providing the ability to follow a chain of
+C pointers.
+
+Something a bit more interesting goes on when indexing arrays of boxed
+objects, because the result is simply the boxed object. So presumably
+it should be entered --- we never usually return an unevaluated
+object!  This is a pain: primitive ops aren't supposed to do
+complicated things like enter objects.  The current solution is to
+return a lifted value, but I don't like it!
+@
+indexArray#       :: Array# elt -> Int# -> _Lift elt   -- Yuk!
+@
+
+\subsubsection{The state type}
+
+The primitive type @State#@ represents the state of a state transformer.
+It is parameterised on the desired type of state, which serves to keep
+states from distinct threads distinct from one another.  But the {\em only}
+effect of this parameterisation is in the type system: all values of type
+@State#@ are represented in the same way.  Indeed, they are all 
+represented by nothing at all!  The code generator ``knows'' to generate no 
+code, and allocate no registers etc, for primitive states.
+@
+type State# s
+@
+
+The type @_RealWorld@ is truly opaque: there are no values defined
+of this type, and no operations over it.  It is ``primitive'' in that
+sense---but it is {\em not unboxed!} Its only role in life is to be the type
+which distinguishes the @PrimIO@ state transformer (see
+Section~\ref{sect:io-spec}).
+@
+data _RealWorld
+@
+
+\subsubsection{States}
+
+A single, primitive, value of type @State# _RealWorld@ is provided.
+@
+realWorld# :: State# _RealWorld
+@
+(Note: in the compiler, not a @PrimOp@; just a mucho magic @Id@.)
+
+\subsection{State pairing types}
+\label{sect:horrid-pairing-types}
+
+This subsection defines some types which, while they aren't quite primitive 
+because we can define them in Haskell, are very nearly so.  They define 
+constructors which pair a primitive state with a value of each primitive type.
+They are required to express the result type of the primitive operations in the 
+state monad.
+@
+data StateAndPtr#    s elt = StateAndPtr#    (State# s) elt 
+
+data StateAndChar#   s     = StateAndChar#   (State# s) Char# 
+data StateAndInt#    s     = StateAndInt#    (State# s) Int# 
+data StateAndWord#   s     = StateAndWord#   (State# s) Word#
+data StateAndFloat#  s     = StateAndFloat#  (State# s) Float# 
+data StateAndDouble# s     = StateAndDouble# (State# s) Double#  
+data StateAndAddr#   s     = StateAndAddr#   (State# s) Addr#
+
+data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
+data StateAndMallocPtr# s   = StateAndMallocPtr# (State# s) MallocPtr#
+data StateAndSynchVar#  s a = StateAndSynchVar#  (State# s) (SynchVar# a)
+
+data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt) 
+data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)  
+data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray# 
+data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)
+@
+
+
+\subsection{Mutable arrays}
+\label{sect:mutable}
+
+Corresponding to @Array#@ and @ByteArray#@,
+we have the types of mutable versions of each.  
+In each case, the representation is a pointer
+to a suitable block of (mutable) heap-allocated storage.
+@
+type MutableArray# s elt
+type MutableByteArray# s
+@
+\subsubsection{Allocation.}
+
+Mutable arrays can be allocated.
+Only pointer-arrays are initialised; arrays of non-pointers are filled
+in by ``user code'' rather than by the array-allocation primitive.
+Reason: only the pointer case has to worry about GC striking with a
+partly-initialised array.
+@
+newArray#       :: Int# -> elt -> State# s -> StateAndMutableArray# s elt 
+
+newCharArray#   :: Int# -> State# s -> StateAndMutableByteArray# s 
+newIntArray#    :: Int# -> State# s -> StateAndMutableByteArray# s 
+newAddrArray#   :: Int# -> State# s -> StateAndMutableByteArray# s 
+newFloatArray#  :: Int# -> State# s -> StateAndMutableByteArray# s 
+newDoubleArray# :: Int# -> State# s -> StateAndMutableByteArray# s 
+@
+The size of a @ByteArray#@ is given in bytes.
+
+\subsubsection{Reading and writing}
+
+%OLD: Remember, offsets in a @MutableByteArray#@ are in bytes.
+@
+readArray#       :: MutableArray# s elt -> Int# -> State# s -> StateAndPtr#    s elt
+readCharArray#   :: MutableByteArray# s -> Int# -> State# s -> StateAndChar#   s
+readIntArray#    :: MutableByteArray# s -> Int# -> State# s -> StateAndInt#    s
+readAddrArray#  :: MutableByteArray# s -> Int# -> State# s -> StateAndAddr#   s 
+readFloatArray#  :: MutableByteArray# s -> Int# -> State# s -> StateAndFloat#  s 
+readDoubleArray# :: MutableByteArray# s -> Int# -> State# s -> StateAndDouble# s 
+
+writeArray#       :: MutableArray# s elt -> Int# -> elt     -> State# s -> State# s 
+writeCharArray#   :: MutableByteArray# s -> Int# -> Char#   -> State# s -> State# s 
+writeIntArray#    :: MutableByteArray# s -> Int# -> Int#    -> State# s -> State# s 
+writeAddrArray#   :: MutableByteArray# s -> Int# -> Addr#   -> State# s -> State# s 
+writeFloatArray#  :: MutableByteArray# s -> Int# -> Float#  -> State# s -> State# s 
+writeDoubleArray# :: MutableByteArray# s -> Int# -> Double# -> State# s -> State# s 
+@
+
+\subsubsection{Equality.}
+
+One can take ``equality'' of mutable arrays.  What is compared is the
+{\em name} or reference to the mutable array, not its contents.
+@
+sameMutableArray#     :: MutableArray# s elt -> MutableArray# s elt -> Bool
+sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Bool
+@
+
+\subsubsection{Freezing mutable arrays}
+
+Only unsafe-freeze has a primitive.  (Safe freeze is done directly in Haskell 
+by copying the array and then using @unsafeFreeze@.) 
+@
+unsafeFreezeArray#     :: MutableArray# s elt -> State# s -> StateAndArray#     s elt
+unsafeFreezeByteArray# :: MutableByteArray# s -> State# s -> StateAndByteArray# s
+@
+
+\subsubsection{Stable pointers}
+
+{\em Andy's comment.} {\bf Errors:} The following is not strictly true: the current
+implementation is not as polymorphic as claimed.  The reason for this
+is that the C programmer will have to use a different entry-routine
+for each type of stable pointer.  At present, we only supply a very
+limited number (1) of these routines.  It might be possible to
+increase the range of these routines by providing general purpose
+entry points to apply stable pointers to (stable pointers to)
+arguments and to enter (stable pointers to) boxed primitive values.
+{\em End of Andy's comment.}
+
+A stable pointer is a name for a Haskell object which can be passed to the 
+external world.  It is ``stable'' in the sense that the name does not change when 
+the Haskell garbage collector runs --- in contrast to the address of the object 
+which may well change.
+
+The stable pointer type is parameterised by the type of the thing which is named.
+@
+type StablePtr# a
+@
+A stable pointer is represented by an index into the (static) 
+@StablePointerTable@.  The Haskell garbage collector treats the 
+@StablePointerTable@ as a source of roots for GC.
+
+The @makeStablePointer@ function converts a value into a stable pointer.
+It is part of the @PrimIO@ monad, because we want to be sure we don't
+allocate one twice by accident, and then only free one of the copies.
+@
+makeStablePointer#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
+freeStablePointer#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
+deRefStablePointer# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
+@
+There is also a C procedure @FreeStablePtr@ which frees a stable pointer.
+
+\subsubsection{``Malloc'' pointers}
+
+A ``malloc'' pointer is an ordinary pointer from outside the Haskell world
+(i.e., from the C world) where the Haskell world has been told ``Let me
+know when you're finished with this ...''.
+
+The ``malloc'' pointer type is just a special @Addr#@ ({\em not} parameterised).
+@
+type MallocPtr#
+@
+{\em ToDo: say more about this and how it's used...}
+
+The main point is that when Haskell discards a 
+value of type @MallocPtr#@, it calls the procedure @FreeMallocPtr@, which
+must be provided by the C world.  @FreeMallocPtr@ might in turn call
+the GHC-provided procedure @FreeStablePtr@, to deallocate a stable pointer.
+No other GHC runtime system procedures should be called by @FreeMallocPtr@.
+
+(Implementation: a linked list of all @MallocPtr#@s is maintained to allow the
+garbage collector to detect when a @MallocPtr#@ becomes garbage.)
+
+Like @Array@, @MallocPtr#@s are represented by heap objects.
+
+{\bf ToDo --- Important:} Ian Poole reports a need for functions to return a list of
+CHPs.  Should we add a @CHeapPtrArray@ type too? or just
+hack something up?
+
+The only Haskell operation we might want on @MallocPtr#@s is an
+equality test.  However, this is easily implemented if desired:
+@
+>      eqCHP x y = (_runST (_ccall_ equal x y) == 1::Int)
+
+C>     equal (x, y)
+C>     {
+C>     return (x == y ? 1 : 0);
+C>     }
+@
+
+The C world must provide a function @FreeCHeapPointer@ which
+will be called (with a C Heap pointer as argument) when the garbage
+collector releases a CHP.
+
+{\bf ToDo:} Decide whether @FreeCHeapPointer@ is allowed to call on a
+stable pointer. (I sincerely hope not since we will still be in the
+GC at this point.)
+
+\subsubsection{Synchronizing variables (I-vars, M-vars)}
+
+ToDo ToDo ToDo
+
+@
+type SynchVar# s elt   -- primitive
+
+newSynchVar#:: State# s -> StateAndSynchVar# s elt
+
+takeMVar#   :: SynchVar# s elt -> State# s -> StateAndPtr# s elt
+putMVar#    :: SynchVar# s elt -> State# s -> State# s
+
+readIVar#   :: SynchVar# s elt -> State# s -> StateAndPtr# s elt
+writeIVar#  :: SynchVar# s elt -> State# s -> State# s
+@
+
+\subsubsection{Controlling the garbage collector}
+
+The C function {\tt PerformGC\/}, allows the C world to force Haskell
+to do a garbage collection.  It can only be called while Haskell
+is performing a C Call.
+
+Note that this function can be used to define a Haskell IO operation
+with the same effect:
+@
+>      performGCIO :: PrimIO ()
+>      performGCIO = _ccall_gc_ PerformGC
+@
+
+{\bf ToDo:} Is there any need for abnormal/normal termination to force
+a GC too?  Is there any need for a function that provides finer
+control over GC: argument = amount of space required; result = amount
+of space recovered.
+
+\subsection{@spark#@ primitive operation (for parallel execution)}
+
+{\em ToDo: say something}  It's used in the unfolding for @par@.
+
+\subsection{The @errorIO#@ primitive operation}
+
+The @errorIO#@ primitive takes an argument of type @PrimIO@.  It aborts execution of
+the current program, and continues instead by performing the given @PrimIO@ value
+on the current state of the world.
+@
+errorIO# :: PrimIO () -> a
+@
+
+\subsection{C Calls}
+
+{\bf ToDo:} current implementation has state variable as second
+argument not last argument.
+
+The @ccall#@ primitive can't be given an ordinary type, because it has
+a variable number of arguments.  The nearest we can get is:
+@
+ccall# :: CRoutine -> a1# -> ... -> an# -> State# _RealWorld -> StateAndR# _RealWorld
+@
+where the type variables @a1#@\ldots@an#@ and @r#@ can be instantiated by any
+primitive type, and @StateAndR#@ is the appropriate pairing type from 
+Section~\ref{sect:horrid-pairing-types}.  The @CRoutine@ 
+isn't a proper Haskell type at all; it just reminds us that @ccall#@ needs to 
+know what C routine to call.
+
+This notation is really short for a massive family of @ccall#@ primitives, one 
+for each combination of types.  (Of course, the compiler simply remembers the 
+types involved, and generates appropriate code when it finally spits out the C.)
+
+Unlike all the other primitive operators, @ccall#@ is not bound to an in-scope 
+identifier.  The only way it is possible to generate a @ccall#@ is via the 
+@_ccall_@ construct.
+
+All this applies equally to @casm#@:
+@
+casm#  :: CAsmString -> a1# -> ... -> an# -> State# _RealWorld -> StateAndR# _RealWorld
+@
+
+%------------------------------------------------------------
+\section{Library stuff built with the Really Primitive Stuff}
+
+\subsection{The state transformer monad}
+
+\subsubsection{Types}
+
+A state transformer is a function from a state to a pair of a result and a new 
+state.  
+@
+type _ST s a = _State s -> (a, _State s)
+@
+The @_ST@ type is {\em abstract}, so that the programmer cannot see its 
+representation.  If he could, he could write bad things like:
+@
+bad :: _ST s a
+bad = \s -> ...(f s)...(g s)...
+@
+Here, @s@ is duplicated, which would be bad news.
+
+A state is represented by a primitive state value, of type @State# s@, 
+wrapped up in a @_State@ constructor.  The reason for boxing it in this
+way is so that we can be strict or lazy in the state.  (Remember, all 
+primitive types are unboxed, and hence can't be bottom; but types built
+with @data@ are all boxed.)
+@
+data _State s = S# (State# s)
+@ 
+
+\subsubsection{The state transformer combinators}
+
+Now for the combinators, all of which live inside the @_ST@
+abstraction.  Notice that @returnST@ and @thenST@ are lazy in the
+state.
+@
+returnST :: a -> _ST s a
+returnST a s = (a, s)
+
+thenST :: _ST s a -> (a -> _ST s b) -> _ST s b
+thenST m k s = let (r,new_s) = m s
+               in 
+               k r new_s
+
+fixST :: (a -> _ST s a) -> _ST s a
+fixST k s = let ans = k r s
+                (r,new_s) = ans
+            in
+            ans
+@
+The interesting one is, of course, @_runST@.  We can't infer its type!
+(It has a funny name because it must be wired into the compiler.)
+@
+-- _runST :: forall a. (forall s. _ST s a) -> a
+_runST m = case m (S# realWorld#) of
+           (r,_) -> r
+@
+
+\subsubsection{Other useful combinators}
+
+There are various other standard combinators, all defined in terms the
+fundamental combinators above. The @seqST@ combinator is like
+@thenST@, except that it discards the result of the first state
+transformer:
+@
+seqST :: _ST s a -> _ST s b -> _ST s b
+seqST m1 m2 = m1 `thenST` (\_ -> m2)
+@
+
+We also have {\em strict} (... in the state...) variants of the
+then/return combinators (same types as their pals):
+@
+returnStrictlyST a s@(S# _) = (a, s)
+
+thenStrictlyST m k s@(S# _)
+  = case (m s) of { (r, new_s@(S# _)) ->
+    k r new_s }
+
+seqStrictlyST m k = ... ditto, for seqST ...
+@
+
+The combinator @listST@ takes a list of state transformers, and
+composes them in sequence, returning a list of their results:
+@
+listST :: [_ST s a] -> _ST s [a]
+listST []     = returnST []
+listST (m:ms) = m              `thenST` \ r ->
+               listST ms       `thenST` \ rs ->
+               returnST (r:rs)
+@
+The @mapST@ combinator ``lifts'' a function from a value to state
+transformers to one which works over a list of values:
+@
+mapST :: (a -> _ST s b) -> [a] -> _ST s [b]
+mapST f ms = listST (map f ms)
+@
+The @mapAndUnzipST@ combinator is similar to @mapST@, except that here the
+function returns a pair:
+@
+mapAndUnzipST :: (a -> _ST s (b,c)) -> [a] -> _ST s ([b],[c])
+mapAndUnzipST f (m:ms)
+  = f m                        `thenST` \ ( r1,  r2) ->
+    mapAndUnzipST f ms `thenST` \ (rs1, rs2) ->
+    returnST (r1:rs1, r2:rs2)
+@
+
+\subsubsection{The @PrimIO@ monad}
+\label{sect:io-spec}
+
+The @PrimIO@ type is defined in as a state transformer which manipulates the 
+@_RealWorld@.
+@
+type PrimIO a = _ST _RealWorld a      -- Transparent
+@
+The @PrimIO@ type is an ordinary type synonym, transparent to the programmer.
+
+The type @_RealWorld@ and value @realWorld#@ do not need to be hidden (although 
+there is no particular point in exposing them).  Even having a value of type 
+@realWorld#@ does not compromise safety, since the type @_ST@ is hidden. 
+
+It is type-correct to use @returnST@ in an I/O context, but it is a
+bit more efficient to use @returnPrimIO@.  The latter is strict in the
+state, which propagates backwards to all the earlier combinators
+(provided they are unfolded).  Why is it safe for @returnPrimIO@ to be
+strict in the state?  Because every context in which an I/O state
+transformer is used will certainly evaluate the resulting state; it is
+the state of the real world!
+@
+returnPrimIO :: a -> PrimIO a
+returnPrimIO a s@(S# _) -> (a, s)
+@
+We provide strict versions of the other combinators too.
+@
+thenPrimIO m k s = case m s of
+                    (r,s) -> k r s
+@
+@fixPrimIO@ has to be lazy, though!
+@
+fixPrimIO  = fixST
+@
+The other combinators are just the same as before, but use the strict
+@thenPrimIO@ and @returnPrimIO@ for efficiency.
+@
+foldrPrimIO f z []     = z
+foldrPrimIO f z (m:ms) = foldrPrimIO f z ms `thenPrimIO` \ ms' ->
+                        f m ms'
+
+listPrimIO ms = foldrPrimIO (\ a xs -> a `thenPrimIO` \ x -> returnPrimIO (x : xs))
+               (returnPrimIO []) ms
+
+mapPrimIO f ms = listPrimIO (map f ms)
+
+mapAndUnzipPrimIO f (m:ms)
+  = f m                            `thenPrimIO` \ ( r1,  r2) ->
+    mapAndUnzipPrimIO f ms  `thenPrimIO` \ (rs1, rs2) ->
+    returnPrimIO (r1:rs1, r2:rs2)
+@
+
+\subsection{Arrays}
+
+\subsubsection{Types}
+
+@
+data Array      ix elt = _Array     (ix,ix) (Array# elt)
+data _ByteArray ix     = _ByteArray (ix,ix) ByteArray#
+
+data _MutableArray     s ix elt = _MutableArray     (ix,ix) (MutableArray# s elt)
+data _MutableByteArray s ix     = _MutableByteArray (ix,ix) (MutableByteArray# s)
+@
+
+\subsubsection{Operations on immutable arrays}
+
+Ordinary array indexing is straightforward.
+@
+(!) :: Ix ix => Array ix elt -> ix -> elt
+@
+QUESTIONs: should @_ByteArray@s be indexed by Ints or ix?  With byte offsets
+or sized ones? (sized ones [WDP])
+@
+indexCharArray   :: Ix ix => _ByteArray ix -> ix -> Char
+indexIntArray    :: Ix ix => _ByteArray ix -> ix -> Int
+indexAddrArray   :: Ix ix => _ByteArray ix -> ix -> _Addr
+indexFloatArray  :: Ix ix => _ByteArray ix -> ix -> Float
+indexDoubleArray :: Ix ix => _ByteArray ix -> ix -> Double
+@
+@Addr@s are indexed straightforwardly by @Int@s.  Unlike the primitive
+operations, though, the offsets assume that the array consists entirely of the
+type of value being indexed, and so there's an implicit multiplication by
+the size of that value.  To access @Addr@s with mixed values requires
+you to do a DIY job using the primitives.
+@
+indexAddrChar :: Addr -> Int -> Char
+...etc...
+indexStaticCharArray   :: Addr -> Int -> Char
+indexStaticIntArray    :: Addr -> Int -> Int
+indexStaticFloatArray  :: Addr -> Int -> Float
+indexStaticDoubleArray :: Addr -> Int -> Double
+indexStaticArray       :: Addr -> Int -> Addr
+@
+
+\subsubsection{Operations on mutable arrays}
+@
+newArray     :: Ix ix => (ix,ix) -> elt -> _ST s (_MutableArray s ix elt)
+newCharArray :: Ix ix => (ix,ix) -> _ST s (_MutableByteArray s ix) 
+...
+@
+
+@
+readArray   :: Ix ix => _MutableArray s ix elt -> ix -> _ST s elt 
+readCharArray   :: Ix ix => _MutableByteArray s ix -> ix -> _ST s Char 
+...
+@
+
+@
+writeArray  :: Ix ix => _MutableArray s ix elt -> ix -> elt -> _ST s () 
+writeCharArray  :: Ix ix => _MutableByteArray s ix -> ix -> Char -> _ST s () 
+...
+@
+
+@
+freezeArray :: Ix ix => _MutableArray s ix elt -> _ST s (Array ix elt)
+freezeCharArray :: Ix ix => _MutableByteArray s ix -> _ST s (_ByteArray ix Char)
+...
+@
+
+We have no need on one-function-per-type for unsafe freezing:
+@
+unsafeFreezeArray :: Ix ix => _MutableArray s ix elt -> _ST s (Array ix elt)  
+unsafeFreezeByteArray :: Ix ix => _MutableByteArray s ix -> _ST s (_ByteArray ix elt)
+@
+
+Sometimes we want to snaffle the bounds of one of these beasts:
+@
+boundsOfArray     :: Ix ix => _MutableArray s ix elt -> (ix, ix)  
+boundsOfByteArray :: Ix ix => _MutableByteArray s ix -> (ix, ix)
+@
+
+Lastly, ``equality'':
+@
+sameMutableArray     :: _MutableArray s ix elt -> _MutableArray s ix elt -> Bool
+sameMutableByteArray :: _MutableByteArray s ix -> _MutableByteArray s ix -> Bool
+@
+
+
+\subsection{Variables}
+
+\subsubsection{Types}
+
+Mutable variables are (for now anyway) implemented as arrays.  The @MutableVar@ type
+is opaque, so we can change the implementation later if we want.
+@
+type MutableVar s a = _MutableArray s Int a
+@
+
+\subsubsection{Operations}
+@
+newVar   :: a -> _ST s (MutableVar s a)
+readVar  :: MutableVar s a -> _ST s a
+writeVar :: MutableVar s a -> a -> _ST s ()
+sameVar  :: MutableVar s a -> MutableVar s a -> Bool
+@
+
+\subsection{Stable pointers}
+
+Nothing exciting here, just simple boxing up.
+@
+data _StablePtr a = _StablePtr (StablePtr# a)
+
+makeStablePointer :: a -> _StablePtr a
+freeStablePointer :: _StablePtr a -> PrimIO ()
+@
+
+\subsection{``Malloc'' pointers}
+
+Again, just boxing up.
+@
+data _MallocPtr = _MallocPtr MallocPtr#
+@
+
+\subsection{C calls}
+
+Everything in this section goes for @_casm_@ too.
+
+{\em ToDo: mention @_ccall_gc_@ and @_casm_gc_@...}
+
+The @_ccall_@ construct has the following form:
+$$@_ccall_@~croutine~a_1~\ldots~a_n$$
+This whole construct has type $@PrimIO@~res$.
+The rules are these:
+\begin{itemize}
+\item
+The first ``argument'', $croutine$, must be the literal name of a C procedure.
+It cannot be a Haskell expression which evaluates to a string, etc; it must be 
+simply the name of the procedure.
+\item
+The arguments $a_1, \ldots,a_n$ must be of {\em C-callable} type.
+\item
+The whole construct has type $@PrimIO@~ty$, where $ty$ is a {\em C-returnable} type.
+\end{itemize}
+A {\em boxed-primitive} type is both C-callable and C-returnable.
+A boxed primitive type is anything declared by:
+@
+data T = C# t
+@
+where @t@ is a primitive type.  Note that
+programmer-defined boxed-primitive types are perfectly OK:
+@
+data Widget = W# Int#
+data Screen = S# CHeapPtr#
+@
+
+There are other types that can be passed to C (C-callable).  This
+table summarises (including the standard boxed-primitive types):
+@
+Boxed              Type of transferd   Corresp.     Which is
+Type               Prim. component     C type       *probably*...
+------             ---------------     ------       -------------
+Char               Char#               StgChar      unsigned char
+Int                Int#                StgInt       long int
+_Word              Word#               StgWord      unsigned long int
+_Addr              Addr#               StgAddr      char *
+Float              Float#              StgFloat     float
+Double             Double#             StgDouble    double
+
+Array              Array#              StgArray     StgPtr
+_ByteArray         ByteArray#          StgByteArray StgPtr
+_MutableArray      MutableArray#       StgArray     StgPtr
+_MutableByteArray   MutableByteArray#  StgByteArray StgPtr
+
+_State             State#              nothing!
+
+_StablePtr         StablePtr#          StgStablePtr StgPtr
+_MallocPtr         MallocPtr#          StgMallocPtr StgPtr
+@
+
+All of the above are {\em C-returnable} except:
+@
+       Array, _ByteArray, _MutableArray, _MutableByteArray
+@
+
+{\bf ToDo:} I'm pretty wary of @Array@ and @_MutableArray@ being in
+this list, and not too happy about @_State@ [WDP].
+
+{\bf ToDo:} Can code generator pass all the primitive types?  Should this be
+extended to include {\tt Bool\/} (or any enumeration type?)
+
+The type checker must be able to figure out just which of the C-callable/returnable
+types is being used.  If it can't, you have to add type signatures. For example,
+@
+f x = _ccall_ foo x
+@
+is not good enough, because the compiler can't work out what type @x@ is, nor 
+what type the @_ccall_@ returns.  You have to write, say:
+@
+f :: Int -> PrimIO Float
+f x = _ccall_ foo x
+@
+
+\subsubsection{Implementation}
+
+The desugarer unwraps the @_ccall_@ construct by inserting the necessary 
+evaluations etc to unbox the arguments.  For example, the body of the definition 
+of @f@ above would become:
+@
+        (\ s -> case x of { I# x# -> 
+                case s of { S# s# ->
+                case ccall# [Int#,Float#] x# s# of { StateAndFloat# f# new_s# ->
+                (F# f#, S# new_s#)
+                }}})
+@
+Notice that the state, too, is unboxed.
+
+The code generator must deal specially with primitive objects which
+are stored on the heap.
+
+... details omitted ...
+
+More importantly, it must construct a C Heap Pointer heap-object after
+a @_ccall_@ which returns a @MallocPtr#@.
+
+%--------------------------------------------------------
+\section{Non-primitive stuff that must be wired into GHC}
+
+@
+data Char    = C# Char#
+data Int     = I# Int#
+data _Word   = W# Word#
+data _Addr   = A# Addr#
+
+data Float   = F# Float#
+data Double  = D# Double#
+data Integer = J# Int# Int# ByteArray#
+
+-- and the other boxed-primitive types:
+    Array, _ByteArray, _MutableArray, _MutableByteArray,
+    _StablePtr, _MallocPtr
+
+data Bool     = False | True
+data CMP_TAG# = LT# | EQ# | GT#  -- used in derived comparisons
+
+data List a = [] | a : (List a)
+-- tuples...
+
+data Ratio a  = a :% a
+type Rational = Ratio Integer
+
+data {Request,Response,etc} -- so we can check the type of "main"
+
+data _Lift a = _Lift a    -- used Yukkily as described elsewhere
+
+type String  = [Char]    -- convenience, only
+@
+
+%------------------------------------------------------------
+\section{Programmer interface(s)}
+
+\subsection{The bog-standard interface}
+
+If you rely on the implicit @import Prelude@ that GHC normally does
+for you, and if you don't use any weird flags (notably
+@-fglasgow-exts@), and if you don't import one of the fairly-magic
+@PreludeGla*@ interfaces, then GHC should work {\em exactly} as the
+Haskell report says, and the full user namespaces should be available
+to you.
+
+Exception: until we burn in the new names @_scc_@ and @_ccall_@, the
+names @scc@ and @ccall@ are still available.
+
+\subsection{If you mess about with @import Prelude@...}
+
+Innocent renaming and hiding, e.g.,
+@
+import Prelude hiding ( fromIntegral ) renaming (map to mop)
+@
+should work just fine (even it {\em is} atrocious programming practice).
+
+There are some things you can do that will make GHC crash, e.g.,
+hiding a standard class:
+@
+import Prelude hiding ( Eq(..) )
+@
+Don't do that.
+
+\subsection{Turning on Glasgow extensions with @-fglasgow-exts@}
+
+If you turn on @-fglasgow-exts@, then all the primitive types and
+operations described herein are available.
+
+It is possible that some name conflicts between your code and the
+wired-in things might spring to life (though we doubt it...).
+Change your names :-)
+
+\subsection{@import PreludeGlaST@}
+
+@
+type ST s a = _ST s a  -- so you don't need -fglasgow-exts...
+@
+
+\subsection{@import PreludeGlaMisc@}
+
+\end{document}
+                                                       
index 79c7ab9..2403968 100644 (file)
@@ -1070,6 +1070,104 @@ Enables some debugging code related to the garbage-collector.
 %-ddump-asm-globals-info
 
 %----------------------------------------------------------------------
 %-ddump-asm-globals-info
 
 %----------------------------------------------------------------------
+\subsubsection{How to read Core syntax (from some \tr{-ddump-*} flags)}
+\index{reading Core syntax}
+\index{Core syntax, how to read}
+
+Let's do this by commenting an example.  It's from doing
+\tr{-ddump-ds} on this code:
+\begin{verbatim}
+skip2 m = m : skip2 (m+2)
+\end{verbatim}
+
+Before we jump in, a word about names of things.  Within GHC,
+variables, type constructors, etc., are identified by their
+``Uniques.''  These are of the form `letter' plus `number' (both
+loosely interpreted).  The `letter' gives some idea of where the
+Unique came from; e.g., \tr{_} means ``built-in type variable'';
+\tr{t} means ``from the typechecker''; \tr{s} means ``from the
+simplifier''; and so on.  The `number' is printed fairly compactly in
+a `base-62' format, which everyone hates except me (WDP).
+
+Remember, everything has a ``Unique'' and it is usually printed out
+when debugging, in some form or another.  So here we go...
+
+\begin{verbatim}
+Desugared:
+Main.skip2{-r1L6-} :: _forall_ a$_4 =>{{Num a$_4}} -> a$_4 -> [a$_4]
+
+--# `r1L6' is the Unique for Main.skip2;
+--# `_4' is the Unique for the type-variable (template) `a'
+--# `{{Num a$_4}}' is a dictionary argument
+
+_NI_
+
+--# `_NI_' means "no (pragmatic) information" yet; it will later
+--# evolve into the GHC_PRAGMA info that goes into interface files.
+
+Main.skip2{-r1L6-} =
+    /\ _4 -> \ d.Num.t4Gt ->
+       let {
+         {- CoRec -}
+         +.t4Hg :: _4 -> _4 -> _4
+         _NI_
+         +.t4Hg = (+{-r3JH-} _4) d.Num.t4Gt
+
+         fromInt.t4GS :: Int{-2i-} -> _4
+         _NI_
+         fromInt.t4GS = (fromInt{-r3JX-} _4) d.Num.t4Gt
+
+--# The `+' class method (Unique: r3JH) selects the addition code
+--# from a `Num' dictionary (now an explicit lamba'd argument).
+--# Because Core is 2nd-order lambda-calculus, type applications
+--# and lambdas (/\) are explicit.  So `+' is first applied to a
+--# type (`_4'), then to a dictionary, yielding the actual addition
+--# function that we will use subsequently...
+
+--# We play the exact same game with the (non-standard) class method
+--# `fromInt'.  Unsurprisingly, the type `Int' is wired into the
+--# compiler.
+
+         lit.t4Hb :: _4
+         _NI_
+         lit.t4Hb =
+             let {
+               ds.d4Qz :: Int{-2i-}
+               _NI_
+               ds.d4Qz = I#! 2#
+             } in  fromInt.t4GS ds.d4Qz
+
+--# `I# 2#' is just the literal Int `2'; it reflects the fact that
+--# GHC defines `data Int = I# Int#', where Int# is the primitive
+--# unboxed type.  (see relevant info about unboxed types elsewhere...)
+
+--# The `!' after `I#' indicates that this is a *saturated*
+--# application of the `I#' data constructor (i.e., not partially
+--# applied).
+
+         skip2.t3Ja :: _4 -> [_4]
+         _NI_
+         skip2.t3Ja =
+             \ m.r1H4 ->
+                 let { ds.d4QQ :: [_4]
+                       _NI_
+                       ds.d4QQ =
+                   let {
+                     ds.d4QY :: _4
+                     _NI_
+                     ds.d4QY = +.t4Hg m.r1H4 lit.t4Hb
+                   } in  skip2.t3Ja ds.d4QY
+                 } in
+                 :! _4 m.r1H4 ds.d4QQ
+
+         {- end CoRec -}
+       } in  skip2.t3Ja
+\end{verbatim}
+
+(``It's just a simple functional language'' is an unregisterised
+trademark of Peyton Jones Enterprises, plc.)
+
+%----------------------------------------------------------------------
 \subsubsection[arity-checking]{Options to insert arity-checking code}
 \index{arity checking}
 
 \subsubsection[arity-checking]{Options to insert arity-checking code}
 \index{arity checking}
 
index b01dec5..49c1861 100644 (file)
@@ -612,6 +612,12 @@ something...) per PVM processor.  We use the standard \tr{debugger}
 script that comes with PVM3, but we sometimes meddle with the
 \tr{debugger2} script.  We include ours in the GHC distribution,
 in \tr{ghc/utils/pvm/}.
 script that comes with PVM3, but we sometimes meddle with the
 \tr{debugger2} script.  We include ours in the GHC distribution,
 in \tr{ghc/utils/pvm/}.
+
+\item[\tr{-e<num>}:]
+\index{-e<num> RTS option (parallel)}
+(PARALLEL ONLY) Limit the number of pending sparks per processor to
+\tr{<num>}. The default is 100. A larger number may be appropriate if
+your program generates large amounts of parallelism initially.
 \end{description}
 
 %************************************************************************
 \end{description}
 
 %************************************************************************
diff --git a/ghc/docs/users_guide/prof-output.lit b/ghc/docs/users_guide/prof-output.lit
new file mode 100644 (file)
index 0000000..a246b38
--- /dev/null
@@ -0,0 +1,77 @@
+%
+% Included by profiling.lit
+%
+
+When you run your profiled program with the \tr{-p} RTS option
+\index{\tr{-p<sort> RTS option (profiling)}, you get the following
+information about your ``cost centres'':
+
+\begin{description}
+%-------------------------------------------------------------
+\item[\tr{COST CENTRE}:] The cost-centre's name.
+%-------------------------------------------------------------
+\item[\tr{MODULE}:]
+The module associated with the cost-centre;
+important mostly if you have identically-named cost-centres in
+different modules.
+%-------------------------------------------------------------
+\item[\tr{scc}:]
+How many times this cost-centre was entered; think
+of it as ``I got to the \tr{_scc_} construct this many times...''
+%-------------------------------------------------------------
+\item[\tr{subcc}:]
+How many times this cost-centre ``passed control'' to another
+cost-centre; for example, \tr{scc=4} plus \tr{subscc=8} means
+``This \tr{_scc_} was entered four times, but went out to
+other \tr{_scc_s} eight times.''
+%-------------------------------------------------------------
+\item[\tr{%time}:]
+What part of the time was spent in this cost-centre (see also ``ticks,''
+below).
+%-------------------------------------------------------------
+\item[\tr{%alloc}:]
+What part of the memory allocation was done in this cost-centre
+(see also ``bytes,'' below).
+\end{description}
+
+If you use the \tr{-P} RTS option
+\index{\tr{-P<sort> RTS option (profiling)}, you will also get the
+following information:
+\begin{description}
+%-------------------------------------------------------------
+\item[\tr{cafcc}:] Two columns, analogous to the \tr{scc} and \tr{subcc}
+columns, except these are for CAF cost-centres: the first column
+is how many times this top-level CAF cost-centre was entered;
+the second column is how many times this cost-centre (CAF or otherwise)
+entered another CAF cost-centre.
+%-------------------------------------------------------------
+\item[\tr{thunks}:]
+How many times we entered (evaluated) a thunk---an unevaluated
+object in the heap---while we were in this cost-centre.
+%-------------------------------------------------------------
+\item[\tr{funcs}:]
+How many times we entered (evaluated) a function while we we in this
+cost-centre.  (In Haskell, functions are first-class values and may be
+passed as arguments, returned as results, evaluated, and generally
+manipulated just like data values)
+%-------------------------------------------------------------
+\item[\tr{PAPs}:]
+How many times we entered (evaluated) a partial application (PAP), i.e.,
+a function applied to fewer arguments than it needs.  For example, \tr{Int}
+addition applied to one argument would be a PAP.  A PAP is really
+just a particular form for a function.
+%-------------------------------------------------------------
+\item[\tr{closures}:]
+How many heap objects were allocated; these objects may be of varying
+size.  If you divide the number of bytes (mentioned below) by this
+number of ``closures'', then you will get the average object size.
+(Not too interesting, but still...)
+%-------------------------------------------------------------
+\item[\tr{ticks}:]  The raw number of time ``ticks'' which were
+attributed to this cost-centre; from this, we get the \tr{%time}
+figure mentioned above.
+%-------------------------------------------------------------
+\item[\tr{bytes}:] Number of bytes allocated in the heap while in
+this cost-centre; again, this is the raw number from which we
+get the \tr{%alloc} figure mentioned above.
+\end{description}
index e98cdb5..68d4a7e 100644 (file)
@@ -96,6 +96,15 @@ system.  Just visit the Glasgow FP Web page...
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
+\subsection[prof-output]{What's in a profiling report?}
+\index{profiling report, meaning thereof}
+%*                                                                     *
+%************************************************************************
+
+\input{prof-output.lit}
+
+%************************************************************************
+%*                                                                     *
 \subsection[prof-graphs]{Producing graphical heap profiles}
 \index{heap profiles, producing}
 %*                                                                     *
 \subsection[prof-graphs]{Producing graphical heap profiles}
 \index{heap profiles, producing}
 %*                                                                     *
index db7c4fd..f44a836 100644 (file)
@@ -187,7 +187,14 @@ recommended for everyday use!
 \item[\tr{-B}:]
 \index{-B RTS option}
 Sound the bell at the start of each (major) garbage collection.
 \item[\tr{-B}:]
 \index{-B RTS option}
 Sound the bell at the start of each (major) garbage collection.
-[Why anyone would do this, I cannot imagine.]
+
+Oddly enough, people really do use this option!  Our pal in Durham
+(England), PaulCallaghan, writes: ``Some people here use it for a
+variety of purposes---honestly!---e.g., confirmation that the
+code/machine is doing something, infinite loop detection, gauging cost
+of recently added code. Certain people can even tell what stage [the
+program] is in by the beep pattern. But the major use is for annoying
+others in the same office...''
 
 \item[\tr{-I}:]
 Use the ``debugging mini-interpreter'' with sanity-checking; you have
 
 \item[\tr{-I}:]
 Use the ``debugging mini-interpreter'' with sanity-checking; you have
index a7f535c..361ea84 100644 (file)
@@ -320,6 +320,12 @@ gives the strictness of the function's arguments.  \tr{L} is lazy
 \tr{U(...)} is strict and
 ``unpackable'' (very good), and \tr{A} is absent (very good).
 
 \tr{U(...)} is strict and
 ``unpackable'' (very good), and \tr{A} is absent (very good).
 
+For an ``unpackable'' \tr{U(...)} argument, the info inside
+tells the strictness of its components.  So, if the argument is a
+pair, and it says \tr{U(AU(LSS))}, that means ``the first component of the
+pair isn't used; the second component is itself unpackable, with three
+components (lazy in the first, strict in the second \& third).''
+
 If the function isn't exported, just compile with the extra flag \tr{-ddump-simpl};
 next to the signature for any binder, it will print the self-same
 pragmatic information as would be put in an interface file.
 If the function isn't exported, just compile with the extra flag \tr{-ddump-simpl};
 next to the signature for any binder, it will print the self-same
 pragmatic information as would be put in an interface file.
index 4e7f653..97e9100 100644 (file)
@@ -10,7 +10,7 @@ DYN_LOADABLE_BITS = \
        ghc-asm-sparc.prl \
        ghc-asm-solaris.prl \
        ghc-asm-m68k.prl \
        ghc-asm-sparc.prl \
        ghc-asm-solaris.prl \
        ghc-asm-m68k.prl \
-       ghc-asm-iX86.prl \
+       ghc-asm.prl \
        ghc-asm-alpha.prl \
        ghc-asm-hppa.prl \
        ghc-asm-mips.prl \
        ghc-asm-alpha.prl \
        ghc-asm-hppa.prl \
        ghc-asm-mips.prl \
index 76f9817..23ee45a 100644 (file)
@@ -57,30 +57,6 @@ sub mangle_asm {
        } elsif ( /\.\.ng:$/ ) { # Local labels not to be confused with new chunks
            $chk[$i] .= $_;
 
        } elsif ( /\.\.ng:$/ ) { # Local labels not to be confused with new chunks
            $chk[$i] .= $_;
 
-       } elsif ( /^(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
        } elsif ( /^\$C(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
        } elsif ( /^\$C(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
@@ -97,6 +73,8 @@ sub mangle_asm {
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
@@ -138,6 +116,30 @@ sub mangle_asm {
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
+       } elsif ( /^(ret_|djn_)/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
        } elsif ( /^[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
        } elsif ( /^[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
@@ -304,6 +306,12 @@ sub mangle_asm {
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /\.quad\s+([A-Za-z0-9_]+_entry)$/
+                 && $1 ne "${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
+
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
@@ -316,6 +324,9 @@ sub mangle_asm {
                    $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
                }
 
                    $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
                }
 
+               # NB: no very good way to look for "dangling" references
+               # to fast-entry pt
+
                print OUTASM "\.text\n\t\.align 3\n";
                print OUTASM $c;
                $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
                print OUTASM "\.text\n\t\.align 3\n";
                print OUTASM $c;
                $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
index 7515b3a..1032a36 100644 (file)
@@ -86,30 +86,6 @@ sub mangle_asm {
            $chkcat[$i] = 'literal';
            $chksymb[$i] = $1;
 
            $chkcat[$i] = 'literal';
            $chksymb[$i] = $1;
 
-       } elsif ( /^(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^vtbl_([A-Za-z0-9_]+)$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^([A-Za-z0-9_]+)DirectReturn$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^[A-Za-z0-9_]+_upd$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
        } elsif ( /^__stg_split_marker(\d+)$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'splitmarker';
        } elsif ( /^__stg_split_marker(\d+)$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'splitmarker';
@@ -121,6 +97,8 @@ sub mangle_asm {
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry$/ ) {
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry$/ ) {
@@ -167,6 +145,30 @@ sub mangle_asm {
            $chkcat[$i] = 'bss';
            $chksymb[$i] = $1;
 
            $chkcat[$i] = 'bss';
            $chksymb[$i] = $1;
 
+       } elsif ( /^(ret_|djn_)/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^vtbl_([A-Za-z0-9_]+)$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^([A-Za-z0-9_]+)DirectReturn$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^[A-Za-z0-9_]+_upd$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
        } elsif ( /^[A-Za-z0-9_]/ && ! /^L\$\d+$/) {
            local($thing);
            chop($thing = $_);
        } elsif ( /^[A-Za-z0-9_]/ && ! /^L\$\d+$/) {
            local($thing);
            chop($thing = $_);
@@ -339,10 +341,12 @@ sub mangle_asm {
                print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
                print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
-#              if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
-#                && $1 ne "_${symb}_entry" ) {
-#                  print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
-#              }
+
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
+                 && $1 ne "${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
@@ -356,6 +360,9 @@ sub mangle_asm {
                    $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
                }
 
                    $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
                }
 
+               # ToDo: ???? any good way to look for "dangling" references
+               # to fast-entry pt ???
+
                print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
                print OUTASM $c;
                $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
                print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
                print OUTASM $c;
                $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
diff --git a/ghc/driver/ghc-asm-iX86.lprl b/ghc/driver/ghc-asm-iX86.lprl
deleted file mode 100644 (file)
index 941ff68..0000000
+++ /dev/null
@@ -1,640 +0,0 @@
-%************************************************************************
-%*                                                                     *
-\section[Driver-asm-fiddling]{Fiddling with assembler files (iX86)}
-%*                                                                     *
-%************************************************************************
-
-Tasks:
-\begin{itemize}
-\item
-Utterly stomp out C functions' prologues and epilogues; i.e., the
-stuff to do with the C stack.
-\item
-Any other required tidying up.
-\end{itemize}
-
-\begin{code}
-sub mangle_asm {
-    local($in_asmf, $out_asmf) = @_;
-
-    # multi-line regexp matching:
-    local($*) = 1;
-    local($i, $c);
-    &init_FUNNY_THINGS();
-
-    open(INASM, "< $in_asmf")
-       || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
-    open(OUTASM,"> $out_asmf")
-       || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
-
-    # read whole file, divide into "chunks":
-    #  record some info about what we've found...
-
-    @chk = ();         # contents of the chunk
-    $numchks = 0;      # number of them
-    @chkcat = ();      # what category of thing in each chunk
-    @chksymb = ();     # what symbol(base) is defined in this chunk
-    %slowchk = ();     # ditto, its regular "slow" entry code
-    %fastchk = ();     # ditto, fast entry code
-    %closurechk = ();  # ditto, the (static) closure
-    %infochk = ();     # given a symbol base, say what chunk its info tbl is in
-    %vectorchk = ();    # ditto, return vector table
-    %directchk = ();    # ditto, direct return code
-
-    $i = 0;
-    $chkcat[0] = 'misc';
-
-    while (<INASM>) {
-#???   next if /^\.stab.*___stg_split_marker/;
-#???   next if /^\.stab.*ghc.*c_ID/;
-       next if /^#(NO_)?APP/;
-
-       if ( /^\s+/ ) { # most common case first -- a simple line!
-           # duplicated from the bottom
-
-           $chk[$i] .= $_;
-
-       } elsif ( /^_(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^LC(\d+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'string';
-           $chksymb[$i] = $1;
-
-       } elsif ( /^___stg_split_marker(\d+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'splitmarker';
-           $chksymb[$i] = $1;
-
-       } elsif ( /^_([A-Za-z0-9_]+)_info:$/ ) {
-           $symb = $1;
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'infotbl';
-           $chksymb[$i] = $symb;
-
-           $infochk{$symb} = $i;
-
-       } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'slow';
-           $chksymb[$i] = $1;
-
-           $slowchk{$1} = $i;
-
-       } elsif ( /^_([A-Za-z0-9_]+)_fast\d+:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'fast';
-           $chksymb[$i] = $1;
-
-           $fastchk{$1} = $i;
-
-       } elsif ( /^_([A-Za-z0-9_]+)_closure:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'closure';
-           $chksymb[$i] = $1;
-
-           $closurechk{$1} = $i;
-
-       } elsif ( /^_ghc.*c_ID:/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'consist';
-
-       } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.):/ ) {
-           ; # toss it
-
-       } elsif ( /^_ErrorIO_call_count:/        # HACK!!!!
-              || /^_[A-Za-z0-9_]+\.\d+:$/
-              || /^_.*_CAT:/                   # PROF: _entryname_CAT
-              || /^_CC_.*_struct:/             # PROF: _CC_ccident_struct
-              || /^_.*_done:/                  # PROF: _module_done
-              || /^__module_registered:/       # PROF: _module_registered
-              ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'data';
-           $chksymb[$i] = '';
-
-       } elsif ( /^_[A-Za-z0-9_]/ ) {
-           local($thing);
-           chop($thing = $_);
-           print STDERR "Funny global thing?: $_"
-               unless $KNOWN_FUNNY_THING{$thing}
-                   || /^__(PRIn|PRStart).*:/   # pointer reversal GC routines
-                   || /^_CC_.*:/               # PROF: _CC_ccident
-                   || /^__reg.*:/;             # PROF: __reg<module>
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } else { # simple line (duplicated at the top)
-
-           $chk[$i] .= $_;
-       }
-    }
-    $numchks = $#chk + 1;
-
-    # the division into chunks is imperfect;
-    # we throw some things over the fence into the next
-    # chunk.
-    #
-    # also, there are things we would like to know
-    # about the whole module before we start spitting
-    # output.
-
-    # NB: we start meddling at chunk 1, not chunk 0
-
-    for ($i = 1; $i < $numchks; $i++) {
-       $c = $chk[$i]; # convenience copy
-
-#      print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
-
-       # toss all prologue stuff;
-       # be slightly paranoid to make sure there's
-       # nothing surprising in there
-       if ( $c =~ /--- BEGIN ---/ ) {
-           if (($p, $r) = split(/--- BEGIN ---/, $c)) {
-               $p =~ s/^\tpushl \%edi\n//;
-               $p =~ s/^\tpushl \%esi\n//;
-               $p =~ s/^\tsubl \$\d+,\%esp\n//;
-               die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
-
-               # glue together what's left
-               $c = $p . $r;
-           }
-       }
-
-       # toss all epilogue stuff; again, paranoidly
-       if ( $c =~ /--- END ---/ ) {
-           if (($r, $e) = split(/--- END ---/, $c)) {
-               $e =~ s/^\tret\n//;
-               $e =~ s/^\tpopl \%edi\n//;
-               $e =~ s/^\tpopl \%esi\n//;
-               $e =~ s/^\taddl \$\d+,\%esp\n//;
-               die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
-
-               # glue together what's left
-               $c = $r . $e;
-           }
-       }
-
-       # toss all calls to __DISCARD__
-       $c =~ s/^\tcall ___DISCARD__\n//g;
-
-       # pin a funny end-thing on (for easier matching):
-       $c .= 'FUNNY#END#THING';
-
-       # pick some end-things and move them to the next chunk
-
-       while ( $c =~ /^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.stab[^n].*\n)FUNNY#END#THING/ ) {
-           $to_move = $1;
-
-           if ( $to_move =~ /\.(globl|stab)/ && $i < ($numchks - 1) ) {
-               $chk[$i + 1] = $to_move . $chk[$i + 1];
-               # otherwise they're tossed
-           }
-
-           $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
-       }
-
-       $c =~ s/FUNNY#END#THING//;
-       $chk[$i] = $c; # update w/ convenience copy
-    }
-
-    # print out all the literal strings first
-    for ($i = 0; $i < $numchks; $i++) {
-       if ( $chkcat[$i] eq 'string' ) {
-           print OUTASM "\.text\n\t\.align 4\n";
-            # not sure what alignment is required (WDP 95/02)
-            # .align 4 (on 16-byte boundaries) is 486-cache friendly
-           print OUTASM $chk[$i];
-           
-           $chkcat[$i] = 'DONE ALREADY';
-       }
-    }
-
-    for ($i = 0; $i < $numchks; $i++) {
-#      print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
-
-       next if $chkcat[$i] eq 'DONE ALREADY';
-
-       if ( $chkcat[$i] eq 'misc' ) {
-           print OUTASM "\.text\n\t\.align 4\n";
-           &print_doctored($chk[$i], 0);
-
-       } elsif ( $chkcat[$i] eq 'data' ) {
-           print OUTASM "\.data\n\t\.align 2\n"; # ToDo: change align??
-           print OUTASM $chk[$i];
-
-       } elsif ( $chkcat[$i] eq 'consist' ) {
-           if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
-               local($consist) = "$1.$2.$3";
-               $consist =~ s/,/./g;
-               $consist =~ s/\//./g;
-               $consist =~ s/-/_/g;
-               $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
-               print OUTASM "\.text\n$consist:\n";
-           } else {
-               print STDERR "Couldn't grok consistency: ", $chk[$i];
-           }
-
-       } elsif ( $chkcat[$i] eq 'splitmarker' ) {
-           # we can just re-constitute this one...
-           print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
-
-       } elsif ( $chkcat[$i] eq 'closure'
-              || $chkcat[$i] eq 'infotbl'
-              || $chkcat[$i] eq 'slow'
-              || $chkcat[$i] eq 'fast' ) { # do them in that order
-           $symb = $chksymb[$i];
-
-           # CLOSURE
-           if ( defined($closurechk{$symb}) ) {
-               print OUTASM "\.data\n\t\.align 2\n"; # ToDo: change align?
-               print OUTASM $chk[$closurechk{$symb}];
-               $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
-           }
-
-           # INFO TABLE
-           if ( defined($infochk{$symb}) ) {
-
-               print OUTASM "\.text\n\t\.align 4\n"; # NB: requires padding
-               print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
-               # entry code will be put here!
-
-               $chkcat[$infochk{$symb}] = 'DONE ALREADY';
-           }
-
-           # STD ENTRY POINT
-           if ( defined($slowchk{$symb}) ) {
-
-               # teach it to drop through to the fast entry point:
-               $c = $chk[$slowchk{$symb}];
-               $c =~ s/^\tmovl \$_${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
-               $c =~ s/^\tmovl \$_${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
-
-               print STDERR "still has jump to fast entry point:\n$c"
-                   if $c =~ /_${symb}_fast/;
-
-               print OUTASM "\.text\n\t\.align 4\n";
-               &print_doctored($c, 1); # NB: the 1!!!
-               $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
-           }
-           
-           # FAST ENTRY POINT
-           if ( defined($fastchk{$symb}) ) {
-               print OUTASM "\.text\n\t\.align 4\n"; # Fills w/ no-ops!
-               &print_doctored($chk[$fastchk{$symb}], 0);
-               $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
-           }
-
-       } elsif ( $chkcat[$i] eq 'vector'
-              || $chkcat[$i] eq 'direct' ) { # do them in that order
-           $symb = $chksymb[$i];
-
-           # VECTOR TABLE
-           if ( defined($vectorchk{$symb}) ) {
-               print OUTASM "\.text\n\t\.align 4\n"; # NB: requires padding
-               print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
-               # direct return code will be put here!
-               $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
-           }
-
-           # DIRECT RETURN
-           if ( defined($directchk{$symb}) ) {
-               print OUTASM "\.text\n\t\.align 4\n";
-               &print_doctored($chk[$directchk{$symb}], 0);
-               $chkcat[$directchk{$symb}] = 'DONE ALREADY';
-           }
-           
-       } else {
-           &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm iX86)\n$chkcat[$i]\n$chk[$i]\n");
-       }
-    }
-    # finished
-    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
-    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
-}
-\end{code}
-
-\begin{code}
-sub print_doctored {
-    local($_, $need_fallthru_patch) = @_;
-
-    if ( ! /^\t[a-z]/ ) { # no instructions in here, apparently
-       print OUTASM $_;
-
-    } else { # must do some **HACKING**
-       local($entry_patch)     = '';
-       local($exit_patch)      = '';
-       local($call_entry_patch)= '';
-       local($call_exit_patch) = '';
-       local($sp_entry_patch)  = '';
-       local($sp_exit_patch)   = '';
-
-       # gotta watch out for weird instructions that
-       # invisibly smash various regs:
-       #   rep*        %ecx used for counting
-       #   scas*       %edi used for destination index
-       #   cmps*       %e[sd]i used for indices
-       #   loop*       %ecx used for counting
-       #
-       # SIGH.
-       print STDERR "WEIRD INSN!\n$_" if /^\t(rep|scas|loop|cmps)/;
-
-       # WDP: this still looks highly dubious to me. 95/07
-       # We cater for:
-       #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
-       #  * some secret uses of machine reg, requiring STG reg
-       #    to be saved/restored
-       #  * but what about totally-unexpected uses of machine reg?
-       #    (maybe I've forgotten how this works...)
-
-       if ( $StolenX86Regs < 3
-            && ( /32\(\%ebx\)/ || /^\tcmps/ ) ) { # R1 (esi)
-           $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
-           $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
-           # nothing for call_{entry,exit} because %esi is callee-save
-       }
-       if ( $StolenX86Regs < 4
-            && ( /64\(\%ebx\)/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
-           $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
-           $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
-           # nothing for call_{entry,exit} because %edi is callee-save
-       }
-       if ( $StolenX86Regs < 5
-            && ( /36\(\%ebx\)/ || /^\t(rep|loop)/ ) ) { # R2 (ecx)
-           $entry_patch .= "\tmovl \%ecx,36(\%ebx)\n";
-           $exit_patch  .= "\tmovl 36(\%ebx),\%ecx\n";
-
-           $call_exit_patch  .= "\tmovl \%ecx,108(\%ebx)\n";
-           $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
-       }
-       # first, convert calls to *very magic form*: (ToDo: document for real!)
-       # from
-       #       pushl $768
-       #       call _PerformGC_wrapper
-       #       addl $4,%esp
-       # to
-       #       movl $768, %eax
-       #       call _PerformGC_wrapper
-       #
-       # Special macros in ghc/includes/COptWraps.lh, used in
-       # ghc/runtime/CallWrap_C.lc, are required for this to work!
-       #
-       s/^\tpushl \$(\d+)\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \$$1,\%eax\n\tmovl \$L$2a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$2a:\n__SP_ENTRY_PATCH__L$2:\n/g;
-       s/^\tpushl \%eax\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \$L$1a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$1a:\n__SP_ENTRY_PATCH__L$1:\n/g;
-
-       s/^\tpushl \%edx\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \%edx,\%eax\n\tmovl \$L$1a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$1a:\n__SP_ENTRY_PATCH__L$1:\n/g;
-
-       if ( $StolenX86Regs < 5 ) { # %ecx is ordinary reg
-           s/^\tpushl \%ecx\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \%ecx,\%eax\n\tmovl \$L$1a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$1a:\n__SP_ENTRY_PATCH__L$1:\n/g;
-       }
-
-       die "PerformGC_wrapper still alive!\n$_" if / _PerformGC_wrapper/;
-
-       # --------------------------------------------------------
-       # OK, now acct for the fact that %esp holds Hp on entry;
-       #
-       # * must hold C-stack ptr if we go to C
-       # * must get Hp ( 80(%ebx) ) back in it if we come back from C
-       # * must hold Hp when we go on to the next guy
-       # * don't worry about PerformGC_wrapper -- it is magic
-       # * we have a "save location" for %esp ( 100(%ebx) )
-       # * because C-stack ptr doesn't change in Haskell-land,
-       #   we don't have to save it -- just restore it when
-       #   necessary.
-       #
-    if ( $SpX86Mangling ) { # NB: not used in RTS
-       if ( /(\tcall |\tpushl |\%esp)/ ) { # *anything* C-stack-ish...
-           # then we patch up...
-           $sp_entry_patch  = "\tmovl \%esp,80(\%ebx)\n\tmovl 100(\%ebx),%esp\n";
-           $sp_exit_patch   = "\tmovl 80(\%ebx),\%esp\n";
-
-       } elsif ( /80\(\%ebx\)/ ) { # no C-stack stuff: try to squash Hp refs!
-           $sp_entry_patch = '';
-           $sp_exit_patch = '';
-
-           # mangle heap-check code
-
-           s/\tmovl 80\(\%ebx\),%eax\n\taddl \$(\d+),\%eax\n\tmovl \%eax,80\(\%ebx\)\n\tcmpl \%eax,84\(\%ebx\)\n/\taddl \$$1,\%esp\n\tcmpl \%esp,84\(\%ebx\)\n/g;
-
-           # mangle other Hp refs
-           s/80\(\%ebx\)/\%esp/g;
-
-           # squash some repeated reloadings of Hp
-           while ( /\tmovl \%esp,\%eax\n\t([a-z].*)\n\tmovl \%esp,\%eax\n/ ) {
-               local($x) = $1;
-               $x =~ s/\%eax/\%esp/g;
-               s/\tmovl \%esp,\%eax\n\t([a-z].*)\n\tmovl \%esp,\%eax\n/\t$x\n\tmovl \%esp,\%eax\n/;
-           }
-
-           while ( /\tmovl \%esp,\%edx\n\t([a-z].*)\n\tmovl \%esp,\%edx\n/ ) {
-               local($x) = $1;
-               $x =~ s/\%edx/\%esp/g;
-               s/\tmovl \%esp,\%edx\n\t([a-z].*)\n\tmovl \%esp,\%edx\n/\t$x\n\tmovl \%esp,\%edx\n/;
-           }
-
-           if ( $StolenX86Regs < 5 ) { # %ecx is ordinary reg
-               while ( /\tmovl \%esp,\%ecx\n\t([a-z].*)\n\tmovl \%esp,\%ecx\n/ ) {
-                   local($x) = $1;
-                   $x =~ s/\%ecx/\%esp/g;
-                   s/\tmovl \%esp,\%ecx\n\t([a-z].*)\n\tmovl \%esp,\%ecx\n/\t$x\n\tmovl \%esp,\%ecx\n/;
-               }
-           }
-
-           s/\tmovl \%esp,\%eax\n\tmovl \%eax,\%edx\n\taddl \$-(\d+),\%edx\n\tmovl \%edx,(-\d+)?\(\%eax\)\n/\tmovl \%esp,\%edx\n\taddl \$-$1,\%edx\n\tmovl \%edx,$2\(\%esp\)\n/g;
-
-       }
-    }
-
-       # --------------------------------------------------------
-       # next, here we go with non-%esp patching!
-       #
-       s/^(\t[a-z])/$sp_entry_patch$entry_patch$1/; # before first instruction
-       s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
-
-       if ($StolenX86Regs == 2 ) { # YURGH! spurious uses of esi,edi,ecx?
-           s/^(\tjmp .*)(\%esi|\%edi|\%ecx)(.*\n)/\tmovl $2,\%eax\n$1\%eax$3/g;
-       } elsif ($StolenX86Regs == 3 ) { # spurious uses of edi,ecx?
-           s/^(\tjmp .*)(\%edi|\%ecx)(.*\n)/\tmovl $2,\%eax\n$1\%eax$3/g;
-       } elsif ($StolenX86Regs == 4 ) { # spurious uses of ecx?
-           s/^(\tjmp .*)(\%ecx)(.*\n)/\tmovl $2,\%eax\n$1\%eax$3/g;
-       }
-
-       s/^\tjmp \*L/\tJMP___L/g;
-
-#testing:
-#      while ( /^(\tjmp (\*)?[^L].*\n)/ && $sp_exit_patch ) {
-#          print STDERR "Converting\n$1to\n$sp_exit_patch$exit_patch$1";
-#          s/^(\tjmp)( (\*)?[^L].*\n)/$sp_exit_patch$exit_patch\tJMPME$2/;
-#      }
-
-       # fix _all_ non-local jumps
-       s/^(\tjmp (\*)?[^L].*\n)/$sp_exit_patch$exit_patch$1/g;
-
-#test: s/JMPME/jmp /g;
-
-       s/^\tJMP___L/\tjmp \*L/g;
-
-       # fix post-PerformGC wrapper (re-)entries
-       s/__SP_ENTRY_PATCH__/$sp_entry_patch/g;
-
-       if ($StolenX86Regs == 2 ) {
-           die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_" 
-               if /^\t(jmp|call) .*\%e(si|di|cx)/;
-       } elsif ($StolenX86Regs == 3 ) {
-           die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_" 
-               if /^\t(jmp|call) .*\%e(di|cx)/;
-       } elsif ($StolenX86Regs == 4 ) {
-           die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_" 
-               if /^\t(jmp|call) .*\%ecx/;
-       }
-
-       # final peephole fix
-       s/^\tmovl 36\(\%ebx\),\%ecx\n\tjmp \*36\(\%ebx\)\n/\tmovl 36\(\%ebx\),\%ecx\n\tjmp \*\%ecx\n/;
-
-       # --------------------------------------------------------
-       # that's it -- print it
-       #
-       die "Funny jumps?\n$_" if /^\tjmp [^L\*]/; # paranoia
-
-       print OUTASM $_;
-
-       if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
-           print OUTASM $sp_exit_patch, $exit_patch;
-           # ToDo: make it not print if there is a "jmp" at the end
-       }
-    }
-}
-\end{code}
-
-\begin{code}
-sub init_FUNNY_THINGS {
-    %KNOWN_FUNNY_THING = (
-       '_CheckHeapCode:', 1,
-       '_CommonUnderflow:', 1,
-       '_Continue:', 1,
-       '_EnterNodeCode:', 1,
-       '_ErrorIO_call_count:', 1,
-       '_ErrorIO_innards:', 1,
-       '_IndUpdRetDir:', 1,
-       '_IndUpdRetV0:', 1,
-       '_IndUpdRetV1:', 1,
-       '_IndUpdRetV2:', 1,
-       '_IndUpdRetV3:', 1,
-       '_IndUpdRetV4:', 1,
-       '_IndUpdRetV5:', 1,
-       '_IndUpdRetV6:', 1,
-       '_IndUpdRetV7:', 1,
-       '_PrimUnderflow:', 1,
-       '_StackUnderflowEnterNode:', 1,
-       '_StdErrorCode:', 1,
-       '_UnderflowVect0:', 1,
-       '_UnderflowVect1:', 1,
-       '_UnderflowVect2:', 1,
-       '_UnderflowVect3:', 1,
-       '_UnderflowVect4:', 1,
-       '_UnderflowVect5:', 1,
-       '_UnderflowVect6:', 1,
-       '_UnderflowVect7:', 1,
-       '_UpdErr:', 1,
-       '_UpdatePAP:', 1,
-       '_WorldStateToken:', 1,
-       '__Enter_Internal:', 1,
-       '__PRMarking_MarkNextAStack:', 1,
-       '__PRMarking_MarkNextBStack:', 1,
-       '__PRMarking_MarkNextCAF:', 1,
-       '__PRMarking_MarkNextGA:', 1,
-       '__PRMarking_MarkNextRoot:', 1,
-       '__PRMarking_MarkNextSpark:', 1,
-       '__Scavenge_Forward_Ref:', 1,
-       '___std_entry_error__:', 1,
-       '__startMarkWorld:', 1,
-       '_resumeThread:', 1,
-       '_startCcRegisteringWorld:', 1,
-       '_startEnterFloat:', 1,
-       '_startEnterInt:', 1,
-       '_startPerformIO:', 1,
-       '_startStgWorld:', 1,
-       '_stopPerformIO:', 1
-    );
-}
-\end{code}
-
-The following table reversal is used for both info tables and return
-vectors.  In both cases, we remove the first entry from the table,
-reverse the table, put the label at the end, and paste some code
-(that which is normally referred to by the first entry in the table)
-right after the table itself.  (The code pasting is done elsewhere.)
-
-\begin{code}
-sub rev_tbl {
-    local($symb, $tbl, $discard1) = @_;
-
-    local($before) = '';
-    local($label) = '';
-    local(@words) = ();
-    local($after) = '';
-    local(@lines) = split(/\n/, $tbl);
-    local($i, $extra, $words_to_pad, $j);
-
-    for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) {
-       $label .= $lines[$i] . "\n",
-           next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/
-                || $lines[$i] =~ /^\.globl/
-                || $lines[$i] =~ /^_vtbl_\S+:$/;
-
-       $before .= $lines[$i] . "\n"; # otherwise...
-    }
-
-    for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) {
-       push(@words, $lines[$i]);
-    }
-    # now throw away the first word (entry code):
-    shift(@words) if $discard1;
-
-    # for 486-cache-friendliness, we want our tables aligned
-    # on 16-byte boundaries (.align 4).  Let's pad:
-    $extra = ($#words + 1) % 4;
-    $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
-    for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t\.long 0"); }
-
-    for (; $i <= $#lines; $i++) {
-       $after .= $lines[$i] . "\n";
-    }
-
-    $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
-
-#   print STDERR "before=$before\n";
-#   print STDERR "label=$label\n";
-#   print STDERR "words=",(reverse @words),"\n";
-#   print STDERR "after=$after\n";
-
-    $tbl;
-}
-
-# make "require"r happy...
-1;
-
-\end{code}
index c89d95f..e3a1431 100644 (file)
@@ -54,30 +54,6 @@ sub mangle_asm {
 
            $chk[$i] .= $_;
 
 
            $chk[$i] .= $_;
 
-       } elsif ( /^_(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
        } elsif ( /^LC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
        } elsif ( /^LC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
@@ -94,6 +70,8 @@ sub mangle_asm {
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
            $infochk{$symb} = $i;
 
        } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
            $infochk{$symb} = $i;
 
        } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
@@ -135,6 +113,30 @@ sub mangle_asm {
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
+       } elsif ( /^_(ret_|djn_)/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
        } elsif ( /^_[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
        } elsif ( /^_[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
@@ -282,6 +284,12 @@ sub mangle_asm {
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /\.long\s+([A-Za-z0-9_]+_entry)$/
+                 && $1 ne "_${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
+
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
@@ -290,11 +298,14 @@ sub mangle_asm {
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
-               $c =~ s/^\tjmp _${symb}_fast\d+.*\n\tnop\n//;
-               $c =~ s/^\tjmp _${symb}_fast\d+.*\n//;
+
+               if ( defined($fastchk{$symb}) ) {
+                   $c =~ s/^\tjmp _${symb}_fast\d+.*\n\tnop\n//;
+                   $c =~ s/^\tjmp _${symb}_fast\d+.*\n//;
+               }
 
                print STDERR "still has jump to fast entry point:\n$c"
 
                print STDERR "still has jump to fast entry point:\n$c"
-                   if $c =~ /_${symb}_fast/;
+                   if $c =~ /_${symb}_fast/; # NB: paranoia
 
                print OUTASM "\.text\n\t\.even\n";
                print OUTASM $c;
 
                print OUTASM "\.text\n\t\.even\n";
                print OUTASM $c;
index 635bc10..3c210cb 100644 (file)
@@ -55,30 +55,6 @@ sub mangle_asm {
        } elsif ( /^\d+:/ ) { # a funny-looking very-local label
            $chk[$i] .= $_;
 
        } elsif ( /^\d+:/ ) { # a funny-looking very-local label
            $chk[$i] .= $_;
 
-       } elsif ( /^(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
        } elsif ( /^\$LC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
        } elsif ( /^\$LC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
@@ -95,6 +71,8 @@ sub mangle_asm {
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
@@ -136,6 +114,30 @@ sub mangle_asm {
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
+       } elsif ( /^(ret_|djn_)/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
        } elsif ( /^[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
        } elsif ( /^[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
@@ -265,7 +267,7 @@ sub mangle_asm {
     # print out the header stuff first
     $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
 
     # print out the header stuff first
     $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
 
-    # get rid of horrible "$Revision: 1.1 $" strings
+    # get rid of horrible "<dollar>Revision: .*$" strings
     local(@lines0) = split(/\n/, $chk[0]);
     local($z) = 0;
     while ( $z <= $#lines0 ) {
     local(@lines0) = split(/\n/, $chk[0]);
     local($z) = 0;
     while ( $z <= $#lines0 ) {
@@ -348,6 +350,12 @@ sub mangle_asm {
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
+                 && $1 ne "${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
+
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
@@ -356,10 +364,14 @@ sub mangle_asm {
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
+
                if ( defined($fastchk{$symb}) ) {
                    $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
                }
 
                if ( defined($fastchk{$symb}) ) {
                    $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
                }
 
+               # ToDo??? any good way to look for "dangling" references
+               # to fast-entry pt ???
+
                print OUTASM "\t\.text\n\t\.align 2\n";
                print OUTASM $c;
                $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
                print OUTASM "\t\.text\n\t\.align 2\n";
                print OUTASM $c;
                $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
index e4a3139..6359c66 100644 (file)
@@ -53,30 +53,6 @@ sub mangle_asm {
 
            $chk[$i] .= $_;
 
 
            $chk[$i] .= $_;
 
-       } elsif ( /^(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
        } elsif ( /^\.LLC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
        } elsif ( /^\.LLC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
@@ -93,6 +69,8 @@ sub mangle_asm {
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
            $infochk{$symb} = $i;
 
        } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
@@ -134,6 +112,30 @@ sub mangle_asm {
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
+       } elsif ( /^(ret_|djn_)/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
        } elsif ( /^[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
        } elsif ( /^[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
@@ -269,6 +271,12 @@ sub mangle_asm {
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will be put here!
 
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
+                 && $1 ne "${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
+
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
@@ -277,11 +285,14 @@ sub mangle_asm {
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
-               $c =~ s/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
-               $c =~ s/^\tcall _${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
+
+               if ( defined($fastchk{$symb}) ) {
+                   $c =~ s/^\tcall ${symb}_fast\d+,.*\n\tnop\n//;
+                   $c =~ s/^\tcall ${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
+               }
 
                print STDERR "still has jump to fast entry point:\n$c"
 
                print STDERR "still has jump to fast entry point:\n$c"
-                   if $c =~ /_${symb}_fast/;
+                   if $c =~ /${symb}_fast/; # NB: paranoia
 
                print OUTASM "\.text\n\t\.align 4\n";
                print OUTASM $c;
 
                print OUTASM "\.text\n\t\.align 4\n";
                print OUTASM $c;
index 8560c1a..ffe91ae 100644 (file)
@@ -39,7 +39,6 @@ sub mangle_asm {
     %slowchk = ();     # ditto, its regular "slow" entry code
     %fastchk = ();     # ditto, fast entry code
     %closurechk = ();  # ditto, the (static) closure
     %slowchk = ();     # ditto, its regular "slow" entry code
     %fastchk = ();     # ditto, fast entry code
     %closurechk = ();  # ditto, the (static) closure
-    %num_infos = ();   # this symbol base has this many info tables (1-3)
     %infochk = ();     # given a symbol base, say what chunk its info tbl is in
     %vectorchk = ();    # ditto, return vector table
     %directchk = ();    # ditto, direct return code
     %infochk = ();     # given a symbol base, say what chunk its info tbl is in
     %vectorchk = ();    # ditto, return vector table
     %directchk = ();    # ditto, direct return code
@@ -56,30 +55,6 @@ sub mangle_asm {
 
            $chk[$i] .= $_;
 
 
            $chk[$i] .= $_;
 
-       } elsif ( /^_(ret_|djn_)/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
-       } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'vector';
-           $chksymb[$i] = $1;
-
-           $vectorchk{$1} = $i;
-
-       } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'direct';
-           $chksymb[$i] = $1;
-
-           $directchk{$1} = $i;
-
-       } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
-           $chk[++$i] .= $_;
-           $chkcat[$i] = 'misc';
-           $chksymb[$i] = '';
-
        } elsif ( /^LC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
        } elsif ( /^LC(\d+):$/ ) {
            $chk[++$i] .= $_;
            $chkcat[$i] = 'string';
@@ -96,6 +71,8 @@ sub mangle_asm {
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
            $chkcat[$i] = 'infotbl';
            $chksymb[$i] = $symb;
 
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
            $infochk{$symb} = $i;
 
        } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
            $infochk{$symb} = $i;
 
        } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
@@ -137,6 +114,30 @@ sub mangle_asm {
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
            $chkcat[$i] = 'data';
            $chksymb[$i] = '';
 
+       } elsif ( /^_(ret_|djn_)/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
        } elsif ( /^_[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
        } elsif ( /^_[A-Za-z0-9_]/ ) {
            local($thing);
            chop($thing = $_);
@@ -259,6 +260,12 @@ sub mangle_asm {
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will follow, here!
 
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                # entry code will follow, here!
 
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
+                 && $1 ne "_${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
+
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
                $chkcat[$infochk{$symb}] = 'DONE ALREADY';
            }
 
@@ -267,11 +274,14 @@ sub mangle_asm {
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
 
                # teach it to drop through to the fast entry point:
                $c = $chk[$slowchk{$symb}];
-               $c =~ s/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
-               $c =~ s/^\tcall _${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
+
+               if ( defined($fastchk{$symb}) ) {
+                   $c =~ s/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
+                   $c =~ s/^\tcall _${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
+               }
 
                print STDERR "still has jump to fast entry point:\n$c"
 
                print STDERR "still has jump to fast entry point:\n$c"
-                   if $c =~ /_${symb}_fast/;
+                   if $c =~ /_${symb}_fast/; # NB: paranoia
 
                print OUTASM "\.text\n\t\.align 4\n";
                print OUTASM $c;
 
                print OUTASM "\.text\n\t\.align 4\n";
                print OUTASM $c;
diff --git a/ghc/driver/ghc-asm.lprl b/ghc/driver/ghc-asm.lprl
new file mode 100644 (file)
index 0000000..2643ded
--- /dev/null
@@ -0,0 +1,770 @@
+%************************************************************************
+%*                                                                     *
+\section[Driver-asm-fiddling]{Fiddling with assembler files (iX86)}
+%*                                                                     *
+%************************************************************************
+
+Tasks:
+\begin{itemize}
+\item
+Utterly stomp out C functions' prologues and epilogues; i.e., the
+stuff to do with the C stack.
+\item
+Any other required tidying up.
+\end{itemize}
+
+\begin{code}
+sub init_TARGET_STUFF {
+
+    if ( $TargetPlatform =~ /^i386-.*-linuxaout/ ) {
+
+    $T_STABBY      = 1; # 1 iff .stab things (usually if a.out format)
+    $T_US          = '_'; # _ if symbols have an underscore on the front
+    $T_DO_GC       = '_PerformGC_wrapper';
+    $T_PRE_APP     = '^#'; # regexp that says what comes before APP/NO_APP
+    $T_CONST_LBL    = '^LC(\d+):$';
+    $T_POST_LBL            = ':';
+    $T_PRE_LLBL_PAT = 'L';
+    $T_PRE_LLBL            = 'L';
+    $T_X86_BADJMP   = '^\tjmp [^L\*]';
+
+    $T_MOVE_DIRVS   = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.stab[^n].*\n)';
+    $T_COPY_DIRVS   = '\.(globl|stab)';
+    $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
+    $T_DOT_WORD            = '\.long';
+    $T_HDR_string   = "\.text\n\t\.align 4\n"; # .align 4 is 486-cache friendly
+    $T_HDR_misc            = "\.text\n\t\.align 4\n";
+    $T_HDR_data            = "\.data\n\t\.align 2\n"; # ToDo: change align??
+    $T_HDR_consist  = "\.text\n";
+    $T_HDR_closure  = "\.data\n\t\.align 2\n"; # ToDo: change align?
+    $T_HDR_info            = "\.text\n\t\.align 4\n"; # NB: requires padding
+    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
+    $T_HDR_fast            = "\.text\n\t\.align 4\n";
+    $T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
+    $T_HDR_direct   = "\.text\n\t\.align 4\n";
+
+    } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/ ) {
+
+    $T_STABBY      = 0; # 1 iff .stab things (usually if a.out format)
+    $T_US          = ''; # _ if symbols have an underscore on the front
+    $T_DO_GC       = 'PerformGC_wrapper';
+    $T_PRE_APP     = '/'; # regexp that says what comes before APP/NO_APP
+    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
+    $T_POST_LBL            = ':';
+    $T_PRE_LLBL_PAT = '\.L';
+    $T_PRE_LLBL            = '.L';
+    $T_X86_BADJMP   = '^\tjmp [^\.\*]';
+
+    $T_MOVE_DIRVS   = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.section\s+.*\n|\.type\s+.*\n|\.Lfe.*\n\t\.size\s+.*\n|\.size\s+.*\n|\.ident.*\n)';
+    $T_COPY_DIRVS   = '\.(globl)';
+
+    $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
+    $T_DOT_WORD            = '\.long';
+    $T_HDR_string   = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
+    $T_HDR_misc            = "\.text\n\t\.align 16\n";
+    $T_HDR_data            = "\.data\n\t\.align 4\n"; # ToDo: change align??
+    $T_HDR_consist  = "\.text\n";
+    $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
+    $T_HDR_info            = "\.text\n\t\.align 16\n"; # NB: requires padding
+    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
+    $T_HDR_fast            = "\.text\n\t\.align 16\n";
+    $T_HDR_vector   = "\.text\n\t\.align 16\n"; # NB: requires padding
+    $T_HDR_direct   = "\.text\n\t\.align 16\n";
+    }
+
+if ( 0 ) {
+print STDERR "T_STABBY: $T_STABBY\n";
+print STDERR "T_US: $T_US\n";
+print STDERR "T_DO_GC: $T_DO_GC\n";
+print STDERR "T_PRE_APP: $T_PRE_APP\n";
+print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
+print STDERR "T_POST_LBL: $T_POST_LBL\n";
+print STDERR "T_PRE_LLBL_PAT: $T_PRE_LLBL_PAT\n";
+print STDERR "T_PRE_LLBL: $T_PRE_LLBL\n";
+print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
+
+print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
+print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
+print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
+print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
+print STDERR "T_HDR_string: $T_HDR_string\n";
+print STDERR "T_HDR_misc: $T_HDR_misc\n";
+print STDERR "T_HDR_data: $T_HDR_data\n";
+print STDERR "T_HDR_consist: $T_HDR_consist\n";
+print STDERR "T_HDR_closure: $T_HDR_closure\n";
+print STDERR "T_HDR_info: $T_HDR_info\n";
+print STDERR "T_HDR_entry: $T_HDR_entry\n";
+print STDERR "T_HDR_fast: $T_HDR_fast\n";
+print STDERR "T_HDR_vector: $T_HDR_vector\n";
+print STDERR "T_HDR_direct: $T_HDR_direct\n";
+}
+
+}
+\end{code}
+
+\begin{code}
+sub mangle_asm {
+    local($in_asmf, $out_asmf) = @_;
+
+    # multi-line regexp matching:
+    local($*) = 1;
+    local($i, $c);
+    &init_TARGET_STUFF();
+    &init_FUNNY_THINGS();
+
+    open(INASM, "< $in_asmf")
+       || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
+    open(OUTASM,"> $out_asmf")
+       || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
+
+    # read whole file, divide into "chunks":
+    #  record some info about what we've found...
+
+    @chk = ();         # contents of the chunk
+    $numchks = 0;      # number of them
+    @chkcat = ();      # what category of thing in each chunk
+    @chksymb = ();     # what symbol(base) is defined in this chunk
+    %slowchk = ();     # ditto, its regular "slow" entry code
+    %fastchk = ();     # ditto, fast entry code
+    %closurechk = ();  # ditto, the (static) closure
+    %infochk = ();     # given a symbol base, say what chunk its info tbl is in
+    %vectorchk = ();    # ditto, return vector table
+    %directchk = ();    # ditto, direct return code
+
+    $i = 0;
+    $chkcat[0] = 'misc';
+
+    while (<INASM>) {
+       next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
+       next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
+       next if /${T_PRE_APP}(NO_)?APP/o;
+
+       if ( /^\s+/ ) { # most common case first -- a simple line!
+           # duplicated from the bottom
+
+           $chk[$i] .= $_;
+
+       } elsif ( /$T_CONST_LBL/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'string';
+           $chksymb[$i] = $1;
+
+       } elsif ( /^${T_US}__stg_split_marker(\d+)${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'splitmarker';
+           $chksymb[$i] = $1;
+
+       } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
+           $symb = $1;
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'infotbl';
+           $chksymb[$i] = $symb;
+
+           die "Info table already? $symb; $i\n" if defined($infochk{$symb});
+
+           $infochk{$symb} = $i;
+
+       } elsif ( /^${T_US}([A-Za-z0-9_]+)_entry${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'slow';
+           $chksymb[$i] = $1;
+
+           $slowchk{$1} = $i;
+
+       } elsif ( /^${T_US}([A-Za-z0-9_]+)_fast\d+${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'fast';
+           $chksymb[$i] = $1;
+
+           $fastchk{$1} = $i;
+
+       } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'closure';
+           $chksymb[$i] = $1;
+
+           $closurechk{$1} = $i;
+
+       } elsif ( /^${T_US}ghc.*c_ID${T_POST_LBL}/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'consist';
+
+       } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
+           ; # toss it
+
+       } elsif ( /^${T_US}ErrorIO_call_count${T_POST_LBL}$/o   # HACK!!!!
+              || /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
+              || /^${T_US}.*_CAT${T_POST_LBL}$/o               # PROF: _entryname_CAT
+              || /^${T_US}CC_.*_struct${T_POST_LBL}$/o         # PROF: _CC_ccident_struct
+              || /^${T_US}.*_done${T_POST_LBL}$/o              # PROF: _module_done
+              || /^${T_US}_module_registered${T_POST_LBL}$/o   # PROF: _module_registered
+              ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'data';
+           $chksymb[$i] = '';
+
+       } elsif ( /^${T_US}(ret_|djn_)/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( /^${T_US}vtbl_([A-Za-z0-9_]+)${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'vector';
+           $chksymb[$i] = $1;
+
+           $vectorchk{$1} = $i;
+
+       } elsif ( /^${T_US}([A-Za-z0-9_]+)DirectReturn${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'direct';
+           $chksymb[$i] = $1;
+
+           $directchk{$1} = $i;
+
+       } elsif ( /^${T_US}[A-Za-z0-9_]+_upd${T_POST_LBL}$/o ) {
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
+            &&   /^(_uname|uname|stat|fstat):/ ) {
+           # for some utterly bizarre reason, this platform
+           # likes to drop little local C routines with these names
+           # into each and every .o file that #includes the
+           # relevant system .h file.  Yuck.  We just don't
+           # tolerate them in .hc files (which we are processing
+           # here).  If you need to call one of these things from
+           # Haskell, make a call to your own C wrapper, then
+           # put that C wrapper (which calls one of these) in a
+           # plain .c file.  WDP 95/12
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'toss';
+           $chksymb[$i] = $1;
+
+       } elsif ( /^${T_US}[A-Za-z0-9_]/o ) {
+           local($thing);
+           chop($thing = $_);
+           print STDERR "Funny global thing?: $_"
+               unless $KNOWN_FUNNY_THING{$thing}
+                   || /^${T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o # pointer reversal GC routines
+                   || /^${T_US}CC_.*${T_POST_LBL}$/            # PROF: _CC_ccident
+                   || /^${T_US}_reg.*${T_POST_LBL}$/;          # PROF: __reg<module>
+           $chk[++$i] .= $_;
+           $chkcat[$i] = 'misc';
+           $chksymb[$i] = '';
+
+       } else { # simple line (duplicated at the top)
+
+           $chk[$i] .= $_;
+       }
+    }
+    $numchks = $#chk + 1;
+
+    # the division into chunks is imperfect;
+    # we throw some things over the fence into the next
+    # chunk.
+    #
+    # also, there are things we would like to know
+    # about the whole module before we start spitting
+    # output.
+
+    for ($i = 0; $i < $numchks; $i++) {
+       $c = $chk[$i]; # convenience copy
+
+#      print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
+
+       # toss all prologue stuff;
+       # be slightly paranoid to make sure there's
+       # nothing surprising in there
+       if ( $c =~ /--- BEGIN ---/ ) {
+           if (($p, $r) = split(/--- BEGIN ---/, $c)) {
+               $p =~ s/^\tpushl \%edi\n//;
+               $p =~ s/^\tpushl \%esi\n//;
+               $p =~ s/^\tsubl \$\d+,\%esp\n//;
+               die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
+
+               # glue together what's left
+               $c = $p . $r;
+           }
+       }
+
+       # toss all epilogue stuff; again, paranoidly
+       if ( $c =~ /--- END ---/ ) {
+           if (($r, $e) = split(/--- END ---/, $c)) {
+               $e =~ s/^\tret\n//;
+               $e =~ s/^\tpopl \%edi\n//;
+               $e =~ s/^\tpopl \%esi\n//;
+               $e =~ s/^\taddl \$\d+,\%esp\n//;
+               die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
+
+               # glue together what's left
+               $c = $r . $e;
+           }
+       }
+
+       # toss all calls to __DISCARD__
+       $c =~ s/^\tcall ${T_US}__DISCARD__\n//go;
+
+       # pin a funny end-thing on (for easier matching):
+       $c .= 'FUNNY#END#THING';
+
+       # pick some end-things and move them to the next chunk
+
+       while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
+           $to_move = $1;
+
+           if ( $to_move =~ /${T_COPY_DIRVS}/ && $i < ($numchks - 1) ) {
+               $chk[$i + 1] = $to_move . $chk[$i + 1];
+               # otherwise they're tossed
+           }
+
+           $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
+       }
+
+       $c =~ s/FUNNY#END#THING//;
+
+#      print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
+
+       $chk[$i] = $c; # update w/ convenience copy
+    }
+
+    # print out all the literal strings first
+    for ($i = 0; $i < $numchks; $i++) {
+       if ( $chkcat[$i] eq 'string' ) {
+           print OUTASM $T_HDR_string, $chk[$i];
+           
+           $chkcat[$i] = 'DONE ALREADY';
+       }
+    }
+
+    for ($i = 0; $i < $numchks; $i++) {
+#      print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
+
+       next if $chkcat[$i] eq 'DONE ALREADY';
+
+       if ( $chkcat[$i] eq 'misc' ) {
+           print OUTASM $T_HDR_misc;
+           &print_doctored($chk[$i], 0);
+
+       } elsif ( $chkcat[$i] eq 'toss' ) {
+           print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
+
+       } elsif ( $chkcat[$i] eq 'data' ) {
+           print OUTASM $T_HDR_data;
+           print OUTASM $chk[$i];
+
+       } elsif ( $chkcat[$i] eq 'consist' ) {
+           if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
+               local($consist) = "$1.$2.$3";
+               $consist =~ s/,/./g;
+               $consist =~ s/\//./g;
+               $consist =~ s/-/_/g;
+               $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
+               print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
+           } else {
+               print STDERR "Couldn't grok consistency: ", $chk[$i];
+           }
+
+       } elsif ( $chkcat[$i] eq 'splitmarker' ) {
+           # we can just re-constitute this one...
+           print OUTASM "${T_US}__stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
+
+       } elsif ( $chkcat[$i] eq 'closure'
+              || $chkcat[$i] eq 'infotbl'
+              || $chkcat[$i] eq 'slow'
+              || $chkcat[$i] eq 'fast' ) { # do them in that order
+           $symb = $chksymb[$i];
+
+           # CLOSURE
+           if ( defined($closurechk{$symb}) ) {
+               print OUTASM $T_HDR_closure;
+               print OUTASM $chk[$closurechk{$symb}];
+               $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
+           }
+
+           # INFO TABLE
+           if ( defined($infochk{$symb}) ) {
+
+               print OUTASM $T_HDR_info;
+               print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
+               # entry code will be put here!
+
+               # paranoia
+               if ( $chk[$infochk{$symb}] =~ /${T_DOT_WORD}\s+([A-Za-z0-9_]+_entry)$/o
+                 && $1 ne "${T_US}${symb}_entry" ) {
+                   print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
+               }
+
+               $chkcat[$infochk{$symb}] = 'DONE ALREADY';
+           }
+
+           # STD ENTRY POINT
+           if ( defined($slowchk{$symb}) ) {
+
+               # teach it to drop through to the fast entry point:
+               $c = $chk[$slowchk{$symb}];
+
+               if ( defined($fastchk{$symb}) ) {
+                   $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
+                   $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
+               }
+
+               print STDERR "still has jump to fast entry point:\n$c"
+                   if $c =~ /${T_US}${symb}_fast/; # NB: paranoia
+
+               print OUTASM $T_HDR_entry;
+
+               &print_doctored($c, 1); # NB: the 1!!!
+
+               $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
+           }
+           
+           # FAST ENTRY POINT
+           if ( defined($fastchk{$symb}) ) {
+               print OUTASM $T_HDR_fast;
+               &print_doctored($chk[$fastchk{$symb}], 0);
+               $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
+           }
+
+       } elsif ( $chkcat[$i] eq 'vector'
+              || $chkcat[$i] eq 'direct' ) { # do them in that order
+           $symb = $chksymb[$i];
+
+           # VECTOR TABLE
+           if ( defined($vectorchk{$symb}) ) {
+               print OUTASM $T_HDR_vector;
+               print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
+               # direct return code will be put here!
+               $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
+           }
+
+           # DIRECT RETURN
+           if ( defined($directchk{$symb}) ) {
+               print OUTASM $T_HDR_direct;
+               &print_doctored($chk[$directchk{$symb}], 0);
+               $chkcat[$directchk{$symb}] = 'DONE ALREADY';
+           }
+           
+       } else {
+           &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
+       }
+    }
+    # finished
+    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
+    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
+}
+\end{code}
+
+\begin{code}
+sub print_doctored {
+    local($_, $need_fallthru_patch) = @_;
+
+    if ( $TargetPlatform !~ /^i386-/ 
+      || ! /^\t[a-z]/ ) { # no instructions in here, apparently
+       print OUTASM $_;
+       return;
+    }
+    # OK, must do some x86 **HACKING**
+
+    local($entry_patch)        = '';
+    local($exit_patch) = '';
+    local($call_entry_patch)= '';
+    local($call_exit_patch)    = '';
+
+#OLD:  # first, convert calls to *very magic form*: (ToDo: document
+    # for real!)  from
+    #
+    #  pushl $768
+    #  call _?PerformGC_wrapper
+    #  addl $4,%esp
+    # to
+    #  movl $768, %eax
+    #  call _?PerformGC_wrapper
+    #
+    # The reason we do this now is to remove the apparent use of
+    # %esp, which would throw off the "what patch code do we need"
+    # decision.
+    #
+    # Special macros in ghc/includes/COptWraps.lh, used in
+    # ghc/runtime/CallWrap_C.lc, are required for this to work!
+    #
+
+    s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
+    s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
+    s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
+
+#=  if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
+#=     s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
+#=  }
+
+    # gotta watch out for weird instructions that
+    # invisibly smash various regs:
+    #   rep*   %ecx used for counting
+    #   scas*  %edi used for destination index
+    #   cmps*  %e[sd]i used for indices
+    #   loop*  %ecx used for counting
+    #
+    # SIGH.
+
+    # We cater for:
+    #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
+    #
+    #  * GCC used an "STG reg" for its own purposes
+    #
+    #  * some secret uses of machine reg, requiring STG reg
+    #    to be saved/restored
+
+    # The most dangerous "GCC uses" of an "STG reg" are when
+    # the reg holds the target of a jmp -- it's tricky to
+    # insert the patch-up code before we get to the target!
+    # So here we change the jmps:
+
+    # --------------------------------------------------------
+    # it can happen that we have jumps of the form...
+    #   jmp *<something involving %esp>
+    # or
+    #   jmp <something involving another naughty register...>
+    #
+    # a reasonably-common case is:
+    #
+    #   movl $_blah,<bad-reg>
+    #   jmp  *<bad-reg>
+    #
+    # which is easily fixed as:
+    #
+    # sigh! try to hack around it...
+    #
+
+    if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
+       s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+       s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
+       s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
+       die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
+           if /(jmp|call) .*\%esi/;
+    }
+    if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
+       s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+       s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
+       s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
+       die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
+           if /(jmp|call) .*\%edi/;
+    }
+#=  if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
+#=     s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+#=     s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
+#=     s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
+#=     die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
+#=         if /(jmp|call) .*\%ecx/;
+#=  }
+
+    # OK, now we can decide what our patch-up code is going to
+    # be:
+    if ( $StolenX86Regs <= 2
+        && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
+       $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
+       $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
+       # nothing for call_{entry,exit} because %esi is callee-save
+    }
+    if ( $StolenX86Regs <= 3
+        && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
+       $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
+       $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
+       # nothing for call_{entry,exit} because %edi is callee-save
+    }
+#=  if ( $StolenX86Regs <= 4
+#=      && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
+#=     $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
+#=     $exit_patch  .= "\tmovl 80(\%ebx),\%ecx\n";
+#=
+#=     $call_exit_patch  .= "\tmovl \%ecx,108(\%ebx)\n";
+#=     $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
+#=     # I have a really bad feeling about this if we ever
+#=     # have a nested call...
+#=     # NB: should just hide it somewhere in the C stack.
+#=  }
+    # --------------------------------------------------------
+    # next, here we go with non-%esp patching!
+    #
+    s/^(\t[a-z])/$entry_patch$1/; # before first instruction
+    s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
+
+    # fix _all_ non-local jumps:
+
+    s/^\tjmp \*${T_PRE_LLBL_PAT}/\tJMP___SL/go;
+    s/^\tjmp ${T_PRE_LLBL_PAT}/\tJMP___L/go;
+
+    s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
+
+    s/^\tJMP___SL/\tjmp \*${T_PRE_LLBL}/go;
+    s/^\tJMP___L/\tjmp ${T_PRE_LLBL}/go;
+
+    # fix post-PerformGC wrapper (re-)entries ???
+
+    if ($StolenX86Regs == 2 ) {
+       die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_" 
+           if /^\t(jmp|call) .*\%e(si|di)/;
+#=     die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_" 
+#=         if /^\t(jmp|call) .*\%e(si|di|cx)/;
+    } elsif ($StolenX86Regs == 3 ) {
+       die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_" 
+           if /^\t(jmp|call) .*\%edi/;
+#=     die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_" 
+#=         if /^\t(jmp|call) .*\%e(di|cx)/;
+#=  } elsif ($StolenX86Regs == 4 ) {
+#=     die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_" 
+#=         if /^\t(jmp|call) .*\%ecx/;
+    }
+
+    # final peephole fix
+
+    s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
+
+    # --------------------------------------------------------
+    # that's it -- print it
+    #
+    die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
+
+    print OUTASM $_;
+
+    if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
+       print OUTASM $exit_patch;
+       # ToDo: make it not print if there is a "jmp" at the end
+    }
+}
+\end{code}
+
+\begin{code}
+sub init_FUNNY_THINGS {
+    %KNOWN_FUNNY_THING = (
+       "${T_US}CheckHeapCode${T_POST_LBL}", 1,
+       "${T_US}CommonUnderflow${T_POST_LBL}", 1,
+       "${T_US}Continue${T_POST_LBL}", 1,
+       "${T_US}EnterNodeCode${T_POST_LBL}", 1,
+       "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
+       "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
+       "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
+       "${T_US}PrimUnderflow${T_POST_LBL}", 1,
+       "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
+       "${T_US}StdErrorCode${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect0${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect1${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect2${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect3${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect4${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect5${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect6${T_POST_LBL}", 1,
+       "${T_US}UnderflowVect7${T_POST_LBL}", 1,
+       "${T_US}UpdErr${T_POST_LBL}", 1,
+       "${T_US}UpdatePAP${T_POST_LBL}", 1,
+       "${T_US}WorldStateToken${T_POST_LBL}", 1,
+       "${T_US}_Enter_Internal${T_POST_LBL}", 1,
+       "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
+       "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
+       "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
+       "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
+       "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
+       "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
+       "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
+       "${T_US}__std_entry_error__${T_POST_LBL}", 1,
+       "${T_US}_startMarkWorld${T_POST_LBL}", 1,
+       "${T_US}resumeThread${T_POST_LBL}", 1,
+       "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
+       "${T_US}startEnterFloat${T_POST_LBL}", 1,
+       "${T_US}startEnterInt${T_POST_LBL}", 1,
+       "${T_US}startPerformIO${T_POST_LBL}", 1,
+       "${T_US}startStgWorld${T_POST_LBL}", 1,
+       "${T_US}stopPerformIO${T_POST_LBL}", 1
+    );
+}
+\end{code}
+
+The following table reversal is used for both info tables and return
+vectors.  In both cases, we remove the first entry from the table,
+reverse the table, put the label at the end, and paste some code
+(that which is normally referred to by the first entry in the table)
+right after the table itself.  (The code pasting is done elsewhere.)
+
+\begin{code}
+sub rev_tbl {
+    local($symb, $tbl, $discard1) = @_;
+
+    local($before) = '';
+    local($label) = '';
+    local(@words) = ();
+    local($after) = '';
+    local(@lines) = split(/\n/, $tbl);
+    local($i, $extra, $words_to_pad, $j);
+
+    for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) {
+       $label .= $lines[$i] . "\n",
+           next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/
+                || $lines[$i] =~ /^\.globl/
+                || $lines[$i] =~ /^${T_US}vtbl_\S+:$/;
+
+       $before .= $lines[$i] . "\n"; # otherwise...
+    }
+
+    for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) {
+       push(@words, $lines[$i]);
+    }
+    # now throw away the first word (entry code):
+    shift(@words) if $discard1;
+
+    # for 486-cache-friendliness, we want our tables aligned
+    # on 16-byte boundaries (.align 4).  Let's pad:
+    $extra = ($#words + 1) % 4;
+    $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
+    for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t\.long 0"); }
+
+    for (; $i <= $#lines; $i++) {
+       $after .= $lines[$i] . "\n";
+    }
+
+    $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
+
+#   print STDERR "before=$before\n";
+#   print STDERR "label=$label\n";
+#   print STDERR "words=",(reverse @words),"\n";
+#   print STDERR "after=$after\n";
+
+    $tbl;
+}
+\end{code}
+
+\begin{code}
+sub mini_mangle_asm {
+    local($in_asmf, $out_asmf) = @_;
+
+    &init_TARGET_STUFF();
+
+    open(INASM, "< $in_asmf")
+       || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
+    open(OUTASM,"> $out_asmf")
+       || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
+
+    while (<INASM>) {
+       print OUTASM;
+
+        next unless
+           /^${T_US}(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper${T_POST_LBL}\n/o;
+       print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
+       print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
+    }
+
+    # finished:
+    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
+    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
+}
+
+# make "require"r happy...
+1;
+\end{code}
index 3afe3f5..267315c 100644 (file)
@@ -54,7 +54,7 @@ sub split_asm_file {
 
     %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
 
 
     %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
 
-    $s_stuff = &ReadTMPIUpToAMarker( '' );
+    $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
     # that first stuff is a prologue for all .s outputs
     $prologue_stuff = &process_asm_block ( $s_stuff );
     # $_ already has some of the next stuff in it...
     # that first stuff is a prologue for all .s outputs
     $prologue_stuff = &process_asm_block ( $s_stuff );
     # $_ already has some of the next stuff in it...
@@ -66,14 +66,14 @@ sub split_asm_file {
     $prologue_stuff =~ s|"/tmp/ghc\d+\.c"|"$ifile_root\.hc"|g;
 
     while ( $_ ne '' ) { # not EOF
     $prologue_stuff =~ s|"/tmp/ghc\d+\.c"|"$ifile_root\.hc"|g;
 
     while ( $_ ne '' ) { # not EOF
+       $octr++;
 
        # grab and de-mangle a section of the .s file...
 
        # grab and de-mangle a section of the .s file...
-       $s_stuff = &ReadTMPIUpToAMarker ( $_ );
+       $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
        $this_piece = &process_asm_block ( $s_stuff );
 
        # output to a file of its own
        # open a new output file...
        $this_piece = &process_asm_block ( $s_stuff );
 
        # output to a file of its own
        # open a new output file...
-       $octr++;
        $ofname = "${Tmp_prefix}__${octr}.s";
        open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
 
        $ofname = "${Tmp_prefix}__${octr}.s";
        open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
 
@@ -124,7 +124,7 @@ sub collectExports_mips { # Note: MIPS only
 }
 
 sub ReadTMPIUpToAMarker {
 }
 
 sub ReadTMPIUpToAMarker {
-    local($str) = @_; # already read bits
+    local($str, $count) = @_; # already read bits
 
     
     for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
 
     
     for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
@@ -154,7 +154,7 @@ sub ReadTMPIUpToAMarker {
        $_ = <TMPI>;
     }
 
        $_ = <TMPI>;
     }
 
-    print STDERR "### BLOCK:\n$str" if $Dump_asm_splitting_info;
+    print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
 
     # return str
     $str;
 
     # return str
     $str;
index 2203895..9b2d9f1 100644 (file)
@@ -190,8 +190,7 @@ expressed with a \tr{-O} (or \tr{-O2}) flag, or by its absence.
 \begin{code}
 $OptLevel = 0;     # no -O == 0; -O == 1; -O2 == 2; -Ofile == 3
 $MinusO2ForC = 0;   # set to 1 if -O2 should be given to C compiler
 \begin{code}
 $OptLevel = 0;     # no -O == 0; -O == 1; -O2 == 2; -Ofile == 3
 $MinusO2ForC = 0;   # set to 1 if -O2 should be given to C compiler
-$StolenX86Regs = 5; # **HACK*** of the very worst sort
-$SpX86Mangling = 1; # **EXTREME HACK*** of an even worse sort
+$StolenX86Regs = 4; # **HACK*** of the very worst sort
 \end{code}
 
 These variables represent parts of the -O/-O2/etc ``templates,''
 \end{code}
 
 These variables represent parts of the -O/-O2/etc ``templates,''
@@ -205,6 +204,7 @@ $Oopt_MonadEtaExpansion             = '';
 #OLD:$Oopt_LambdaLift          = '';
 $Oopt_AddAutoSccs              = '';
 $Oopt_FinalStgProfilingMassage = '';
 #OLD:$Oopt_LambdaLift          = '';
 $Oopt_AddAutoSccs              = '';
 $Oopt_FinalStgProfilingMassage = '';
+$Oopt_StgStats                 = '';
 $Oopt_SpecialiseUnboxed                = '';
 $Oopt_FoldrBuild               = 1; # On by default!
 $Oopt_FB_Support               = '-fdo-new-occur-anal -fdo-arity-expand';
 $Oopt_SpecialiseUnboxed                = '';
 $Oopt_FoldrBuild               = 1; # On by default!
 $Oopt_FB_Support               = '-fdo-new-occur-anal -fdo-arity-expand';
@@ -234,6 +234,7 @@ $As         = ''; # assembler is normally the same pgm as used for C compilation
 @As_flags      = ();
 
 $Lnkr          = ''; # linker is normally the same pgm as used for C compilation
 @As_flags      = ();
 
 $Lnkr          = ''; # linker is normally the same pgm as used for C compilation
+@Ld_flags      = ();
 
 # 'nm' is used for consistency checking (ToDo: mk-world-ify)
 # ToDo: check the OS or something ("alpha" is surely not the crucial question)
 
 # 'nm' is used for consistency checking (ToDo: mk-world-ify)
 # ToDo: check the OS or something ("alpha" is surely not the crucial question)
@@ -272,7 +273,9 @@ $BuildTag   = ''; # default is sequential build w/ Appel-style GC
                   '_l',    '$(GHC_BUILD_FLAG_l)',
                   '_m',    '$(GHC_BUILD_FLAG_m)',
                   '_n',    '$(GHC_BUILD_FLAG_n)',
                   '_l',    '$(GHC_BUILD_FLAG_l)',
                   '_m',    '$(GHC_BUILD_FLAG_m)',
                   '_n',    '$(GHC_BUILD_FLAG_n)',
-                  '_o',    '$(GHC_BUILD_FLAG_o)' );
+                  '_o',    '$(GHC_BUILD_FLAG_o)',
+                  '_A',    '$(GHC_BUILD_FLAG_A)',
+                  '_B',    '$(GHC_BUILD_FLAG_B)' );
 
 %BuildDescr    = ('',      'normal sequential',
                   '_p',    'profiling',
 
 %BuildDescr    = ('',      'normal sequential',
                   '_p',    'profiling',
@@ -300,7 +303,9 @@ $BuildTag   = ''; # default is sequential build w/ Appel-style GC
                   '_l',    'user way l',
                   '_m',    'user way m',
                   '_n',    'user way n',
                   '_l',    'user way l',
                   '_m',    'user way m',
                   '_n',    'user way n',
-                  '_o',    'user way o' );
+                  '_o',    'user way o',
+                  '_A',    'user way A',
+                  '_B',    'user way B' );
 
 # these are options that are "fed back" through the option processing loop
 %UserSetupOpts = ('_a', '$(GHC_BUILD_OPTS_a)',
 
 # these are options that are "fed back" through the option processing loop
 %UserSetupOpts = ('_a', '$(GHC_BUILD_OPTS_a)',
@@ -318,6 +323,8 @@ $BuildTag   = ''; # default is sequential build w/ Appel-style GC
                   '_m', '$(GHC_BUILD_OPTS_m)',
                   '_n', '$(GHC_BUILD_OPTS_n)',
                   '_o', '$(GHC_BUILD_OPTS_o)',
                   '_m', '$(GHC_BUILD_OPTS_m)',
                   '_n', '$(GHC_BUILD_OPTS_n)',
                   '_o', '$(GHC_BUILD_OPTS_o)',
+                  '_A', '$(GHC_BUILD_OPTS_A)',
+                  '_B', '$(GHC_BUILD_OPTS_B)',
 
                   # the GC ones don't have any "fed back" options
                   '_2s', '',
 
                   # the GC ones don't have any "fed back" options
                   '_2s', '',
@@ -329,11 +336,11 @@ $BuildTag = ''; # default is sequential build w/ Appel-style GC
 
                            # profiled sequential
                   '_p',    'push(@HsC_flags,  \'-fscc-profiling\');
 
                            # profiled sequential
                   '_p',    'push(@HsC_flags,  \'-fscc-profiling\');
-                            push(@CcBoth_flags, \'-DUSE_COST_CENTRES\');',
+                            push(@CcBoth_flags, \'-DPROFILING\');',
 
                            # ticky-ticky sequential
 
                            # ticky-ticky sequential
-                  '_t',    'push(@HsC_flags, \'-fstg-reduction-counts\');
-                            push(@CcBoth_flags, \'-DDO_REDN_COUNTING\');',
+                  '_t',    'push(@HsC_flags, \'-fticky-ticky\');
+                            push(@CcBoth_flags, \'-DTICKY_TICKY\');',
 
                            # unregisterized (ToDo????)
                   '_u',    '',
 
                            # unregisterized (ToDo????)
                   '_u',    '',
@@ -348,19 +355,19 @@ $BuildTag = ''; # default is sequential build w/ Appel-style GC
                   '_mr',   '$StkChkByPageFaultOK = 0;
                             push(@HsC_flags,  \'-fconcurrent\', \'-fscc-profiling\');
                             push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
                   '_mr',   '$StkChkByPageFaultOK = 0;
                             push(@HsC_flags,  \'-fconcurrent\', \'-fscc-profiling\');
                             push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
-                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DUSE_COST_CENTRES\');',
+                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPROFILING\');',
 
                            # ticky-ticky concurrent
                   '_mt',   '$StkChkByPageFaultOK = 0;
 
                            # ticky-ticky concurrent
                   '_mt',   '$StkChkByPageFaultOK = 0;
-                            push(@HsC_flags,  \'-fconcurrent\', \'-fstg-reduction-counts\');
+                            push(@HsC_flags,  \'-fconcurrent\', \'-fticky-ticky\');
                             push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
                             push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
-                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DDO_REDN_COUNTING\');',
+                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DTICKY_TICKY\');',
 
                            # parallel
                   '_mp',   '$StkChkByPageFaultOK = 0;
                             push(@HsC_flags,  \'-fconcurrent\');
                             push(@HsCpp_flags,\'-D__PARALLEL_HASKELL__\',   \'-DPAR\');
 
                            # parallel
                   '_mp',   '$StkChkByPageFaultOK = 0;
                             push(@HsC_flags,  \'-fconcurrent\');
                             push(@HsCpp_flags,\'-D__PARALLEL_HASKELL__\',   \'-DPAR\');
-                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPAR\', \'-DGUM\');',
+                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPAR\');',
 
                            # GranSim
                   '_mg',   '$StkChkByPageFaultOK = 0;
 
                            # GranSim
                   '_mg',   '$StkChkByPageFaultOK = 0;
@@ -386,7 +393,9 @@ $BuildTag   = ''; # default is sequential build w/ Appel-style GC
                   '_l',    '',
                   '_m',    '',
                   '_n',    '',
                   '_l',    '',
                   '_m',    '',
                   '_n',    '',
-                  '_o',    '' );
+                  '_o',    '',
+                  '_A',    '',
+                  '_B',    '' );
 \end{code}
 
 Import/include directories (\tr{-I} options) are sufficiently weird to
 \end{code}
 
 Import/include directories (\tr{-I} options) are sufficiently weird to
@@ -453,14 +462,13 @@ $RegisteriseC  = '';    # set to 'o', if using optimised C code (only if avail)
                        #   or if generating equiv asm code
 $DEBUGging = '';       # -DDEBUG and all that it entails (um... not really)
 $PROFing = '';         # set to p or e if profiling
                        #   or if generating equiv asm code
 $DEBUGging = '';       # -DDEBUG and all that it entails (um... not really)
 $PROFing = '';         # set to p or e if profiling
-$PROFaging = '';       # set to a if profiling with age -- only for cc consistency
 $PROFgroup = '';       # set to group if an explicit -Ggroup specified
 $PROFauto = '';                # set to relevant hsc flag if -auto or -auto-all
 $PROFcaf  = '';                # set to relevant hsc flag if -caf-all
 #UNUSED:$PROFdict  = '';        # set to relevant hsc flag if -dict-all
 $PROFignore_scc = '';  # set to relevant parser flag if explicit sccs ignored
 $TICKYing = '';        # set to t if compiling for ticky-ticky profiling
 $PROFgroup = '';       # set to group if an explicit -Ggroup specified
 $PROFauto = '';                # set to relevant hsc flag if -auto or -auto-all
 $PROFcaf  = '';                # set to relevant hsc flag if -caf-all
 #UNUSED:$PROFdict  = '';        # set to relevant hsc flag if -dict-all
 $PROFignore_scc = '';  # set to relevant parser flag if explicit sccs ignored
 $TICKYing = '';        # set to t if compiling for ticky-ticky profiling
-$PARing = '';          # set to p if compiling for PAR (ie GUM)
+$PARing = '';          # set to p if compiling for PAR
 $CONCURing = '';       # set to c if compiling for CONCURRENT
 $GRANing = '';         # set to g if compiling for GRAN
 $StkChkByPageFaultOK = 1; # may be set to 0 (false) for some builds
 $CONCURing = '';       # set to c if compiling for CONCURRENT
 $GRANing = '';         # set to g if compiling for GRAN
 $StkChkByPageFaultOK = 1; # may be set to 0 (false) for some builds
@@ -660,11 +668,6 @@ arg: while($_ = $ARGV[0]) {
 
     /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later!
 
 
     /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later!
 
-    /^-fheap-profiling-with-age$/ && do {
-               $PROFaging = 'a'; 
-               push(@CcBoth_flags, '-DHEAP_PROF_WITH_AGE');
-               next arg; };
-
     /^-auto/ && do {
                # generate auto SCCs on top level bindings
                # -auto-all = all top level bindings
     /^-auto/ && do {
                # generate auto SCCs on top level bindings
                # -auto-all = all top level bindings
@@ -701,7 +704,7 @@ arg: while($_ = $ARGV[0]) {
 
     #-------------- "user ways" --------------------------------------------
 
 
     #-------------- "user ways" --------------------------------------------
 
-    (/^-user-setup-([a-o])$/
+    (/^-user-setup-([a-oA-Z])$/
     || /^$(GHC_BUILD_FLAG_a)$/
     || /^$(GHC_BUILD_FLAG_b)$/
     || /^$(GHC_BUILD_FLAG_c)$/
     || /^$(GHC_BUILD_FLAG_a)$/
     || /^$(GHC_BUILD_FLAG_b)$/
     || /^$(GHC_BUILD_FLAG_c)$/
@@ -717,12 +720,14 @@ arg: while($_ = $ARGV[0]) {
     || /^$(GHC_BUILD_FLAG_m)$/
     || /^$(GHC_BUILD_FLAG_n)$/
     || /^$(GHC_BUILD_FLAG_o)$/
     || /^$(GHC_BUILD_FLAG_m)$/
     || /^$(GHC_BUILD_FLAG_n)$/
     || /^$(GHC_BUILD_FLAG_o)$/
+    || /^$(GHC_BUILD_FLAG_A)$/
+    || /^$(GHC_BUILD_FLAG_B)$/
 
     || /^$(GHC_BUILD_FLAG_2s)$/ # GC ones...
     || /^$(GHC_BUILD_FLAG_1s)$/
     || /^$(GHC_BUILD_FLAG_du)$/
     ) && do {
 
     || /^$(GHC_BUILD_FLAG_2s)$/ # GC ones...
     || /^$(GHC_BUILD_FLAG_1s)$/
     || /^$(GHC_BUILD_FLAG_du)$/
     ) && do {
-               /^-user-setup-([a-o])$/  && do { $BuildTag = "_$1"; };
+               /^-user-setup-([a-oA-Z])$/  && do { $BuildTag = "_$1"; };
 
                /^$(GHC_BUILD_FLAG_a)$/  && do { $BuildTag = '_a';  };
                /^$(GHC_BUILD_FLAG_b)$/  && do { $BuildTag = '_b';  };
 
                /^$(GHC_BUILD_FLAG_a)$/  && do { $BuildTag = '_a';  };
                /^$(GHC_BUILD_FLAG_b)$/  && do { $BuildTag = '_b';  };
@@ -739,6 +744,8 @@ arg: while($_ = $ARGV[0]) {
                /^$(GHC_BUILD_FLAG_m)$/  && do { $BuildTag = '_m';  };
                /^$(GHC_BUILD_FLAG_n)$/  && do { $BuildTag = '_n';  };
                /^$(GHC_BUILD_FLAG_o)$/  && do { $BuildTag = '_o';  };
                /^$(GHC_BUILD_FLAG_m)$/  && do { $BuildTag = '_m';  };
                /^$(GHC_BUILD_FLAG_n)$/  && do { $BuildTag = '_n';  };
                /^$(GHC_BUILD_FLAG_o)$/  && do { $BuildTag = '_o';  };
+               /^$(GHC_BUILD_FLAG_A)$/  && do { $BuildTag = '_A';  };
+               /^$(GHC_BUILD_FLAG_B)$/  && do { $BuildTag = '_B';  };
 
                /^$(GHC_BUILD_FLAG_2s)$/ && do { $BuildTag = '_2s'; };
                /^$(GHC_BUILD_FLAG_1s)$/ && do { $BuildTag = '_1s'; };
 
                /^$(GHC_BUILD_FLAG_2s)$/ && do { $BuildTag = '_2s'; };
                /^$(GHC_BUILD_FLAG_1s)$/ && do { $BuildTag = '_1s'; };
@@ -834,7 +841,7 @@ arg: while($_ = $ARGV[0]) {
     #---------- Haskell compiler (hsc) -------------------------------------
 
 # possibly resurrect LATER
     #---------- Haskell compiler (hsc) -------------------------------------
 
 # possibly resurrect LATER
-#   /^-fspat-profiling$/  && do { push(@HsC_flags, '-fstg-reduction-counts');
+#   /^-fspat-profiling$/  && do { push(@HsC_flags, '-fticky-ticky');
 #                          $ProduceS = ''; $ProduceC = 1; # must use C compiler
 #                          push(@CcBoth_flags, '-DDO_SPAT_PROFILING');
 #                          push(@CcBoth_flags, '-fno-schedule-insns'); # not essential
 #                          $ProduceS = ''; $ProduceC = 1; # must use C compiler
 #                          push(@CcBoth_flags, '-DDO_SPAT_PROFILING');
 #                          push(@CcBoth_flags, '-fno-schedule-insns'); # not essential
@@ -866,7 +873,7 @@ arg: while($_ = $ARGV[0]) {
                        local($sname) = &grab_arg_arg('-split-objs', $1);
                        $sname =~ s/ //g; # no spaces
 
                        local($sname) = &grab_arg_arg('-split-objs', $1);
                        $sname =~ s/ //g; # no spaces
 
-                       if ( $TargetPlatform =~ /^(sparc|alpha|m68k|mips|i[34]86|hppa1\.1)-/ ) {
+                       if ( $TargetPlatform =~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|sparc)-/ ) {
                            $SplitObjFiles = 1;
                            push(@HsC_flags, "-fglobalise-toplev-names$sname"); 
                            push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS');
                            $SplitObjFiles = 1;
                            push(@HsC_flags, "-fglobalise-toplev-names$sname"); 
                            push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS');
@@ -948,6 +955,21 @@ arg: while($_ = $ARGV[0]) {
     /^-fdo-monad-eta-expansion$/
                    && do { $Oopt_MonadEtaExpansion = $_; next arg; };
 
     /^-fdo-monad-eta-expansion$/
                    && do { $Oopt_MonadEtaExpansion = $_; next arg; };
 
+    /^-fno-let-from-(case|app|strict-let)$/ # experimental, really (WDP 95/10)
+                   && do { push(@HsC_flags, $_); next arg; };
+
+    /^(-freturn-in-regs-threshold)(.*)$/
+                   && do { local($what) = $1;
+                           local($num)  = &grab_arg_arg($what, $2);
+                           if ($num < 2 || $num > 8) {
+                               die "Bad experimental flag: $_\n";
+                           } else {
+                               $ProduceS = ''; $ProduceC = 1; # force using C compiler
+                               push(@HsC_flags, "$what$num");
+                               push(@CcRegd_flags, "-D__STG_REGS_AVAIL__=$num");
+                           }
+                           next arg; };
+
 #    /^-flambda-lift$/ # so Simon can do some testing; ToDo:rm
 #                  && do { $Oopt_LambdaLift = $_; next arg; };
 
 #    /^-flambda-lift$/ # so Simon can do some testing; ToDo:rm
 #                  && do { $Oopt_LambdaLift = $_; next arg; };
 
@@ -961,8 +983,13 @@ arg: while($_ = $ARGV[0]) {
 
     # ---------------
 
 
     # ---------------
 
-    /^-mlong-calls/ && do { # for GCC for HP-PA boxes
-                           unshift(@CcBoth_flags,  ('-mlong-calls'));
+    /^-mlong-calls$/ && do { # for GCC for HP-PA boxes
+                           unshift(@CcBoth_flags, ( $_ ));
+                           next arg; };
+
+    /^-m(v8|sparclite|cypress|supersparc|cpu=(cypress|supersparc))$/
+                    && do { # for GCC for SPARCs
+                           unshift(@CcBoth_flags, ( $_ ));
                            next arg; };
 
     /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise
                            next arg; };
 
     /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise
@@ -970,7 +997,8 @@ arg: while($_ = $ARGV[0]) {
                            next arg; };
 
     /^-mtoggle-sp-mangling/ && do { # for iX86 boxes only; for RTS only
                            next arg; };
 
     /^-mtoggle-sp-mangling/ && do { # for iX86 boxes only; for RTS only
-                           $SpX86Mangling = 1 - $SpX86Mangling;
+                           print STDERR "$Pgm: warning: -mtoggle-sp-mangling is no longer supported\n";
+#                          $SpX86Mangling = 1 - $SpX86Mangling;
                            next arg; };
 
     #*************** ... and lots of debugging ones (form: -d* )
                            next arg; };
 
     #*************** ... and lots of debugging ones (form: -d* )
@@ -996,6 +1024,7 @@ arg: while($_ = $ARGV[0]) {
     /^-d(dump|ppr)-/         && do { push(@HsC_flags, $_); next arg; };
     /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; };
     /^-dsimplifier-stats/    && do { push(@HsC_flags, $_); next arg; };
     /^-d(dump|ppr)-/         && do { push(@HsC_flags, $_); next arg; };
     /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; };
     /^-dsimplifier-stats/    && do { push(@HsC_flags, $_); next arg; };
+    /^-dstg-stats/          && do { $Oopt_StgStats = $_; next arg; };
 
     #*************** ... and now all these -R* ones for its runtime system...
 
 
     #*************** ... and now all these -R* ones for its runtime system...
 
@@ -1125,8 +1154,6 @@ arg: while($_ = $ARGV[0]) {
                            # in the consistency info
                            $DEBUGging = 'd';
                            next arg; };
                            # in the consistency info
                            $DEBUGging = 'd';
                            next arg; };
-# OLD: do it another way
-#   /^-dgc-debug$/  && do { push(@CcBoth_flags, '-D_GC_DEBUG'); next arg; };
 
     #---------- catch unrecognized flags -----------------------------------
 
 
     #---------- catch unrecognized flags -----------------------------------
 
@@ -1280,7 +1307,7 @@ It really really wants to be the last STG-to-STG pass that is run.
   = (  '-fsimplify',
          '\(',
          "$Oopt_FB_Support",
   = (  '-fsimplify',
          '\(',
          "$Oopt_FB_Support",
-         '-falways-float-lets-from-lets',
+#        '-falways-float-lets-from-lets',      # no idea why this was here (WDP 95/09)
          '-ffloat-lets-exposing-whnf',
          '-ffloat-primops-ok',
          '-fcase-of-case',
          '-ffloat-lets-exposing-whnf',
          '-ffloat-primops-ok',
          '-fcase-of-case',
@@ -1463,6 +1490,7 @@ It really really wants to be the last STG-to-STG pass that is run.
        '-fupdate-analysis',
        '-flambda-lift',
        $Oopt_FinalStgProfilingMassage,
        '-fupdate-analysis',
        '-flambda-lift',
        $Oopt_FinalStgProfilingMassage,
+       $Oopt_StgStats,
 
       # flags for stg2stg
        '-flet-no-escape',
 
       # flags for stg2stg
        '-flet-no-escape',
@@ -1519,7 +1547,7 @@ C or via equivalent native code)?
 \begin{code}
 $RegisteriseC = ( $GccAvailable
                && $RegisteriseC ne 'no'    # not explicitly *un*set...
 \begin{code}
 $RegisteriseC = ( $GccAvailable
                && $RegisteriseC ne 'no'    # not explicitly *un*set...
-               && ($TargetPlatform =~ /^(alpha|hppa1\.1|i[34]86|m68k|mips|sparc)-/)
+               && ($TargetPlatform =~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|sparc)-/)
                ) ? 'o' : '';
 \end{code}
 
                ) ? 'o' : '';
 \end{code}
 
@@ -1597,7 +1625,46 @@ user-specified flags can clobber them (e.g., \tr{-U__STG_REV_TBLS__}).
 Note: a few ``always apply'' flags were set at the very beginning.
 
 \begin{code}
 Note: a few ``always apply'' flags were set at the very beginning.
 
 \begin{code}
-if ($TargetPlatform =~ /^m68k-/) {
+if ($TargetPlatform =~ /^alpha-/) {
+    # we know how to *mangle* asm for alpha
+    unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
+    unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
+    unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
+
+} elsif ($TargetPlatform =~ /^hppa/) {
+    # we know how to *mangle* asm for hppa
+    unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
+    unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
+    # We don't put in '-mlong-calls', because it's only
+    # needed for very big modules (sigh), and we don't want
+    # to hobble ourselves further on all the other modules
+    # (most of them).
+    unshift(@CcBoth_flags,  ('-D_HPUX_SOURCE')) if $GccAvailable;
+        # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
+        # (very nice, but too bad the HP /usr/include files don't agree.)
+
+} elsif ($TargetPlatform =~ /^i386-/) {
+    # we know how to *mangle* asm for X86
+    unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
+    unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1'))
+       if $StkChkByPageFaultOK && $TargetPlatform !~ /linux/;
+       # NB: cannot do required signal magic on Linux for such stk chks */
+
+    unshift(@CcRegd_flags, ('-m486')); # not worth not doing
+
+    # -fno-defer-pop : basically the same game as for m68k
+    #
+    # -fomit-frame-pointer : *must* ; because we're stealing
+    #  the fp (%ebp) for our register maps.  *All* register
+    #  maps (in MachRegs.lh) must steal it.
+
+    unshift(@CcRegd_flags_hc, '-fno-defer-pop');
+    unshift(@CcRegd_flags,    '-fomit-frame-pointer');
+    unshift(@CcRegd_flags,    "-DSTOLEN_X86_REGS=$StolenX86Regs");
+
+    unshift(@CcBoth_flags,  ('-static')) if $GccAvailable; # maybe unnecessary???
+
+} elsif ($TargetPlatform =~ /^m68k-/) {
     # we know how to *mangle* asm for m68k
     unshift (@CcRegd_flags, ('-D__STG_REV_TBLS__'));
     unshift (@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
     # we know how to *mangle* asm for m68k
     unshift (@CcRegd_flags, ('-D__STG_REV_TBLS__'));
     unshift (@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
@@ -1617,49 +1684,16 @@ if ($TargetPlatform =~ /^m68k-/) {
        # maybe gives reg alloc a better time
        # also: -fno-defer-pop is not sufficiently well-behaved without it
 
        # maybe gives reg alloc a better time
        # also: -fno-defer-pop is not sufficiently well-behaved without it
 
-} elsif ($TargetPlatform =~ /^i[34]86-/) {
-    # we know how to *mangle* asm for X86
+} elsif ($TargetPlatform =~ /^powerpc-/) {
+    # we know how to *mangle* asm for PowerPC
     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
-    unshift(@CcRegd_flags, ('-m486')); # not worth not doing
-
-    # -fno-defer-pop : basically the same game as for m68k
-    #
-    # -fomit-frame-pointer : *must* ; because we're stealing
-    #  the fp (%ebp) for our register maps.  *All* register
-    #  maps (in MachRegs.lh) must steal it.
-
-    unshift(@CcRegd_flags_hc, '-fno-defer-pop');
-    unshift(@CcRegd_flags,    '-fomit-frame-pointer');
-    unshift(@CcRegd_flags,    "-DSTOLEN_X86_REGS=$StolenX86Regs");
-    unshift(@CcRegd_flags_hc, "-DMANGLING_X86_SP=$SpX86Mangling"); # only used for checking
-       # the mangler will insert patch-up code if $StolenX86Regs != 5.
-       # *** HACK *** of the worst sort.
-    unshift(@CcBoth_flags,  ('-static')) if $GccAvailable; # maybe unnecessary???
 
 } elsif ($TargetPlatform =~ /^sparc-/) {
     # we know how to *mangle* asm for SPARC
     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
 
 
 } elsif ($TargetPlatform =~ /^sparc-/) {
     # we know how to *mangle* asm for SPARC
     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
 
-} elsif ($TargetPlatform =~ /^alpha-/) {
-    # we know how to *mangle* asm for alpha
-    unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
-    unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
-    unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
-
-} elsif ($TargetPlatform =~ /^hppa/) {
-    # we know how to *mangle* asm for hppa
-    unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
-    unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
-    # We don't put in '-mlong-calls', because it's only
-    # needed for very big modules (sigh), and we don't want
-    # to hobble ourselves further on all the other modules
-    # (most of them).
-    unshift(@CcBoth_flags,  ('-D_HPUX_SOURCE')) if $GccAvailable;
-        # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
-        # (very nice, but too bad the HP /usr/include files don't agree.)
-
 } elsif ($TargetPlatform =~ /^mips-/) {
     # we (hope to) know how to *mangle* asm for MIPSen
     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
 } elsif ($TargetPlatform =~ /^mips-/) {
     # we (hope to) know how to *mangle* asm for MIPSen
     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
@@ -1676,8 +1710,9 @@ not an architecture test.  (JSM)
 \begin{code}
 unshift(@Ld_flags,
     (   $TargetPlatform =~ /^alpha-/
 \begin{code}
 unshift(@Ld_flags,
     (   $TargetPlatform =~ /^alpha-/
-     || $TargetPlatform =~ /^mips-sgi-irix/
      || $TargetPlatform =~ /^hppa/
      || $TargetPlatform =~ /^hppa/
+     || $TargetPlatform =~ /^mips-sgi-irix/
+     || $TargetPlatform =~ /^powerpc-/
      || $TargetPlatform =~ /-solaris/
     )
     ? ('-u', 'unsafePerformPrimIO_fast1',
      || $TargetPlatform =~ /-solaris/
     )
     ? ('-u', 'unsafePerformPrimIO_fast1',
@@ -1685,15 +1720,17 @@ unshift(@Ld_flags,
        '-u', 'IZh_static_info',
        '-u', 'False_inregs_info',
        '-u', 'True_inregs_info',
        '-u', 'IZh_static_info',
        '-u', 'False_inregs_info',
        '-u', 'True_inregs_info',
-       '-u', 'CZh_static_info')
+       '-u', 'CZh_static_info',
+       '-u', 'DEBUG_REGS') # just for fun, now...
 
 
-    # non-Alphas:
+    # nice friendly a.out machines...
     : ('-u', '_unsafePerformPrimIO_fast1',
        '-u', '_Nil_closure',
        '-u', '_IZh_static_info',
        '-u', '_False_inregs_info',
        '-u', '_True_inregs_info',
     : ('-u', '_unsafePerformPrimIO_fast1',
        '-u', '_Nil_closure',
        '-u', '_IZh_static_info',
        '-u', '_False_inregs_info',
        '-u', '_True_inregs_info',
-       '-u', '_CZh_static_info')
+       '-u', '_CZh_static_info',
+       '-u', '_DEBUG_REGS')
     );
 \end{code}
 
     );
 \end{code}
 
@@ -1890,7 +1927,7 @@ EOSCRIPT1
        print EXEC <<\EOSCRIPT2;
 # first, some magical shortcuts to run "commands" on the binary
 # (which is hidden)
        print EXEC <<\EOSCRIPT2;
 # first, some magical shortcuts to run "commands" on the binary
 # (which is hidden)
-if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--(size|file|strip|rm)/ ) {
+if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {
     local($cmd) = $1;
     system("$cmd $pvm_executable");
     exit(0); # all done
     local($cmd) = $1;
     system("$cmd $pvm_executable");
     exit(0); # all done
@@ -2262,7 +2299,7 @@ it fails.
        local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : '';
        if ($RegisteriseC) {
            $cc       = $CcRegd;
        local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : '';
        if ($RegisteriseC) {
            $cc       = $CcRegd;
-           $s_output = ($is_hc_file || $TargetPlatform =~ /^hppa/) ? $cc_as_o : $cc_as;
+           $s_output = ($is_hc_file || $TargetPlatform =~ /^(hppa|i386)/) ? $cc_as_o : $cc_as;
            $c_flags .= " @CcRegd_flags";
            $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc"  : " @CcRegd_flags_c";
        } else {
            $c_flags .= " @CcRegd_flags";
            $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc"  : " @CcRegd_flags_c";
        } else {
@@ -2309,18 +2346,20 @@ EOINCL
          || $Dump_asm_insn_counts
          || $Dump_asm_globals_info ) {
            # dynamically load assembler-fiddling code, which we are about to use
          || $Dump_asm_insn_counts
          || $Dump_asm_globals_info ) {
            # dynamically load assembler-fiddling code, which we are about to use
-           local($target) = '';
-           $target = 'alpha'   if $TargetPlatform =~ /^alpha-/;
-           $target = 'hppa'    if $TargetPlatform =~ /^hppa/;
-           $target = 'iX86'    if $TargetPlatform =~ /^i[34]86-/;
-           $target = 'm68k'    if $TargetPlatform =~ /^m68k-/;
-           $target = 'mips'    if $TargetPlatform =~ /^mips-/;
-           $target = 'solaris' if $TargetPlatform =~ /^sparc-sun-solaris2/;
-           $target = 'sparc'   if $TargetPlatform =~ /^sparc-sun-sunos4/;
-           $target ne ''
+           local($target) = 'oops';
+           $target = '-alpha'   if $TargetPlatform =~ /^alpha-/;
+           $target = '-hppa'    if $TargetPlatform =~ /^hppa/;
+           $target = ''         if $TargetPlatform =~ /^i386-/;
+           $target = '-m68k'    if $TargetPlatform =~ /^m68k-/;
+           $target = '-mips'    if $TargetPlatform =~ /^mips-/;
+           $target = ''         if $TargetPlatform =~ /^powerpc-/;
+           $target = '-solaris' if $TargetPlatform =~ /^sparc-sun-solaris2/;
+           $target = '-sparc'   if $TargetPlatform =~ /^sparc-sun-sunos4/;
+
+           $target ne 'oops'
            || &tidy_up_and_die(1,"$Pgm: panic: can't decipher $TargetPlatform!\n");
            || &tidy_up_and_die(1,"$Pgm: panic: can't decipher $TargetPlatform!\n");
-           require("ghc-asm-$target.prl")
-           || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-$target.prl!\n");
+           require("ghc-asm$target.prl")
+           || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm$target.prl!\n");
        }
 
        if ( $Dump_raw_asm ) { # to stderr, before mangling
        }
 
        if ( $Dump_raw_asm ) { # to stderr, before mangling
@@ -2332,11 +2371,18 @@ EOINCL
             if ($is_hc_file) {
                # post-process the assembler [.hc files only]
                &mangle_asm($cc_as_o, $cc_as);
             if ($is_hc_file) {
                # post-process the assembler [.hc files only]
                &mangle_asm($cc_as_o, $cc_as);
+
            } elsif ($TargetPlatform =~ /^hppa/) {
                # minor mangling of non-threaded files for hp-pa only
            } elsif ($TargetPlatform =~ /^hppa/) {
                # minor mangling of non-threaded files for hp-pa only
-               require("ghc-asm-hppa.prl")
+               require('ghc-asm-hppa.prl')
                || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n");
                &mini_mangle_asm($cc_as_o, $cc_as);
                || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n");
                &mini_mangle_asm($cc_as_o, $cc_as);
+
+           } elsif ($TargetPlatform =~ /^i386/) {
+               # extremely-minor OFFENSIVE mangling of non-threaded just one file
+               require('ghc-asm.prl')
+               || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n");
+               &mini_mangle_asm($cc_as_o, $cc_as);
            }
        }
 
            }
        }
 
@@ -2436,8 +2482,8 @@ sub run_something {
        while ( <CCOUT> ) {
            next if /attribute directive ignored/;
            next if /call-clobbered/;
        while ( <CCOUT> ) {
            next if /attribute directive ignored/;
            next if /call-clobbered/;
-           next if /In file included .*stgdefs/;
-           next if /from .*rtsdefs.h:/;
+           next if /from .*COptRegs\.lh/;
+           next if /from .*(stg|rts)defs\.h:/;
            next if /from ghc\d+.c:\d+:/;
            next if /from .*\.lc/;
            next if /from .*SMinternal\.lh/;
            next if /from ghc\d+.c:\d+:/;
            next if /from .*\.lc/;
            next if /from .*SMinternal\.lh/;
@@ -2531,7 +2577,11 @@ sub process_ghc_timings {
     local($SysSpecificTiming) = 'ghc';
 
     open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
     local($SysSpecificTiming) = 'ghc';
 
     open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
+    local($tot_live) = 0; # for calculating avg residency
+
     while (<STATS>) {
     while (<STATS>) {
+       $tot_live += $1 if /^\s*\d+\s+\d+\s+\d+\.\d+\%\s+(\d+)\s+\d+\.\d+\%/;
+
        $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
 
        if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
        $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
 
        if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
@@ -2549,6 +2599,9 @@ sub process_ghc_timings {
        }
     }
     close(STATS) || die "Failed when closing $StatsFile\n";
        }
     }
     close(STATS) || die "Failed when closing $StatsFile\n";
+    if ( defined($ResidencySamples) && $ResidencySamples > 0 ) {
+       $AvgResidency = int ($tot_live / $ResidencySamples) ;
+    }
 
     # warn about what we didn't find
     print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc);
 
     # warn about what we didn't find
     print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc);
@@ -2562,6 +2615,7 @@ sub process_ghc_timings {
 
     # things we didn't necessarily expect to find
     $MaxResidency     = 0 unless defined($MaxResidency);
 
     # things we didn't necessarily expect to find
     $MaxResidency     = 0 unless defined($MaxResidency);
+    $AvgResidency     = 0 unless defined($AvgResidency);
     $ResidencySamples = 0 unless defined($ResidencySamples);
 
     # a bit of tidying
     $ResidencySamples = 0 unless defined($ResidencySamples);
 
     # a bit of tidying
@@ -2577,7 +2631,7 @@ sub process_ghc_timings {
 
     # print out what we found
     print STDERR "<<$SysSpecificTiming: ",
 
     # print out what we found
     print STDERR "<<$SysSpecificTiming: ",
-       "$BytesAlloc bytes, $GCs GCs, $MaxResidency bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
+       "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
        " :$SysSpecificTiming>>\n";
 
     # OK, party over
        " :$SysSpecificTiming>>\n";
 
     # OK, party over
diff --git a/ghc/includes/AgeProfile.lh b/ghc/includes/AgeProfile.lh
deleted file mode 100644 (file)
index dc4b899..0000000
+++ /dev/null
@@ -1,151 +0,0 @@
-%************************************************************************
-%*                                                                     *
-\subsection[AgeProfile.lh]{Age Profiling Definitions for Heap and Lifetime Profiling}
-%*                                                                     *
-%************************************************************************
-
-Multi-slurp protection:
-\begin{code}
-#ifndef LifeProfile_H
-#define LifeProfile_H
-\end{code}
-
-Definitions relating to the life field in fixed header:
-
-\begin{code}
-#define AGE_FIXED_HDR                  (AGE_HDR_SIZE)
-#define AGE_HDR_POSN                   AFTER_PROF_HDR
-#define AFTER_AGE_HDR                  (AGE_FIXED_HDR+AGE_HDR_POSN)
-\end{code}
-
-We have age header in closure if @LIFE_PROFILE@ or
-@HEAP_PROF_WITH_AGE@ defined.
-
-\begin{code}
-
-#if defined(HEAP_PROF_WITH_AGE) || defined(LIFE_PROFILE) || defined(UPDATES_ENTERED_COUNT)
-
-#define AGE_HDR_SIZE           1
-#define AGE_HDR(closure)       (((P_)(closure))[AGE_HDR_POSN])
-#define        SET_STATIC_AGE_HDR()    ,0
-
-#if defined (HEAP_PROF_WITH_AGE) || defined(UPDATES_ENTERED_COUNT)
-#define SET_AGE_HDR(closure)   AGE_HDR(closure) = 0
-#endif
-
-/* SET_AGE_HDR(closure) defined below if LIFE_PROFILE required */
-
-
-#else  /* ! LIFE_PROFILE && ! HEAP_PROF_WITH_AGE && ! UPDATES_ENTERED */
-
-#define AGE_HDR_SIZE           0
-#define SET_AGE_HDR(closure)
-#define        SET_STATIC_AGE_HDR()
-
-#endif /* ! LIFE_PROFILE && ! HEAP_PROF_WITH_AGE */
-
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsubsection[lifetime-profiling]{Declarations For Lifetime Profiling}
-%*                                                                     *
-%************************************************************************
-
-The SM is responsible for:
-\begin{itemize}
-\item
-Ensuring that the \tr{HpLim} increment will be ok by ALWAYS setting \tr{HpLim}
-lower than the end of the heap (halving the free space suffices).
-\item
-If the user has requested a lifetime profile the storage manager must
-arrange for a garbage collection to occur after \tr{LifeInterval}
-words allocated (excluding age words which will be fudged with the
-\tr{HpLim} increment). Additional collections are possible with
-\tr{part_interval} being returned to indicate what is left.
-\item
-Calling \tr{life_profile_setup} and \tr{life_profile_done} during each
-garbage collection. These can be avoided if the user has not requested
-a lifetime profile.
-\item
-Calling \tr{life_profile_closure} for every closure collected during a
-garbage collection.
-\end{itemize}
-
-The RTS is responsible for:
-\begin{itemize}
-\item
-Allocating extra age word in closures.
-\item
-Initialising closure age to \tr{CurrentTime} using
-\tr{SET_AGE_HDR(closure)}. This increments the heap limit pointer to
-avoid collecting too soon as a result of distortion from the extra
-word in closures.
-\item
-Calling \tr{life_profile_init} and \tr{life_profile_finish} routines.
-\item
-Calling \tr{update_profile_closure} for every closure updated.
-\end{itemize}
-
-
-\begin{code}
-#if defined(LIFE_PROFILE)
-
-extern W_ closures_alloced;
-#define SET_AGE_HDR(closure)   do { AGE_HDR(closure) = (W_)CurrentTime; \
-                               closures_alloced++; HpLim++; } while(0)
-
-/* When we allocate a closure we increment HpLim so that age word will
-   not be included in the allocation before the next profiling interupt.
-*/
-
-
-/* start of execution -- looks for -l flag */
-extern I_ life_profile_init PROTO((StgChar *rts_argv[], StgChar *prog_argv[]));
-
-/* end of execution -- produce report if -l flag */
-extern void life_profile_finish PROTO((I_ alloc, StgChar *prog_argv[]));
-
-extern I_  do_life_prof;       /* Are we liftime profiling ? */
-extern I_  CurrentTime;        /* Current time (LifeIntervals) */
-extern I_  LifeInterval;       /* Lifetime resolution  (in words allocated) */
-
-#define DEFAULT_LIFE_INTERVAL  250     /* 1k -- report 10k */
-#define INTERVALS             100000  /* Intervals recoded */
-#define GROUPED               10      /* No of intervals grouped oin results */
-
-/* START of gc profile */
-extern void life_profile_setup(STG_NO_ARGS);
-
-/* END of gc profile -- returns next alloc interval */
-/* passed alloc since last (inc age words) and req size */
-
-extern I_ life_profile_done  PROTO((I_ alloc, I_ reqsize));
-
-/* LIFE PROFILE function called for every closure collected */
-/* records info if part_interval == 0, indicating a profile reqd */
-
-extern void life_profile_closure   PROTO((P_ closure, I_ size));
-
-/* UPDATE PROFILE function called for every closure updated */
-/* records info if the user requested a lifetime profiling */
-
-extern void update_profile_closure PROTO((P_ closure));
-
-#define LIFE_PROFILE_CLOSURE(closure,size) \
-       STGCALL2(void,(void *, P_, I_),life_profile_closure,closure,size)
-#define UPDATE_PROFILE_CLOSURE(closure) \
-       STGCALL1(void,(void *, P_),update_profile_closure,closure)      
-
-#else /* ! LIFE_PROFILE */
-
-#define LIFE_PROFILE_CLOSURE(closure,size)
-#define UPDATE_PROFILE_CLOSURE(closure)
-
-#endif /* ! LIFE_PROFILE */
-\end{code}
-
-End multi-slurp protection:
-\begin{code}
-#endif /* LifeProfile_H */
-\end{code}
index f1053eb..db8516d 100644 (file)
@@ -252,7 +252,13 @@ register void *_procedure __asm__("$27");
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-#if i386_TARGET_ARCH || i486_TARGET_ARCH
+#if i386_TARGET_ARCH
+
+#ifdef solaris2_TARGET_OS
+#define MINI_INTERPRET_END   "miniInterpretEnd"
+#else
+#define MINI_INTERPRET_END   "_miniInterpretEnd"
+#endif
 
 /* do FUNBEGIN/END the easy way */
 #define FUNBEGIN    __asm__ volatile ("--- BEGIN ---");
 
 /* do FUNBEGIN/END the easy way */
 #define FUNBEGIN    __asm__ volatile ("--- BEGIN ---");
@@ -272,9 +278,6 @@ extern void __DISCARD__(STG_NO_ARGS);
 
 /* The safe part of the stack frame is near the top */
 
 
 /* The safe part of the stack frame is near the top */
 
-extern P_ SP_stack[];
-extern I_ SP_stack_ptr;
-
 #define MINI_INTERPRETER_SETUP                                 \
     StgChar space[RESERVED_C_STACK_BYTES+4*sizeof(long)];      \
     __asm__ volatile ("leal %c0(%%esp),%%eax\n"                        \
 #define MINI_INTERPRETER_SETUP                                 \
     StgChar space[RESERVED_C_STACK_BYTES+4*sizeof(long)];      \
     __asm__ volatile ("leal %c0(%%esp),%%eax\n"                        \
@@ -282,22 +285,21 @@ extern I_ SP_stack_ptr;
                      "\tmovl %%esi,4(%%eax)\n"                 \
                      "\tmovl %%edi,8(%%eax)\n"                 \
                      "\tmovl %%ebp,12(%%eax)\n"                \
                      "\tmovl %%esi,4(%%eax)\n"                 \
                      "\tmovl %%edi,8(%%eax)\n"                 \
                      "\tmovl %%ebp,12(%%eax)\n"                \
-                     "\tmovl %%esp,_MainRegTable+100"          \
                        : : "n" (RESERVED_C_STACK_BYTES)        \
                        : : "n" (RESERVED_C_STACK_BYTES)        \
-                       : "%eax");                              \
-    __asm__ volatile ("movl %%esp,%0"                          \
-                       : "=r" (SP_stack[++SP_stack_ptr]));
+                       : "%eax");
+
+/* the initial "addl $f,%esp" in ..._END compensates for
+   the "call" (rather than a jump) in miniInterpret.
+*/
 
 #define MINI_INTERPRETER_END                           \
     __asm__ volatile (".align 4\n"                     \
 
 #define MINI_INTERPRETER_END                           \
     __asm__ volatile (".align 4\n"                     \
-                     ".globl _miniInterpretEnd\n"      \
-                     "_miniInterpretEnd:\n"            \
+                     ".globl " MINI_INTERPRET_END "\n" \
+                     MINI_INTERPRET_END ":\n"          \
                      "\tnop"                           \
                        : : : "memory" );               \
                      "\tnop"                           \
                        : : : "memory" );               \
-    __asm__ volatile ("movl %0,%%esp\n"                        \
-                     "\tmovl %%esp,_MainRegTable+100"  \
-                       : : "m" (SP_stack[SP_stack_ptr--]) ); \
-    __asm__ volatile ("leal %c0(%%esp),%%eax\n"                \
+    __asm__ volatile ("addl $4,%%esp\n"                        \
+                     "\tleal %c0(%%esp),%%eax\n"       \
                      "\tmovl 0(%%eax),%%ebx\n"         \
                      "\tmovl 4(%%eax),%%esi\n"         \
                      "\tmovl 8(%%eax),%%edi\n"         \
                      "\tmovl 0(%%eax),%%ebx\n"         \
                      "\tmovl 4(%%eax),%%esi\n"         \
                      "\tmovl 8(%%eax),%%edi\n"         \
@@ -436,17 +438,77 @@ extern void __DISCARD__(STG_NO_ARGS);
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsubsection[COptJumps-RS6000]{Tail-jumping on an IBM RS6000 running AIX}
+\subsubsection[COptJumps-powerpc]{Tail-jumping on an IBM PowerPC running AIX}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-#if rs6000_ibm_aix_TARGET
+#if powerpc_TARGET_ARCH
 
 
-#define JMP_(cont)     ((F_) (cont))()
-/* partain: untested */
+/* do FUNBEGIN/END the easy way */
+#define FUNBEGIN    __asm__ volatile ("--- BEGIN ---");
+#define FUNEND      __asm__ volatile ("--- END ---");
+
+/* try "m68k-style" for now */
+extern void __DISCARD__(STG_NO_ARGS);
+
+/* this is "alpha-style" */
+#define JMP_(cont)                             \
+    do { void *_procedure = (void *)(cont);    \
+         goto *_procedure;                     \
+       } while(0)
+
+#define RESUME_(target)        JMP_(target)
+
+/* _All_ callee-saved regs, whether we steal them or not, must be saved
+   (and restored).
+*/
+
+#define MINI_INTERPRETER_SETUP                 \
+    StgChar space[RESERVED_C_STACK_BYTES+6*sizeof(double)+9*sizeof(long)]; \
+    __asm__ volatile ("addu $2,$sp,%0\n"       \
+                      "\ts.d $f20,0($2)\n"     \
+                      "\ts.d $f22,8($2)\n"     \
+                      "\ts.d $f24,16($2)\n"    \
+                      "\ts.d $f26,24($2)\n"    \
+                      "\ts.d $f28,32($2)\n"    \
+                      "\ts.d $f30,40($2)\n"    \
+                     "\tsw  $16,48($2)\n"      \
+                      "\tsw  $17,52($2)\n"     \
+                      "\tsw  $18,56($2)\n"     \
+                      "\tsw  $19,60($2)\n"     \
+                      "\tsw  $20,64($2)\n"     \
+                      "\tsw  $21,68($2)\n"     \
+                      "\tsw  $22,72($2)\n"     \
+                      "\tsw  $23,76($2)\n"     \
+                      "\tsw  $fp,80($2)\n"     \
+                      : : "I" (RESERVED_C_STACK_BYTES+16) : "$2" );
+
+    /* the 16 bytes is for the argument-register save-area above $sp */
+
+#define MINI_INTERPRETER_END                   \
+    __asm__ volatile (".align 2\n"             \
+                             ".globl miniInterpretEnd\n" \
+                      "miniInterpretEnd:\n"            \
+                     "\taddu $2,$sp,%0\n"      \
+                      "\tl.d $f20,0($2)\n"     \
+                      "\tl.d $f22,8($2)\n"     \
+                      "\tl.d $f24,16($2)\n"    \
+                      "\tl.d $f26,24($2)\n"    \
+                      "\tl.d $f28,32($2)\n"    \
+                      "\tl.d $f30,40($2)\n"    \
+                     "\tlw  $16,48($2)\n"      \
+                      "\tlw  $17,52($2)\n"     \
+                      "\tlw  $18,56($2)\n"     \
+                      "\tlw  $19,60($2)\n"     \
+                      "\tlw  $20,64($2)\n"     \
+                      "\tlw  $21,68($2)\n"     \
+                      "\tlw  $22,72($2)\n"     \
+                      "\tlw  $23,76($2)\n"     \
+                      "\tlw  $fp,80($2)\n"     \
+                      : : "I" (RESERVED_C_STACK_BYTES+16) : "$2" );
 
 
-#endif /* rs6000-ibm-aix* */
+#endif /* powerpc */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index 07d36c2..e6c3669 100644 (file)
@@ -62,7 +62,7 @@ typedef struct rt {
     P_ rHpLim;
     I_ rTag;
     StgRetAddr rRet;
     P_ rHpLim;
     I_ rTag;
     StgRetAddr rRet;
-    I_ rActivity;
+    I_ rActivity;      /* NB: UNUSED */
     P_ rCstkptr;       /* used for iX86 registerizing only! offset=100 */
     P_ rWrapReturn;    /* ditto; offset=104 */
     P_ rSaveECX;       /* ditto; offset=108 */
     P_ rCstkptr;       /* used for iX86 registerizing only! offset=100 */
     P_ rWrapReturn;    /* ditto; offset=104 */
     P_ rSaveECX;       /* ditto; offset=108 */
@@ -138,9 +138,10 @@ extern STGRegisterTable MainRegTable;
 #define MAIN_Dbl1          (MainRegTable.rDbl[0])
 #define MAIN_Dbl2          (MainRegTable.rDbl[1])
 
 #define MAIN_Dbl1          (MainRegTable.rDbl[0])
 #define MAIN_Dbl2          (MainRegTable.rDbl[1])
 
+#define MAIN_Hp            (MainRegTable.rHp)
+#define MAIN_HpLim         (MainRegTable.rHpLim)
 #define MAIN_Tag           (MainRegTable.rTag)
 #define MAIN_Ret           (MainRegTable.rRet)
 #define MAIN_Tag           (MainRegTable.rTag)
 #define MAIN_Ret           (MainRegTable.rRet)
-#define MAIN_Activity      (MainRegTable.rActivity)
 
 #define MAIN_StkO          (MainStkO)
 #define MAIN_Liveness      (MainRegTable.rLiveness)
 
 #define MAIN_StkO          (MainStkO)
 #define MAIN_Liveness      (MainRegTable.rLiveness)
@@ -175,7 +176,6 @@ extern STGRegisterTable MainRegTable;
                            
 #define SAVE_Tag           MAIN_Tag
 #define SAVE_Ret           MAIN_Ret
                            
 #define SAVE_Tag           MAIN_Tag
 #define SAVE_Ret           MAIN_Ret
-#define SAVE_Activity      MAIN_Activity
 
 #else
 
 
 #else
 
@@ -213,7 +213,6 @@ extern STGRegisterTable *CurrentRegTable;
 
 #define SAVE_Tag           (CurrentRegTable->rTag)
 #define SAVE_Ret           (CurrentRegTable->rRet)
 
 #define SAVE_Tag           (CurrentRegTable->rTag)
 #define SAVE_Ret           (CurrentRegTable->rRet)
-#define SAVE_Activity      (CurrentRegTable->rActivity)
 
 #define SAVE_StkO          (CurrentRegTable->rStkO)
 #define SAVE_Liveness      (CurrentRegTable->rLiveness)
 
 #define SAVE_StkO          (CurrentRegTable->rStkO)
 #define SAVE_Liveness      (CurrentRegTable->rLiveness)
@@ -772,8 +771,6 @@ RetReg              l0           $15    $22     %r10
 
 Liveness                                                       (CONCURRENT)  
 
 
 Liveness                                                       (CONCURRENT)  
 
-Activity        g5                                             (DO_SPAT_PROFILING)
-
 StdUpdRetVec#
 StkStub#        i7                  $23
 \end{verbatim}
 StdUpdRetVec#
 StkStub#        i7                  $23
 \end{verbatim}
@@ -840,7 +837,6 @@ context is saved, so the space does not go to waste.
 #define RTBL_HpLim         (BaseReg->rHpLim)
 #define RTBL_Tag           (BaseReg->rTag)
 #define RTBL_Ret           (BaseReg->rRet)
 #define RTBL_HpLim         (BaseReg->rHpLim)
 #define RTBL_Tag           (BaseReg->rTag)
 #define RTBL_Ret           (BaseReg->rRet)
-#define RTBL_Activity              (BaseReg->rActivity)
 #define RTBL_StkO          (BaseReg->rStkO)
 #define RTBL_Liveness      (BaseReg->rLiveness)
 
 #define RTBL_StkO          (BaseReg->rStkO)
 #define RTBL_Liveness      (BaseReg->rLiveness)
 
@@ -860,6 +856,12 @@ GLOBAL_REG_DECL(P_,StkOReg,REG_StkO)
 #define StkOReg RTBL_StkO
 #endif
 
 #define StkOReg RTBL_StkO
 #endif
 
+#ifndef __STG_REGS_AVAIL__ /* driver ensures it is 2 or more */
+# define __STG_REGS_AVAIL__ 8 /* R1 to R8 */
+/* this would only be non-8 if doing weird experiments (WDP 95/11) */
+/* or it might be set lower for a particular arch... */
+#endif
+
 /* R1 is used for Node */
 #ifdef REG_R1
 GLOBAL_REG_DECL(StgUnion,R1,REG_R1)
 /* R1 is used for Node */
 #ifdef REG_R1
 GLOBAL_REG_DECL(StgUnion,R1,REG_R1)
@@ -877,37 +879,37 @@ GLOBAL_REG_DECL(StgUnion,R2,REG_R2)
 #ifdef REG_R3
 GLOBAL_REG_DECL(StgUnion,R3,REG_R3)
 #else
 #ifdef REG_R3
 GLOBAL_REG_DECL(StgUnion,R3,REG_R3)
 #else
-#define R3 RTBL_R3
+# define R3 RTBL_R3
 #endif
 
 #ifdef REG_R4
 GLOBAL_REG_DECL(StgUnion,R4,REG_R4)
 #else
 #endif
 
 #ifdef REG_R4
 GLOBAL_REG_DECL(StgUnion,R4,REG_R4)
 #else
-#define R4 RTBL_R4
+# define R4 RTBL_R4
 #endif
 
 #ifdef REG_R5
 GLOBAL_REG_DECL(StgUnion,R5,REG_R5)
 #else
 #endif
 
 #ifdef REG_R5
 GLOBAL_REG_DECL(StgUnion,R5,REG_R5)
 #else
-#define R5 RTBL_R5
+# define R5 RTBL_R5
 #endif
 
 #ifdef REG_R6
 GLOBAL_REG_DECL(StgUnion,R6,REG_R6)
 #else
 #endif
 
 #ifdef REG_R6
 GLOBAL_REG_DECL(StgUnion,R6,REG_R6)
 #else
-#define R6 RTBL_R6
+# define R6 RTBL_R6
 #endif
 
 #ifdef REG_R7
 GLOBAL_REG_DECL(StgUnion,R7,REG_R7)
 #else
 #endif
 
 #ifdef REG_R7
 GLOBAL_REG_DECL(StgUnion,R7,REG_R7)
 #else
-#define R7 RTBL_R7
+# define R7 RTBL_R7
 #endif
 
 #ifdef REG_R8
 GLOBAL_REG_DECL(StgUnion,R8,REG_R8)
 #else
 #endif
 
 #ifdef REG_R8
 GLOBAL_REG_DECL(StgUnion,R8,REG_R8)
 #else
-#define R8 RTBL_R8
+# define R8 RTBL_R8
 #endif
 
 #ifdef REG_Flt1
 #endif
 
 #ifdef REG_Flt1
@@ -1003,12 +1005,6 @@ GLOBAL_REG_DECL(I_,LivenessReg,REG_Liveness)
 #define LivenessReg RTBL_Liveness
 #endif
 
 #define LivenessReg RTBL_Liveness
 #endif
 
-#ifdef REG_Activity
-GLOBAL_REG_DECL(I_,ActivityReg,REG_Activity)
-#else
-#define ActivityReg RTBL_Activity
-#endif
-
 #ifdef REG_StdUpdRetVec
 GLOBAL_REG_DECL(D_,StdUpdRetVecReg,REG_StdUpdRetVec)
 #else
 #ifdef REG_StdUpdRetVec
 GLOBAL_REG_DECL(D_,StdUpdRetVecReg,REG_StdUpdRetVec)
 #else
@@ -1213,18 +1209,10 @@ GLOBAL_REG_DECL(P_,StkStubReg,REG_StkStub)
 #define CALLER_RESTORE_Liveness        /* nothing */
 #endif
 
 #define CALLER_RESTORE_Liveness        /* nothing */
 #endif
 
-#ifdef CALLER_SAVES_Activity
-#define CALLER_SAVE_Activity   SAVE_Activity = ActivityReg;
-#define CALLER_RESTORE_Activity        ActivityReg = SAVE_Activity;
-#else
-#define CALLER_SAVE_Activity   /* nothing */
-#define CALLER_RESTORE_Activity        /* nothing */
-#endif
-
 #ifdef CALLER_SAVES_Base
 #ifndef CONCURRENT
 #define CALLER_SAVE_Base       /* nothing, ever (it holds a fixed value) */
 #ifdef CALLER_SAVES_Base
 #ifndef CONCURRENT
 #define CALLER_SAVE_Base       /* nothing, ever (it holds a fixed value) */
-#define CALLER_RESTORE_Base    BaseReg = MainRegTable;
+#define CALLER_RESTORE_Base    BaseReg = &MainRegTable;
 #else
 #define CALLER_SAVE_Base       /* nothing */
 #define CALLER_RESTORE_Base    BaseReg = CurrentRegTable;
 #else
 #define CALLER_SAVE_Base       /* nothing */
 #define CALLER_RESTORE_Base    BaseReg = CurrentRegTable;
index 7aa8286..da57a40 100644 (file)
@@ -185,7 +185,7 @@ void Yield_wrapper PROTO((W_));
 
 Call wrappers need to be able to call arbitrary functions, regardless of
 their arguments and return types.  (Okay, we actually only allow up to
 
 Call wrappers need to be able to call arbitrary functions, regardless of
 their arguments and return types.  (Okay, we actually only allow up to
-five arguments, because on the sparc it gets more complicated to handle
+five arguments, because on the SPARC it gets more complicated to handle
 any more.)  The nasty bit is that the return value can be in either an
 integer register or a floating point register, and we don't know which.
 (We {\em don't} handle structure returns, and we don't want to.)
 any more.)  The nasty bit is that the return value can be in either an
 integer register or a floating point register, and we don't know which.
 (We {\em don't} handle structure returns, and we don't want to.)
@@ -200,7 +200,7 @@ chock full of assembly gook for the current platform.  These are
 results, and @MAGIC_RETURN@, which collects all possible results back
 up again.
 
 results, and @MAGIC_RETURN@, which collects all possible results back
 up again.
 
-For example, in the sparc version, the @SETUP@ guarantees that we
+For example, in the SPARC version, the @SETUP@ guarantees that we
 have enough space to store all of our argument registers for a wee
 bit, and it gives a `C' name to the register that we're going to use
 for the call.  (It helps to do the call in actual `C' fashion, so that
 have enough space to store all of our argument registers for a wee
 bit, and it gives a `C' name to the register that we're going to use
 for the call.  (It helps to do the call in actual `C' fashion, so that
@@ -223,8 +223,7 @@ gets whatever it's after.
 
 #if defined(__GNUC__) && defined(__STG_GCC_REGS__)
 
 
 #if defined(__GNUC__) && defined(__STG_GCC_REGS__)
 
-#if alpha_dec_osf1_TARGET
-    /* Is this too specific */
+#if alpha_TARGET_ARCH
 
 #define MAGIC_CALL_SETUP       \
     long WeNeedThisSpace[7];   \
 
 #define MAGIC_CALL_SETUP       \
     long WeNeedThisSpace[7];   \
@@ -277,7 +276,7 @@ gets whatever it's after.
 
 #define SET_RETADDR(loc)  { register StgFunPtrFunPtr ra __asm__ ("$26"); loc = ra; }
 
 
 #define SET_RETADDR(loc)  { register StgFunPtrFunPtr ra __asm__ ("$26"); loc = ra; }
 
-#define WRAPPER_SETUP(f)  SaveAllStgContext();
+#define WRAPPER_SETUP(f,ignore1,ignore2)  SaveAllStgContext();
 
 #define WRAPPER_RETURN(x)   \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
 
 #define WRAPPER_RETURN(x)   \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
@@ -296,8 +295,7 @@ gets whatever it's after.
 
 \begin{code}
 
 
 \begin{code}
 
-#if hppa1_1_hp_hpux_TARGET
-    /* Is this too specific */
+#if hppa1_1_TARGET_ARCH
 
 #define MAGIC_CALL_SETUP           \
     long SavedIntArgRegs[4];       \
 
 #define MAGIC_CALL_SETUP           \
     long SavedIntArgRegs[4];       \
@@ -353,7 +351,7 @@ gets whatever it's after.
 
 #define SET_RETADDR(loc)  __asm__ volatile ("stw %%r2, %0" : "=m" ((void *)(loc)));
 
 
 #define SET_RETADDR(loc)  __asm__ volatile ("stw %%r2, %0" : "=m" ((void *)(loc)));
 
-#define WRAPPER_SETUP(f)  SaveAllStgContext();
+#define WRAPPER_SETUP(f,ignore1,ignore2)  SaveAllStgContext();
 
 #define WRAPPER_RETURN(x)   \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
 
 #define WRAPPER_RETURN(x)   \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
@@ -371,65 +369,57 @@ gets whatever it's after.
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-
-#if i386_TARGET_ARCH || i486_TARGET_ARCH
+#if i386_TARGET_ARCH
 
 /* modelled loosely on SPARC stuff */
 
 /* NB: no MAGIC_CALL_SETUP, MAGIC_CALL, or MAGIC_RETURN! */
 
 
 /* modelled loosely on SPARC stuff */
 
 /* NB: no MAGIC_CALL_SETUP, MAGIC_CALL, or MAGIC_RETURN! */
 
-#define WRAPPER_NAME(f)          __asm__("L" #f "_wrapper")
+#define WRAPPER_NAME(f) /*nothing*/
 
 
+#ifdef solaris2_TARGET_OS
+#define REAL_NAME(f)   #f
+#else
 #define REAL_NAME(f)   "_" #f
 #define REAL_NAME(f)   "_" #f
+#endif
 
 
-/* when we come into PerformGC_wrapper:
+/* 
+   Threaded code needs to be able to grab the return address, in case we have
+   an intervening context switch.
+ */
 
 
-    - %esp holds Hp (!); get it into 80(%ebx) -- quick!
+#define SET_RETADDR(loc,val) loc = val;
 
 
-    - %esp needs to be bumped by (at least) 4, because
-      C thinks an argument was passed on the stack
-      (use 64 just for fun)
+/* the grab-%eax-quickly HACK is here because we use a VERY SPECIAL
+   calling convention on iX86 just for calling PerformGC_wrapper.
+   (WDP 95/09)
 
 
-    - %eax holds the argument for PerformGC
+   NB: mangler makes sure that __temp_{eax,esp} get loaded.
+   (This is about as ugly as it can get.)
+*/
 
 
-    - 104(%ebx) hold the return address -- address we want to
-      go back to
+#define WRAPPER_SETUP(f,ret_addr,args)                 \
+    __asm__ volatile (                                 \
+       "movl "   REAL_NAME(__temp_esp)  ",%%edx\n"     \
+       "\tmovl (%%edx),%0\n"                           \
+       "\tmovl " REAL_NAME(__temp_eax) ",%1"           \
+       : "=r" (ret_addr), "=r" (args) );               \
+    SaveAllStgContext(ret_addr);
 
 
-    - 100(%ebx) holds a %esp value that we can re-load with
-      if need be
+/* Note re WRAPPER_SETUP: we have special code just for PerformGC_wrapper;
+   pls see its definition.  WDP 95/09
 
 
+   Also note the EXTREMELY UGLY slamming in of an "sp_offset"; the
+   return address *is* on the stack, but it is hard to get there
+   before GCC has moved the sp pointer... WDP 95/11
 */
 */
-#define WRAPPER_SETUP(f)                       \
-    __asm__ volatile (                         \
-        ".globl " REAL_NAME(f) "_wrapper\n"    \
-        REAL_NAME(f) "_wrapper:\n"             \
-        "\tmovl %%esp,80(%%ebx)\n"             \
-        "\tmovl 100(%%ebx),%%esp\n"            \
-        "\tmovl %%eax,%0\n"                    \
-       "\tincl _SP_stack_ptr\n"                \
-       "\tmovl _SP_stack_ptr,%%eax\n"          \
-       "\tmovl %%esp,_SP_stack(,%%eax,4)\n"    \
-       "\tsubl $64,%%esp"                      \
-       : "=r" (args));                         \
-    SaveAllStgContext();
-
-#define WRAPPER_RETURN(x)                      \
-    do {P_ foo;                                        \
-       RestoreAllStgRegs();                    \
-       if(x) JMP_(EnterNodeCode); /* never used? */ \
-       __asm__ volatile (                      \
-       "movl %1,%0\n"                          \
-       "\tmovl %0,_MainRegTable+100"           \
-       : "=r" (foo) : "m" (SP_stack[SP_stack_ptr--]) ); \
-       __asm__ volatile (                      \
-       "movl 80(%ebx),%esp\n"                  \
-       "\tjmp *104(%ebx)" );                   \
-    } while(0);
+
+#define WRAPPER_RETURN(x)   \
+    do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
 
 #define SEPARATE_WRAPPER_RESTORE    /* none */
 
 #endif /* iX86 */
 
 #define SEPARATE_WRAPPER_RESTORE    /* none */
 
 #endif /* iX86 */
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -466,7 +456,7 @@ gets whatever it's after.
 
 #define WRAPPER_NAME(f)          /* nothing */
 
 
 #define WRAPPER_NAME(f)          /* nothing */
 
-#define WRAPPER_SETUP(f)  SaveAllStgContext();
+#define WRAPPER_SETUP(f,ignore1,ignore2)  SaveAllStgContext();
 
 #define WRAPPER_RETURN(x)  \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
 
 #define WRAPPER_RETURN(x)  \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
@@ -513,7 +503,7 @@ gets whatever it's after.
 
 #define WRAPPER_NAME(f)          /* nothing */
 
 
 #define WRAPPER_NAME(f)          /* nothing */
 
-#define WRAPPER_SETUP(f)  SaveAllStgContext();
+#define WRAPPER_SETUP(f,ignore1,ignore2)  SaveAllStgContext();
 
 #define WRAPPER_RETURN(x)  \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
 
 #define WRAPPER_RETURN(x)  \
     do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
@@ -525,6 +515,52 @@ gets whatever it's after.
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
+\subsubsection[powerpc-magic]{Call-wrapper MAGIC for PowerPC}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+#if powerpc_TARGET_ARCH
+
+/* shift 4 arg registers down one */
+
+#define MAGIC_CALL_SETUP  \
+    register void (*f)() __asm__("$2");        \
+    __asm__ volatile (                 \
+    "move $2,$4\n"                     \
+    "\tmove $4,$5\n"                   \
+    "\tmove $5,$6\n"                   \
+    "\tmove $6,$7\n"                   \
+    "\tlw $7,16($sp)\n"                        \
+    "\taddu $sp,$sp,4\n"               \
+    : : : "$2" );
+
+#define MAGIC_CALL             \
+    (*f)();                    \
+     __asm__ volatile (                \
+    "subu $sp,$sp,4\n"         \
+    "\ts.d $f0, -8($sp)\n"     \
+    "\tsw  $2, -12($sp)");
+
+#define MAGIC_RETURN           \
+    __asm__ volatile (         \
+    "l.d $f0, -8($sp)\n"       \
+    "\tlw  $2, -12($sp)");
+
+#define WRAPPER_NAME(f)          /* nothing */
+
+#define WRAPPER_SETUP(f,ignore1,ignore2)  SaveAllStgContext();
+
+#define WRAPPER_RETURN(x)  \
+    do {RestoreAllStgRegs(); if(x) JMP_(EnterNodeCode);} while(0);
+
+#define SEPARATE_WRAPPER_RESTORE    /* none */
+
+#endif /* powerpc */
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsubsection[sparc-magic]{Call-wrapper MAGIC for SPARC}
 %*                                                                     *
 %************************************************************************
 \subsubsection[sparc-magic]{Call-wrapper MAGIC for SPARC}
 %*                                                                     *
 %************************************************************************
@@ -561,10 +597,10 @@ gets whatever it's after.
         "\tldd [%fp-32],%i0");
 
 /* 
         "\tldd [%fp-32],%i0");
 
 /* 
-   We rename the entry points for wrappers so that we can
-   introduce a new entry point after the prologue.  We want to ensure
-   that the register window does not slide!  However, we insert a 
-   call to abort() to make gcc _believe_ that the window slid.
+   We rename the entry points for wrappers so that we can introduce a
+   new entry point after the prologue.  We want to ensure that the
+   register window does not slide!  However, we insert a call to
+   abort() to make gcc _believe_ that the window slid.
  */
 
 #define WRAPPER_NAME(f)          __asm__("L" #f "_wrapper")
  */
 
 #define WRAPPER_NAME(f)          __asm__("L" #f "_wrapper")
@@ -575,7 +611,7 @@ gets whatever it's after.
 #define REAL_NAME(f)   "_" #f
 #endif
 
 #define REAL_NAME(f)   "_" #f
 #endif
 
-#define WRAPPER_SETUP(f)                   \
+#define WRAPPER_SETUP(f,ignore1,ignore2)    \
     __asm__ volatile (                     \
         ".global " REAL_NAME(f) "_wrapper\n"\
         REAL_NAME(f) "_wrapper:\n"         \
     __asm__ volatile (                     \
         ".global " REAL_NAME(f) "_wrapper\n"\
         REAL_NAME(f) "_wrapper:\n"         \
@@ -587,15 +623,17 @@ gets whatever it's after.
        "\tmov %i0,%o0\n"                   \
        "\tmov %i1,%o1");
 /* 
        "\tmov %i0,%o0\n"                   \
        "\tmov %i1,%o1");
 /* 
- * In the above, we want to ensure that the arguments are both in the %i registers
- * and the %o registers, with the assumption that gcc will expect them now to be in
- * one or the other.  This is a terrible hack.
+ * In the above, we want to ensure that the arguments are both in the
+ * %i registers and the %o registers, with the assumption that gcc
+ * will expect them now to be in one or the other.  This is a terrible
+ * hack.
  */
 
 /* 
  */
 
 /* 
-   Threaded code needs to be able to grab the return address, in case we have
-   an intervening context switch.  Note that we want the address of the next
-   instruction to be executed, so we add 8 to the link address.
+   Threaded code needs to be able to grab the return address, in case
+   we have an intervening context switch.  Note that we want the
+   address of the next instruction to be executed, so we add 8 to the
+   link address.
  */
 
 #define SET_RETADDR(loc)       \
  */
 
 #define SET_RETADDR(loc)       \
index 05297e2..ed1fe26 100644 (file)
@@ -15,7 +15,7 @@ environment to be defined, despite the fact that we don't have CostCentre
 fields in closures.
 
 \begin{code}
 fields in closures.
 
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
 
 # define CC_EXTERN(cc_ident)                                   \
      extern struct cc CAT2(cc_ident,_struct);                  \
 
 # define CC_EXTERN(cc_ident)                                   \
      extern struct cc CAT2(cc_ident,_struct);                  \
@@ -28,7 +28,7 @@ extern CostCentre Registered_CC;/* registered cost centre list */
 CC_EXTERN(CC_MAIN);            /* initial MAIN cost centre */
 CC_EXTERN(CC_GC);              /* Garbage Collection cost center */
 
 CC_EXTERN(CC_MAIN);            /* initial MAIN cost centre */
 CC_EXTERN(CC_GC);              /* Garbage Collection cost center */
 
-# ifdef GUM
+# ifdef PAR
 CC_EXTERN(CC_MSG);             /* Communications cost center */
 CC_EXTERN(CC_IDLE);             /* Idle-time cost centre */
 # endif
 CC_EXTERN(CC_MSG);             /* Communications cost center */
 CC_EXTERN(CC_IDLE);             /* Idle-time cost centre */
 # endif
@@ -59,7 +59,7 @@ source using the @CC_DECLARE@ macro where @label@, @module@ and
           subsumed, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};       \
      is_local CostCentre cc_ident = STATIC_CC_REF(cc_ident)
 
           subsumed, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};       \
      is_local CostCentre cc_ident = STATIC_CC_REF(cc_ident)
 
-#endif /* defined(USE_COST_CENTRES) || defined(CONCURRENT) */
+#endif /* defined(PROFILING) || defined(CONCURRENT) */
 \end{code}
 
 Definitions relating to the profiling field as a whole.
 \end{code}
 
 Definitions relating to the profiling field as a whole.
@@ -79,13 +79,13 @@ Definitions relating to the profiling field as a whole.
 %************************************************************************
 
 The cost-centre profiling is only on if the driver turns on
 %************************************************************************
 
 The cost-centre profiling is only on if the driver turns on
-@USE_COST_CENTRES@.
+@PROFILING@.
 
 These are the {\em dummy} definitions in force if we do {\em NOT}
 
 These are the {\em dummy} definitions in force if we do {\em NOT}
-turn on @USE_COST_CENTRES@.  Get them out of the way....
+turn on @PROFILING@.  Get them out of the way....
 
 \begin{code}
 
 \begin{code}
-#if !defined(USE_COST_CENTRES)
+#if !defined(PROFILING)
 
 /*** Declaration Definitions ***/
 
 
 /*** Declaration Definitions ***/
 
@@ -114,13 +114,13 @@ turn on @USE_COST_CENTRES@.  Get them out of the way....
 # define CC_ALLOC(cc, size, kind)
 # define HEAP_PROFILE_CLOSURE(closure,size)
 
 # define CC_ALLOC(cc, size, kind)
 # define HEAP_PROFILE_CLOSURE(closure,size)
 
-# ifndef GUM
+# ifndef PAR
 #  define START_TIME_PROFILER
 #  define RESTART_TIME_PROFILER
 #  define STOP_TIME_PROFILER
 # endif
 
 #  define START_TIME_PROFILER
 #  define RESTART_TIME_PROFILER
 #  define STOP_TIME_PROFILER
 # endif
 
-#endif /* !defined(USE_COST_CENTRES) */
+#endif /* !defined(PROFILING) */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -142,7 +142,7 @@ an additional cost centre field within the fixed header of all
 closures. This is adjacent to the info pointer.
 
 \begin{code}
 closures. This is adjacent to the info pointer.
 
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 
 CC_EXTERN(CC_SUBSUMED);        /* top level fns SUBSUMED cost centre */
 CC_EXTERN(CC_OVERHEAD);        /* costs due only to profiling machinery */
 
 CC_EXTERN(CC_SUBSUMED);        /* top level fns SUBSUMED cost centre */
 CC_EXTERN(CC_OVERHEAD);        /* costs due only to profiling machinery */
@@ -278,7 +278,7 @@ On entering a closure we only count the enter to thunks ...
 # define ENTER_CC_PAP_CL(closure)                      \
        ENTER_CC_PAP(CC_HDR(closure))
 
 # define ENTER_CC_PAP_CL(closure)                      \
        ENTER_CC_PAP(CC_HDR(closure))
 
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -306,7 +306,7 @@ centre. @REGISTER_IMPORT@ pushes a modules registering routine onto
 the register stack.
 
 \begin{code}
 the register stack.
 
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 
 extern F_ _regMain (STG_NO_ARGS);
 extern F_ *register_stack;
 
 extern F_ _regMain (STG_NO_ARGS);
 extern F_ *register_stack;
@@ -317,8 +317,6 @@ extern F_ *register_stack;
 # define POP_REGISTER_STACK                                            \
        *(--register_stack)
 
 # define POP_REGISTER_STACK                                            \
        *(--register_stack)
 
-extern I_ SM_trace;
-
 # define START_REGISTER_CCS(reg_mod_name)                              \
        static int _module_registered = 0;                              \
        STGFUN(reg_mod_name) {                                          \
 # define START_REGISTER_CCS(reg_mod_name)                              \
        static int _module_registered = 0;                              \
        STGFUN(reg_mod_name) {                                          \
@@ -350,12 +348,12 @@ extern I_ SM_trace;
        } while(0);                                                     \
        FUNEND; }
 
        } while(0);                                                     \
        FUNEND; }
 
-#endif  /* USE_COST_CENTRES */
+#endif  /* PROFILING */
 \end{code}
 
 We don't want to attribute costs to an unregistered cost-centre:
 \begin{code}
 \end{code}
 
 We don't want to attribute costs to an unregistered cost-centre:
 \begin{code}
-#if !defined(USE_COST_CENTRES) || !defined(DEBUG)
+#if !defined(PROFILING) || !defined(DEBUG)
 # define ASSERT_IS_REGISTERED(cc,chk_not_overhead) /*nothing*/
 #else
 # define ASSERT_IS_REGISTERED(cc,chk_not_overhead)                             \
 # define ASSERT_IS_REGISTERED(cc,chk_not_overhead) /*nothing*/
 #else
 # define ASSERT_IS_REGISTERED(cc,chk_not_overhead)                             \
@@ -401,7 +399,7 @@ Similarily, the SP stuff should probably be the highly uninformative
 @INTERNAL_KIND@.
 
 \begin{code}
 @INTERNAL_KIND@.
 
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 
 # define CON_K         1
 # define FN_K          2
 
 # define CON_K         1
 # define FN_K          2
@@ -438,7 +436,7 @@ typedef struct ClCat {
 # define CAT_DECLARE(base_name, kind, descr, type) \
        static struct ClCat MK_CAT_IDENT(base_name) = {UNHASHED,-1,kind,descr,type};
 
 # define CAT_DECLARE(base_name, kind, descr, type) \
        static struct ClCat MK_CAT_IDENT(base_name) = {UNHASHED,-1,kind,descr,type};
 
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -449,7 +447,7 @@ typedef struct ClCat {
 
 Stuff to do with timer signals:
 \begin{code}
 
 Stuff to do with timer signals:
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
 
 extern I_ time_profiling;      /* Flag indicating if timer/serial profiling is required */
 
 
 extern I_ time_profiling;      /* Flag indicating if timer/serial profiling is required */
 
@@ -468,11 +466,6 @@ extern void stop_time_profiler(STG_NO_ARGS);
 # define TICK_FREQUENCY                50                      /* ticks per second */
 # define TICK_MILLISECS                (1000/TICK_FREQUENCY)   /* milli-seconds per tick */
 
 # define TICK_FREQUENCY                50                      /* ticks per second */
 # define TICK_MILLISECS                (1000/TICK_FREQUENCY)   /* milli-seconds per tick */
 
-# ifdef CONCURRENT
-extern I_ profilerTicks;
-extern I_ tick_millisecs;
-# endif
-
 # define DEFAULT_INTERVAL      TICK_FREQUENCY          /* 1 second */
 
 /* These are never called directly from threaded code */
 # define DEFAULT_INTERVAL      TICK_FREQUENCY          /* 1 second */
 
 /* These are never called directly from threaded code */
@@ -480,7 +473,7 @@ extern I_ tick_millisecs;
 # define RESTART_TIME_PROFILER ULTRASAFESTGCALL0(void,(void *),restart_time_profiler)          /*R StgOverflow.lc */
 # define STOP_TIME_PROFILER    ULTRASAFESTGCALL0(void,(void *),stop_time_profiler)             /*R StgOverflow.lc */
 
 # define RESTART_TIME_PROFILER ULTRASAFESTGCALL0(void,(void *),restart_time_profiler)          /*R StgOverflow.lc */
 # define STOP_TIME_PROFILER    ULTRASAFESTGCALL0(void,(void *),stop_time_profiler)             /*R StgOverflow.lc */
 
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
 #  define OR_INTERVAL_EXPIRED  || (interval_expired)           /*R StgMacros.h */
 # endif
 \end{code}
 #  define OR_INTERVAL_EXPIRED  || (interval_expired)           /*R StgMacros.h */
 # endif
 \end{code}
@@ -528,7 +521,7 @@ which to store profiling information based on the return table size
 value(s).
 
 \begin{code}
 value(s).
 
 \begin{code}
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
 
 #  define DEFAULT_MAX_CC     4096
 #  define DEFAULT_MAX_MOD     256
 
 #  define DEFAULT_MAX_CC     4096
 #  define DEFAULT_MAX_MOD     256
@@ -561,7 +554,7 @@ extern ClCategory *index_type_table;
 extern hash_t init_index_type(STG_NO_ARGS);
 extern hash_t index_type PROTO((ClCategory clcat));
 
 extern hash_t init_index_type(STG_NO_ARGS);
 extern hash_t index_type PROTO((ClCategory clcat));
 
-# endif /* USE_COST_CENTRES */
+# endif /* PROFILING */
 \end{code}
 
 
 \end{code}
 
 
@@ -582,12 +575,12 @@ memory alloc macros.
        centre->time_ticks += 1;                                        \
        } while(0)
 
        centre->time_ticks += 1;                                        \
        } while(0)
 
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
 #  define CC_ALLOC(cc, size, kind)                                     \
        do { CostCentre cc_ = (CostCentre) (cc);                        \
        ASSERT_IS_REGISTERED(cc_,0/*OK if OVERHEAD*/);                  \
        cc_->mem_allocs += 1;                                           \
 #  define CC_ALLOC(cc, size, kind)                                     \
        do { CostCentre cc_ = (CostCentre) (cc);                        \
        ASSERT_IS_REGISTERED(cc_,0/*OK if OVERHEAD*/);                  \
        cc_->mem_allocs += 1;                                           \
-       cc_->mem_alloc  += (size) - (PROF_FIXED_HDR + AGE_FIXED_HDR);   \
+       cc_->mem_alloc  += (size) - (PROF_FIXED_HDR + TICKY_FIXED_HDR); \
        } while(0) /* beware name-capture by ASSERT_IS...! */
 # endif
 \end{code}
        } while(0) /* beware name-capture by ASSERT_IS...! */
 # endif
 \end{code}
@@ -600,19 +593,12 @@ memory alloc macros.
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-extern I_  cc_profiling;       /* Are we performing/reporting cc profiling? */
-extern I_  heap_profiling_reqd;        /* Are we performing heap profiling? */
+I_     init_cc_profiling PROTO((I_ rts_argc, char *rts_argv[], char *prog_argv[]));
+void   report_cc_profiling PROTO((I_ final));
 
 
-# define SORTCC_LABEL  'C'
-# define SORTCC_TIME   'T'
-# define SORTCC_ALLOC  'A'
-extern char cc_profiling_sort; /* How to sort cost centre report */
-
-extern I_  init_cc_profiling PROTO((I_ rts_argc, char *rts_argv[], char *prog_argv[]));
-extern void report_cc_profiling PROTO((I_ final));
-
-extern void cc_register(STG_NO_ARGS);
-extern void cc_sort PROTO((CostCentre *sort, char sort_on));
+void   cc_register(STG_NO_ARGS);
+void   cc_sort PROTO((CostCentre *sort, char sort_on));
+rtsBool cc_to_ignore PROTO((CostCentre));
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -622,32 +608,14 @@ extern void cc_sort PROTO((CostCentre *sort, char sort_on));
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-# define HEAP_NO_PROFILING     0       /* N.B. Used as indexes into arrays */
-
-# if defined(USE_COST_CENTRES)
-
-#  define HEAP_BY_CC           1
-#  define HEAP_BY_MOD          2
-#  define HEAP_BY_GRP          3
-#  define HEAP_BY_DESCR                4
-#  define HEAP_BY_TYPE         5
-#  define HEAP_BY_TIME         6
-  
-#  define CCchar    'C'
-#  define MODchar   'M'
-#  define GRPchar   'G'
-#  define DESCRchar 'D'
-#  define TYPEchar  'Y'
-#  define TIMEchar  'T'
-
-extern I_ heap_profile_init PROTO((I_ prof,
-                                  char *select_cc_str,
+# if defined(PROFILING)
+
+extern I_ heap_profile_init PROTO((char *select_cc_str,
                                   char *select_mod_str,
                                   char *select_grp_str,
                                   char *select_descr_str,
                                   char *select_typ_str,
                                   char *select_kind_str,
                                   char *select_mod_str,
                                   char *select_grp_str,
                                   char *select_descr_str,
                                   char *select_typ_str,
                                   char *select_kind_str,
-                                  I_  select_age,
                                   char *argv[]));
 
 extern void heap_profile_finish(STG_NO_ARGS);
                                   char *argv[]));
 
 extern void heap_profile_finish(STG_NO_ARGS);
@@ -663,12 +631,12 @@ extern hash_t time_intervals;             /* no. of time intervals reported -- 18 */
 #  define HEAP_PROFILE_CLOSURE(closure,size) \
        STGCALL2(void,(void *, P_, I_),(*heap_profile_fn),closure,size)                 /*R SM2s.lh */
 
 #  define HEAP_PROFILE_CLOSURE(closure,size) \
        STGCALL2(void,(void *, P_, I_),(*heap_profile_fn),closure,size)                 /*R SM2s.lh */
 
-# endif        /* USE_COST_CENTRES */
+# endif        /* PROFILING */
 \end{code}
 
 End multi-slurp protection:
 \begin{code}
 \end{code}
 
 End multi-slurp protection:
 \begin{code}
-#endif /* USE_COST_CENTRES || GUM */
+#endif /* PROFILING || PAR */
 
 #endif /* CostCentre_H */
 \end{code}
 
 #endif /* CostCentre_H */
 \end{code}
diff --git a/ghc/includes/Force_GC.lh b/ghc/includes/Force_GC.lh
deleted file mode 100644 (file)
index 66a4ce6..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-%************************************************************************
-%*                                                                     *
-\subsection[Force_GC.lh]{}
-%*                                                                     *
-%************************************************************************
-
-Multi-slurp protection:
-\begin{code}
-#ifndef Force_GC_H
-#define Force_GC_H
-
-#ifdef FORCE_GC
-extern I_  force_GC;           /* Are we forcing GC ? */
-extern I_  GCInterval;         /* GC resolution  (in words allocated) */
-extern I_  alloc_since_last_major_GC; /* words allocated since last major GC */
-
-#define DEFAULT_GC_INTERVAL  5000000
-
-#endif /* FORCE_GC */
-\end{code}
-
-End multi-slurp protection:
-\begin{code}
-#endif /* ! Force_GC_H */
-\end{code}
index 08e6ea6..f769205 100644 (file)
@@ -123,39 +123,6 @@ Range of built-in table of static small int-like closures.
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsection[string-size]{Maximum size of cost centre and description strings}
-%*                                                                     *
-%************************************************************************
-
-This is the maximum identifier length that can be used for a cost
-centre or description string. It includes the terminating null
-character.
-
-WDP 95/07: I think this STRING_SIZE thing is completely redundant.
-
-The printf formats are here, so we are less likely to make overly-long
-filenames (with disastrous results).  No more than 128 chars, please!
-
-\begin{code}
-#define STRING_SIZE 128
-
-#define STATS_FILENAME_MAXLEN  128
-
-#define GR_FILENAME_FMT                "%0.124s.gr"
-#define GR_FILENAME_FMT_GUM    "%0.120s.%03d.gr"
-#define HP_FILENAME_FMT                "%0.124s.hp"
-#define LIFE_FILENAME_FMT      "%0.122s.life"
-#define PROF_FILENAME_FMT      "%0.122s.prof"
-#define PROF_FILENAME_FMT_GUM  "%0.118s.%03d.prof"
-#define QP_FILENAME_FMT                "%0.124s.qp"
-#define STAT_FILENAME_FMT      "%0.122s.stat"
-#define TICKY_FILENAME_FMT     "%0.121s.ticky"
-#define TIME_FILENAME_FMT      "%0.122s.time"
-#define TIME_FILENAME_FMT_GUM  "%0.118s.%03d.time"
-\end{code}
-
-%************************************************************************
-%*                                                                     *
 \subsection[update-frame-size]{Update frame size}
 %*                                                                     *
 %************************************************************************
 \subsection[update-frame-size]{Update frame size}
 %*                                                                     *
 %************************************************************************
@@ -187,7 +154,7 @@ If cost-centres are being used we have to add to the above sizes:
 If we are compiling C code the use of cost centres is determined at
 compile time so we use conditional macro definitions.
 \begin{code}
 If we are compiling C code the use of cost centres is determined at
 compile time so we use conditional macro definitions.
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 #define STD_UF_SIZE    SCC_STD_UF_SIZE
 #define CON_UF_SIZE    SCC_CON_UF_SIZE
 #else
 #define STD_UF_SIZE    SCC_STD_UF_SIZE
 #define CON_UF_SIZE    SCC_CON_UF_SIZE
 #else
@@ -221,9 +188,12 @@ what.
 Tags for indirection nodes and ``other'' (probably unevaluated) nodes;
 normal-form values of algebraic data types will have tags 0, 1, ...
 
 Tags for indirection nodes and ``other'' (probably unevaluated) nodes;
 normal-form values of algebraic data types will have tags 0, 1, ...
 
+@INFO_IND_TAG@ is different from @INFO_OTHER_TAG@ just so we can count
+how often we bang into indirection nodes; that's all.  (WDP 95/11)
+
 \begin{code}
 #define INFO_OTHER_TAG         (-1)
 \begin{code}
 #define INFO_OTHER_TAG         (-1)
-#define INFO_IND_TAG           (-1)
+#define INFO_IND_TAG           (-2)
 #define INFO_FIRST_TAG         0
 \end{code}
 
 #define INFO_FIRST_TAG         0
 \end{code}
 
index 40eb8f4..74ab648 100644 (file)
@@ -1,5 +1,6 @@
 LH_FILES = \
 LH_FILES = \
-rtsTypes.lh    /* runtime system */ \
+RtsTypes.lh    /* runtime system */ \
+RtsFlags.lh \
 \
 SMinterface.lh /* storage-management related */ \
 SMClosures.lh \
 \
 SMinterface.lh /* storage-management related */ \
 SMClosures.lh \
@@ -19,13 +20,11 @@ COptWraps.lh \
 \
 GhcConstants.lh \
 \
 \
 GhcConstants.lh \
 \
-RednCounts.lh  /* "ticky-ticky" profiling */ \
+Ticky.lh       /* "ticky-ticky" profiling */ \
 \
 Info.lh                /* Info pointer definitions */ \
 \
 CostCentre.lh   /* for cost centre profiling */ \
 \
 Info.lh                /* Info pointer definitions */ \
 \
 CostCentre.lh   /* for cost centre profiling */ \
-AgeProfile.lh  /* age stuff for heap and lifetime profiling */ \
-Force_GC.lh    /* for forcing GC */ \
 \
 GranSim.lh  \
 Parallel.lh    /* for PAR build */ \
 \
 GranSim.lh  \
 Parallel.lh    /* for PAR build */ \
index 91c6353..6e098a0 100644 (file)
@@ -377,9 +377,6 @@ stack pointer.  \tr{%eax} and \tr{%edx} are return values from C functions,
 hence they get trashed across ccalls and are caller saves. \tr{%ebx},
 \tr{%esi}, \tr{%edi}, \tr{%ebp} are all callee-saves.
 
 hence they get trashed across ccalls and are caller saves. \tr{%ebx},
 \tr{%esi}, \tr{%edi}, \tr{%ebp} are all callee-saves.
 
-We only steal \tr{%ebx} for base registers.  SIGH.  SimonM also took
-\tr{%esi} for SpA and \tr{%edi} for SpB.  Maybe later.
-
 \begin{code}
 #if i386_TARGET_ARCH
 
 \begin{code}
 #if i386_TARGET_ARCH
 
@@ -402,7 +399,9 @@ We only steal \tr{%ebx} for base registers.  SIGH.  SimonM also took
 #define REG_Scav       ebx
 #define REG_ToHp       ebp
 #if defined(GCap) || defined(GCgn)
 #define REG_Scav       ebx
 #define REG_ToHp       ebp
 #if defined(GCap) || defined(GCgn)
+/* NO: -concurrent croaks on SMevac.lc with this
 #define REG_OldGen     esi
 #define REG_OldGen     esi
+*/
 #endif /* GCap || GCgn */
 
 #else  /* default: MAIN_REG_MAP */
 #endif /* GCap || GCgn */
 
 #else  /* default: MAIN_REG_MAP */
@@ -424,7 +423,12 @@ We only steal \tr{%ebx} for base registers.  SIGH.  SimonM also took
    - give back ebp
 */
 
    - give back ebp
 */
 
-/* SpB and R1 are the two heaviest hitters, followed by SpA */
+/* SpB and R1 are the two heaviest hitters, followed by SpA.
+   Hp comes next, followed closely by R2;
+   then RetReg, then R3 and R4.
+   At least based on some static counts.
+   SIGH.  WDP 95/09
+*/
 #define REG_Base    ebx
 #define REG_SpB            ebp
 #if STOLEN_X86_REGS >= 3
 #define REG_Base    ebx
 #define REG_SpB            ebp
 #if STOLEN_X86_REGS >= 3
@@ -435,15 +439,16 @@ We only steal \tr{%ebx} for base registers.  SIGH.  SimonM also took
 # define REG_SpA    edi
 # define CALLEE_SAVES_SpA
 #endif
 # define REG_SpA    edi
 # define CALLEE_SAVES_SpA
 #endif
-/* the mangler will put Hp in %esp!!! */
-#if defined(MANGLING_X86_SP) && MANGLING_X86_SP == 0
-Oops! You should not be here if not mangling %esp!
-#endif
 #if STOLEN_X86_REGS >= 5
 #if STOLEN_X86_REGS >= 5
-# define REG_R2    ecx
-# define CALLER_SAVES_R2
+/*
+# define REG_Hp    ecx
+# define CALLER_SAVES_Hp
+# define CALLER_SAVES_SYSTEM
+*/
+/* because we *might* have Hp in a caller-saves register */
 #endif
 
 #endif
 
+
 #endif /* SCAV_REG_MAP */
 #endif /* SCAN_REG_MAP */
 #endif /* MARK_REG_MAP */
 #endif /* SCAV_REG_MAP */
 #endif /* SCAN_REG_MAP */
 #endif /* MARK_REG_MAP */
@@ -692,7 +697,7 @@ We can steal some, but we might have to save/restore around ccalls.
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsubsection[mapping-rs6000]{The IBM RS6000 register mapping}
+\subsubsection[mapping-powerpc]{The PowerPC register mapping}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
@@ -703,25 +708,91 @@ We can steal some, but we might have to save/restore around ccalls.
 
 I think we can do the Whole Business with callee-save registers only!
 
 
 I think we can do the Whole Business with callee-save registers only!
 
-UTTERLY UNTESTED
-
 \begin{code}
 \begin{code}
-#if rs6000_TARGET_ARCH
-
-#define REG_Base       ????    
-#define REG_R1 
-#define REG_SpA        
-#define REG_SpB        
-#define REG_Hp         
-
-#define REG_Flt1       
-#define REG_Flt2       
-#define REG_Flt3       
-#define REG_Flt4       
-#define REG_Dbl1       
-#define REG_Dbl2       
-
-#endif /* rs6000 */
+#if powerpc_TARGET_ARCH
+
+#define REG(x) __asm__("%" #x)
+
+#if defined(MARK_REG_MAP)
+#define REG_Mark       r13
+#define REG_MStack     r14
+#define REG_MRoot      r15
+#define REG_BitArray    r16
+#define REG_HeapBase   r17
+#define REG_HeapLim    r18
+#else
+#if defined(SCAN_REG_MAP)
+#define REG_Scan       r13
+#define REG_New        r14
+#define REG_LinkLim    r15
+#else
+#if defined(SCAV_REG_MAP)
+#define REG_Scav       r13
+#define REG_ToHp       r14
+#if defined(GCap) || defined(GCgn)
+#define REG_OldGen     r15
+#endif /* GCap || GCgn */
+#else  /* default: MAIN_REG_MAP */
+
+/* callee saves */
+#define CALLEE_SAVES_FltReg1
+#define CALLEE_SAVES_FltReg2
+#define CALLEE_SAVES_FltReg3
+#define CALLEE_SAVES_FltReg4
+#define CALLEE_SAVES_DblReg1
+#define CALLEE_SAVES_DblReg2
+#define CALLEE_SAVES_SpA
+#define CALLEE_SAVES_SuA
+#define CALLEE_SAVES_SpB
+#define CALLEE_SAVES_SuB
+#define CALLEE_SAVES_Hp
+#define CALLEE_SAVES_HpLim
+
+#define CALLEE_SAVES_Ret
+
+#define CALLEE_SAVES_R1
+#define CALLEE_SAVES_R2
+#define CALLEE_SAVES_R3
+#define CALLEE_SAVES_R4
+#define CALLEE_SAVES_R5
+#define CALLEE_SAVES_R6
+#define CALLEE_SAVES_R7
+#define CALLEE_SAVES_R8
+
+#define REG_R1         r13
+#define REG_R2         r14
+#define REG_R3         r15
+#define REG_R4         r16
+#define REG_R5         r17
+#define REG_R6         r18
+#define REG_R7         r19
+#define REG_R8         r20
+
+#define REG_Flt1       fr14
+#define REG_Flt2       fr15
+#define REG_Flt3       fr16
+#define REG_Flt4       fr17
+
+#define REG_Dbl1       fr18
+#define REG_Dbl2       fr19
+
+#define REG_SpA        r21
+#define REG_SuA        r22
+#define REG_SpB        r23
+#define REG_SuB        r24
+
+#define REG_Hp         r25
+#define REG_HpLim      r26
+
+#define REG_Ret                r27
+
+#define REG_StkStub    r28
+
+#endif /* SCAV_REG_MAP */
+#endif /* SCAN_REG_MAP */
+#endif /* MARK_REG_MAP */
+
+#endif /* powerpc */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -769,19 +840,19 @@ discretion being the better part of valor, we also don't take
 #else
 #if defined(SCAN_REG_MAP)
 #define REG_ScanBase   g4
 #else
 #if defined(SCAN_REG_MAP)
 #define REG_ScanBase   g4
+/* NB: *not* defining this (so that everything is done w/ global variables)
+   does *not* work; I suspect that the Sca[nv]RegTable is not being
+   initialised somewhere... WDP 95/10
+*/
 #else
 #if defined(SCAV_REG_MAP)
 #define REG_ScavBase   g4
 #else
 #if defined(SCAV_REG_MAP)
 #define REG_ScavBase   g4
+/* see comment above */
 #else  /* default: MAIN_REG_MAP */
 
 /* callee saves (nothing) */
 
 #else  /* default: MAIN_REG_MAP */
 
 /* callee saves (nothing) */
 
-/* caller saves (fp registers and maybe Activity) */
-
-#if defined(DO_SPAT_PROFILING)
-#define CALLER_SAVES_SYSTEM
-#define CALLER_SAVES_Activity
-#endif
+/* caller saves (fp registers) */
 
 #define CALLER_SAVES_USER
 
 
 #define CALLER_SAVES_USER
 
@@ -807,10 +878,6 @@ discretion being the better part of valor, we also don't take
 #define REG_Dbl1       f6
 #define REG_Dbl2       f8
 
 #define REG_Dbl1       f6
 #define REG_Dbl2       f8
 
-#if defined(DO_SPAT_PROFILING)
-#define REG_Activity   g5
-#endif
-
 #define REG_SpA        i0
 #define REG_SuA        i1
 #define REG_SpB        i2
 #define REG_SpA        i0
 #define REG_SuA        i1
 #define REG_SpB        i2
index 83f2f44..df37382 100644 (file)
@@ -32,11 +32,14 @@ These basic definitions need to be around, one way or the other:
 
 \begin{code}
 # ifdef PAR
 
 \begin{code}
 # ifdef PAR
-#  define MAX_PES      128             /* Maximum number of processors */
+#  define MAX_PES      256             /* Maximum number of processors */
+       /* MAX_PES is enforced by SysMan, which does not
+          allow more than this many "processors".
+          This is important because PackGA [GlobAddr.lc]
+          **assumes** that a PE# can fit in 8+ bits.
+       */
 
 
-extern I_ do_gr_profile;
 extern I_ do_sp_profile;
 extern I_ do_sp_profile;
-extern I_ do_gr_binary;
 
 extern P_ PendingFetches;
 extern GLOBAL_TASK_ID *PEs;
 
 extern P_ PendingFetches;
 extern GLOBAL_TASK_ID *PEs;
@@ -164,8 +167,11 @@ global address for a local closure which did not previously have one.
   
 #  define MAX_GA_WEIGHT                        0       /* Treat as 2^n */
   
   
 #  define MAX_GA_WEIGHT                        0       /* Treat as 2^n */
   
-#  define PACK_GA(pe,slot)    ((((W_)(pe)) << (BITS_IN(W_)/2)) | ((W_)(slot)))
-
+W_ PackGA PROTO((W_, int));
+   /* There was a PACK_GA macro here; but we turned it into the PackGA
+      routine [GlobAddr.lc] (because it needs to do quite a bit of
+      paranoia checking.  Phil & Will (95/08)
+   */
 \end{code}
 
 At the moment, there is no activity profiling for GUM.  This may change.
 \end{code}
 
 At the moment, there is no activity profiling for GUM.  This may change.
@@ -464,7 +470,8 @@ This constant defines how many words of data we can pack into a single
 packet in the parallel (GUM) system.
 
 \begin{code}
 packet in the parallel (GUM) system.
 
 \begin{code}
-#  ifdef GUM
+#  ifdef PAR
+void   InitPackBuffer(STG_NO_ARGS);
 P_      PackNearbyGraph PROTO((P_ closure,W_ *size));
 P_      PackTSO PROTO((P_ tso, W_ *size));
 P_      PackStkO PROTO((P_ stko, W_ *size));
 P_      PackNearbyGraph PROTO((P_ closure,W_ *size));
 P_      PackTSO PROTO((P_ tso, W_ *size));
 P_      PackStkO PROTO((P_ stko, W_ *size));
@@ -485,13 +492,25 @@ void    doGlobalGC(STG_NO_ARGS);
 P_ UnpackGraph PROTO((W_ *buffer, globalAddr **gamap, W_ *nGAs));
 #  endif
 
 P_ UnpackGraph PROTO((W_ *buffer, globalAddr **gamap, W_ *nGAs));
 #  endif
 
-#  define PACK_BUFFER_SIZE     1024
-#  define PACK_HEAP_REQUIRED  \
-    ((PACK_BUFFER_SIZE - PACK_HDR_SIZE) / (PACK_GA_SIZE + _FHS) * (SPEC_HS + 2))
-
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
+#  define PACK_HEAP_REQUIRED  \
+    ((RTSflags.ParFlags.packBufferSize - PACK_HDR_SIZE) / (PACK_GA_SIZE + _FHS) * (SPEC_HS + 2))
+
+extern W_      *PackBuffer;      /* size: can be set via option */
+extern long *buffer;             /* HWL_ */
+extern W_ *freeBuffer;           /* HWL_ */
+extern W_ *packBuffer;           /* HWL_ */
+
+extern void    InitPackBuffer(STG_NO_ARGS);
+extern void    InitMoreBuffers(STG_NO_ARGS);
+extern void    InitPendingGABuffer(W_ size); 
+extern void    AllocClosureQueue(W_ size);
+
+#  define MAX_GAS      (RTSflags.ParFlags.packBufferSize / PACK_GA_SIZE)
+
+
 #  define PACK_GA_SIZE 3       /* Size of a packed GA in words */
                                /* Size of a packed fetch-me in words */
 #  define PACK_FETCHME_SIZE (PACK_GA_SIZE + FIXED_HS)
 #  define PACK_GA_SIZE 3       /* Size of a packed GA in words */
                                /* Size of a packed fetch-me in words */
 #  define PACK_FETCHME_SIZE (PACK_GA_SIZE + FIXED_HS)
@@ -500,8 +519,6 @@ P_ UnpackGraph PROTO((W_ *buffer, globalAddr **gamap, W_ *nGAs));
 
 #  define PACK_PLC_SIZE        2       /* Size of a packed PLC in words */
   
 
 #  define PACK_PLC_SIZE        2       /* Size of a packed PLC in words */
   
-#  define MAX_GAS      (PACK_BUFFER_SIZE / PACK_GA_SIZE)
-
 \end{code}
 End multi-slurp protection:
 \begin{code}
 \end{code}
 End multi-slurp protection:
 \begin{code}
diff --git a/ghc/includes/RtsFlags.lh b/ghc/includes/RtsFlags.lh
new file mode 100644 (file)
index 0000000..9a7bbaa
--- /dev/null
@@ -0,0 +1,191 @@
+\begin{code}
+#ifndef RTSFLAGS_H
+#define RTSFLAGS_H
+\end{code}
+
+For defaults, see the @initRtsFlagsDefaults@ routine.
+
+\begin{code}
+struct GC_FLAGS {
+    FILE   *statsFile;
+    I_     giveStats; /* ToDo: replace with enum type? */
+#define NO_GC_STATS     0
+#define VERBOSE_GC_STATS 1
+
+    I_     stksSize; /* this size is stored to record number of *words* */
+    I_     heapSize; /* this size is stored to record number of *words* */
+    I_     allocAreaSize;
+    rtsBool allocAreaSizeGiven;
+    I_     specifiedOldGenSize; /* zero => use the rest of the heap */
+    double  pcFreeHeap;
+    I_     minAllocAreaSize; /* derived from: pcFreeHeap, heap-size */
+
+    rtsBool force2s; /* force the use of 2-space copying collection;
+                       forced to rtsTrue if we do *heap* profiling.
+                    */
+    rtsBool forceGC; /* force a major GC every <interval> bytes */
+    I_     forcingInterval; /* actually, stored as a number of *words* */
+    rtsBool ringBell;
+    W_     trace;
+           /* bit  1 set: chatty GC summaries
+                   2 set: details of minor collections
+                   4 set: details of major collections, except marking
+                   8 set: ditto, but marking this time
+                  16 set: GC of MallocPtrs
+                  32 set: GC of Concurrent things
+           */
+#define DEBUG_TRACE_MINOR_GC   2
+#define DEBUG_TRACE_MAJOR_GC   4
+#define DEBUG_TRACE_MARKING    8
+#define DEBUG_TRACE_MALLOCPTRS 16
+#define DEBUG_TRACE_CONCURRENT 32
+
+    rtsBool lazyBlackHoling;
+    rtsBool doSelectorsAtGC;
+    rtsBool squeezeUpdFrames;
+};
+
+struct DEBUG_FLAGS {
+};
+
+#if defined(PROFILING) || defined(PAR)
+    /* with PROFILING, full cost-centre stuff (also PROFILING_FLAGS);
+       with PAR, just the four fixed cost-centres.
+    */
+struct COST_CENTRE_FLAGS {
+    W_     doCostCentres;
+# define COST_CENTRES_SUMMARY  1
+# define COST_CENTRES_VERBOSE  2 /* incl. serial time profile */
+# define COST_CENTRES_ALL      3
+
+    char    sortBy;
+# define SORTCC_LABEL  'C'
+# define SORTCC_TIME   'T'
+# define SORTCC_ALLOC  'A'
+
+    I_     ctxtSwitchTicks; /* derived */
+    I_     profilerTicks;   /* derived */
+    I_     msecsPerTick;    /* derived */
+};
+#endif
+
+#ifdef PROFILING
+struct PROFILING_FLAGS {
+    W_ doHeapProfile;
+# define NO_HEAP_PROFILING     0       /* N.B. Used as indexes into arrays */
+# define HEAP_BY_CC            1
+# define HEAP_BY_MOD           2
+# define HEAP_BY_GRP           3
+# define HEAP_BY_DESCR         4
+# define HEAP_BY_TYPE          5
+# define HEAP_BY_TIME          6
+  
+# define CCchar    'C'
+# define MODchar   'M'
+# define GRPchar   'G'
+# define DESCRchar 'D'
+# define TYPEchar  'Y'
+# define TIMEchar  'T'
+};
+#endif
+
+#ifdef CONCURRENT
+struct CONCURRENT_FLAGS {
+    I_     ctxtSwitchTime; /* in milliseconds */
+    I_     maxThreads;
+    I_     stkChunkSize;
+    I_     maxLocalSparks;
+};
+#endif /* CONCURRENT */
+
+#ifdef PAR
+struct PAR_FLAGS {
+    rtsBool parallelStats;     /* Gather parallel statistics */
+    rtsBool granSimStats;      /* Full .gr profile (rtsTrue) or only END events? */
+    rtsBool granSimStats_Binary;
+
+    rtsBool outputDisabled;    /* Disable output for performance purposes */
+    
+    W_     packBufferSize;
+};
+
+#endif /* PAR */
+
+#ifdef GRAN
+struct GRAN_FLAGS {
+};
+#endif /* GRAN */
+
+#ifdef TICKY_TICKY
+struct TICKY_FLAGS {
+    rtsBool showTickyStats;
+    FILE   *tickyFile;
+
+    /* see also: doUpdEntryCounts in AllFlags */
+};
+#endif /* TICKY_TICKY */
+\end{code}
+
+Put them together:
+\begin{code}
+struct RTS_FLAGS {
+    struct GC_FLAGS    GcFlags;
+    struct DEBUG_FLAGS DebugFlags; /* unused at present */
+
+#if defined(PROFILING) || defined(PAR)
+    struct COST_CENTRE_FLAGS CcFlags;
+#endif
+#ifdef PROFILING
+    struct PROFILING_FLAGS ProfFlags;
+#endif
+#ifdef CONCURRENT
+    struct CONCURRENT_FLAGS ConcFlags;
+#endif
+#ifdef PAR
+    struct PAR_FLAGS   ParFlags;
+#endif
+#ifdef GRAN
+    struct GRAN_FLAGS  GranFlags;
+#endif
+#ifdef TICKY_TICKY
+    struct TICKY_FLAGS TickyFlags;
+#endif
+};
+
+extern struct RTS_FLAGS RTSflags;
+\end{code}
+
+Routines that operate-on/to-do-with RTS flags:
+\begin{code}
+void   initRtsFlagsDefaults (STG_NO_ARGS);
+void   setupRtsFlags PROTO((int *argc,     char *argv[],
+                            int *rts_argc, char *rts_argv[]));
+\end{code}
+
+OLD: This is the maximum identifier length that can be used for a cost
+centre or description string. It includes the terminating null
+character.
+
+The printf formats are here, so we are less likely to make overly-long
+filenames (with disastrous results).  No more than 128 chars, please!
+
+\begin{code}
+#define STATS_FILENAME_MAXLEN  128
+
+#define GR_FILENAME_FMT                "%0.124s.gr"
+#define GR_FILENAME_FMT_GUM    "%0.120s.%03d.%s"
+#define HP_FILENAME_FMT                "%0.124s.hp"
+#define LIFE_FILENAME_FMT      "%0.122s.life"
+#define PROF_FILENAME_FMT      "%0.122s.prof"
+#define PROF_FILENAME_FMT_GUM  "%0.118s.%03d.prof"
+#define QP_FILENAME_FMT                "%0.124s.qp"
+#define STAT_FILENAME_FMT      "%0.122s.stat"
+#define TICKY_FILENAME_FMT     "%0.121s.ticky"
+#define TIME_FILENAME_FMT      "%0.122s.time"
+#define TIME_FILENAME_FMT_GUM  "%0.118s.%03d.time"
+\end{code}
+
+Multi-slurp protection:
+\begin{code}
+#endif /* RTSFLAGS_H */
+\end{code}
similarity index 96%
rename from ghc/includes/rtsTypes.lh
rename to ghc/includes/RtsTypes.lh
index 3ac9e06..a72694c 100644 (file)
@@ -27,7 +27,7 @@ Hash tables for GUM are ADTs.  Peek inside, and I'll have to kill you.
 The same goes for hash list cells.
 
 \begin{code}
 The same goes for hash list cells.
 
 \begin{code}
-#ifdef GUM
+#ifdef PAR
 typedef struct hashtable HashTable;
 typedef struct hashlist HashList;
 
 typedef struct hashtable HashTable;
 typedef struct hashlist HashList;
 
@@ -114,7 +114,7 @@ containing the @label@, @module@, @group@, and the statistical meters
 we are collecting.
 
 \begin{code}
 we are collecting.
 
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
 
 typedef struct cc {
     struct cc *registered;     /* list of registered cost centres      */
 
 typedef struct cc {
     struct cc *registered;     /* list of registered cost centres      */
@@ -150,7 +150,7 @@ typedef struct cc {
 
 } *CostCentre;
 
 
 } *CostCentre;
 
-#endif /* defined(USE_COST_CENTRES) || defined(CONCURRENT) */
+#endif /* defined(PROFILING) || defined(CONCURRENT) */
 \end{code}
 
 This structure will need to be expanded change as the statistics we
 \end{code}
 
 This structure will need to be expanded change as the statistics we
index 509a4bb..326eaf3 100644 (file)
@@ -416,7 +416,7 @@ which are used to define them must all be defined consistently.
 
 \begin{code}
 
 
 \begin{code}
 
-#define FIXED_HS               (INFO_FIXED_HDR + PAR_FIXED_HDR + PROF_FIXED_HDR + AGE_FIXED_HDR)
+#define FIXED_HS (INFO_FIXED_HDR + PAR_FIXED_HDR + PROF_FIXED_HDR + TICKY_FIXED_HDR)
 
 /* NB: this *defines* the intended order for the pieces of 
    the fixed header.  Care should be taken to ensure that this
 
 /* NB: this *defines* the intended order for the pieces of 
    the fixed header.  Care should be taken to ensure that this
@@ -430,13 +430,17 @@ which are used to define them must all be defined consistently.
         SET_GRAN_HDR(closure,ThisPE);                  \
        SET_PAR_HDR(closure,LOCAL_GA);                  \
        SET_PROF_HDR(closure,costcentre);               \
         SET_GRAN_HDR(closure,ThisPE);                  \
        SET_PAR_HDR(closure,LOCAL_GA);                  \
        SET_PROF_HDR(closure,costcentre);               \
-       SET_AGE_HDR(closure)
+       SET_TICKY_HDR(closure,0)
 
 #define UPD_FIXED_HDR(closure,infolbl,costcentre)      \
        SET_INFO_PTR(closure,infolbl);                  \
 
 #define UPD_FIXED_HDR(closure,infolbl,costcentre)      \
        SET_INFO_PTR(closure,infolbl);                  \
-       SET_PROF_HDR(closure,costcentre)
+       SET_PROF_HDR(closure,costcentre);               \
+       SET_TICKY_HDR(closure,1)
        /* fiddling SET_PAR_HDR would be a bug (says Patrick) */
        /* fiddling SET_PAR_HDR would be a bug (says Patrick) */
-       /* no SET_AGE_HDR for inplace updates */
+       /* We set ticky-hdr to 1 because the only place we
+          use this macro is when we have just done an update
+          (WDP 96/01)
+       */
 
 /* These items are comma-separated */
 
 
 /* These items are comma-separated */
 
@@ -445,7 +449,7 @@ which are used to define them must all be defined consistently.
         SET_STATIC_PROCS(closure)                      \
        SET_STATIC_PAR_HDR(closure)                     \
        SET_STATIC_PROF_HDR(cc_ident)                   \
         SET_STATIC_PROCS(closure)                      \
        SET_STATIC_PAR_HDR(closure)                     \
        SET_STATIC_PROF_HDR(cc_ident)                   \
-       SET_STATIC_AGE_HDR()
+       SET_STATIC_TICKY_HDR()
 
 \end{code}
 
 
 \end{code}
 
@@ -486,7 +490,10 @@ to reserve in the variable header for mutable closures:
 they will hear about it soon enough (WDP 95/05).
 
 \begin{code}
 they will hear about it soon enough (WDP 95/05).
 
 \begin{code}
-#define SPEC_HS                                (FIXED_HS)
+#define SPEC_HS                (FIXED_HS)
+
+#define SPEC_SIZE(fields) (FIXED_HS + (fields))
+                       /*notational convenience; in SMscan.lc + elsewhere */
 
 #define SPEC_CLOSURE_PTR(closure, no)  (((P_)(closure))[SPEC_HS + (no) - 1])
 #define SPEC_CLOSURE_SIZE(closure)     ((W_)INFO_SIZE(INFO_PTR(closure)))
 
 #define SPEC_CLOSURE_PTR(closure, no)  (((P_)(closure))[SPEC_HS + (no) - 1])
 #define SPEC_CLOSURE_SIZE(closure)     ((W_)INFO_SIZE(INFO_PTR(closure)))
@@ -687,12 +694,12 @@ do {                                 \
 } while (0)
 
 EXTDATA_RO(StablePointerTable_info);
 } while (0)
 
 EXTDATA_RO(StablePointerTable_info);
-EXTDATA_RO(EmptyStablePointerTable_static_info);
+EXTDATA_RO(EmptyStablePointerTable_info);
 EXTDATA(EmptySPTable_closure);
 extern int ValidateSPTable PROTO(( P_ SPTable ));
 
 #  define CHECK_SPT_InfoTable( closure ) \
 EXTDATA(EmptySPTable_closure);
 extern int ValidateSPTable PROTO(( P_ SPTable ));
 
 #  define CHECK_SPT_InfoTable( closure ) \
-  ASSERT( (*((PP_) (closure)) == EmptyStablePointerTable_static_info && (closure == EmptySPTable_closure) ) || \
+  ASSERT( (*((PP_) (closure)) == EmptyStablePointerTable_info && (closure == EmptySPTable_closure) ) || \
          (*((PP_) (closure)) == StablePointerTable_info) )
 
 #  define CHECK_SPT_Size( closure ) \
          (*((PP_) (closure)) == StablePointerTable_info) )
 
 #  define CHECK_SPT_Size( closure ) \
@@ -910,35 +917,37 @@ on @MUT_LINK@ being defined.
 
 #define IND_CLOSURE_SIZE(closure) (MIN_UPD_SIZE)
 #define IND_CLOSURE_NoPTRS(closure) 1
 
 #define IND_CLOSURE_SIZE(closure) (MIN_UPD_SIZE)
 #define IND_CLOSURE_NoPTRS(closure) 1
-#define IND_CLOSURE_NoNONPTRS(closure) (IND_CLOSURE_SIZE(closure)-IND_CLOSURE_NoPTRS(closure)-IND_VHS)
+#define IND_CLOSURE_NoNONPTRS(closure) \
+           (IND_CLOSURE_SIZE(closure)-IND_CLOSURE_NoPTRS(closure)-IND_VHS)
 \end{code}
 
 Indirections must store a pointer to the closure which is the target
 of the indirection:
 \begin{code}
 \end{code}
 
 Indirections must store a pointer to the closure which is the target
 of the indirection:
 \begin{code}
-#define IND_CLOSURE_PTR(closure)       (((P_)(closure))[IND_HS])
+#define IND_CLOSURE_PTR(closure)  (((P_)(closure))[IND_HS])
+#define IND_CLOSURE_LINK(closure) (((P_)(closure))[FIXED_HS])
 \end{code}
 
 \end{code}
 
-\begin{code}
-#define IND_CLOSURE_LINK(closure)      (((P_)(closure))[FIXED_HS])
-\end{code}
+When we are profiling, we occasionally use ``permanent indirections''
+to store cost centres associated in some way with PAPs.  Don't ask me
+why.  For now, a permanent indirection must have the same shape as a
+regular indirection.  The only difference is that it is, well,
+permanent.  That is to say, it is never short-circuited.  (What is the
+point, anyway?)
 
 
-When we are profiling, we occasionally use ``permanent indirections'' to
-store cost centres associated in some way with PAPs.  Don't ask me why.
-For now, a permanent indirection must have the same shape as a regular
-indirection.  The only difference is that it is, well, permanent.  That is
-to say, it is never short-circuited.  (What is the point, anyway?)
-
-Presumably, such objects could shrink as they moved into the old generation,
-but then their header size would change as well (the word that they get to
-lose is the VHS word of a standard indirection), and I just don't feel up
-to it today.  --JSM.
+Presumably, such objects could shrink as they moved into the old
+generation, but then their header size would change as well (the word
+that they get to lose is the VHS word of a standard indirection), and
+I just don't feel up to it today.  --JSM.
 
 \begin{code}
 
 \begin{code}
-#ifdef USE_COST_CENTRES
-
-#define        PERM_IND_CLOSURE_PTR(closure,dummy)     IND_CLOSURE_PTR(closure)
+#if defined(PROFILING) || defined(TICKY_TICKY)
 
 
+#define        PERM_IND_CLOSURE_PTR(closure,dummy) IND_CLOSURE_PTR(closure)
+    /* really *must* be the same as IND_CLOSURE_PTR; it is
+       merely a "two-argument" variant, to fit in with the
+       bizarre goings-on in SMmark.lhc and friends. WDP 95/12
+    */
 #endif
 \end{code}
 
 #endif
 \end{code}
 
@@ -963,8 +972,11 @@ The compiler will also allocate an updatable black hole on entering a
 @CAF@.
 
 \begin{code}
 @CAF@.
 
 \begin{code}
-#define BH_HS                  (FIXED_HS)
-#define BH_VHS                 0L
+#define BH_HS          (FIXED_HS)
+#define BH_VHS         0L
+
+#define BH_U_SIZE      MIN_UPD_SIZE
+#define BH_N_SIZE      MIN_NONUPD_SIZE
 
 #define BH_CLOSURE_SIZE(closure)       ((W_)INFO_SIZE(INFO_PTR(closure)))
 #define BH_CLOSURE_NoPTRS(closure)     0L
 
 #define BH_CLOSURE_SIZE(closure)       ((W_)INFO_SIZE(INFO_PTR(closure)))
 #define BH_CLOSURE_NoPTRS(closure)     0L
@@ -977,13 +989,13 @@ The compiler will also allocate an updatable black hole on entering a
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsubsection[RBH-closures]{@RBH@ (revertable black hole) closure macros}
+\subsubsection[RBH-closures]{@RBH@ (revertible black hole) closure macros}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-There are two kinds of revertable black holes, produced from GEN or
+There are two kinds of revertible black holes, produced from GEN or
 SPEC closures, respectively.  There's no @SET_RBH_HDR@ macro -- use
 SPEC closures, respectively.  There's no @SET_RBH_HDR@ macro -- use
-@TurnIntoRBH@ instead!!
+@convertToRBH@ instead!!
 
 Note that the NoPTRS and NoNONPTRS macros refer to the *original* closure.
 
 
 Note that the NoPTRS and NoNONPTRS macros refer to the *original* closure.
 
@@ -994,7 +1006,7 @@ Note that the NoPTRS and NoNONPTRS macros refer to the *original* closure.
 #define SPEC_RBH_CLOSURE_PTR(closure, no)      (((P_)(closure))[SPEC_RBH_HS + (no) - 1])
 #define SPEC_RBH_CLOSURE_SIZE(closure)         ((W_)INFO_SIZE(REVERT_INFOPTR(INFO_PTR(closure))))
 #define SPEC_RBH_CLOSURE_NoPTRS(closure)       ((W_)INFO_NoPTRS(REVERT_INFOPTR(INFO_PTR(closure))))
 #define SPEC_RBH_CLOSURE_PTR(closure, no)      (((P_)(closure))[SPEC_RBH_HS + (no) - 1])
 #define SPEC_RBH_CLOSURE_SIZE(closure)         ((W_)INFO_SIZE(REVERT_INFOPTR(INFO_PTR(closure))))
 #define SPEC_RBH_CLOSURE_NoPTRS(closure)       ((W_)INFO_NoPTRS(REVERT_INFOPTR(INFO_PTR(closure))))
-#define SPEC_RBH_CLOSURE_NoNONPTRS(closure)    (SPEC_RBH_CLOSURE_SIZE(closure)-SPEC_RBH_CLOSURE_NoPTRS(closure)/*-SPEC_VHS*/)
+#define SPEC_RBH_CLOSURE_NoNONPTRS(closure)    (SPEC_RBH_CLOSURE_SIZE(closure)-SPEC_RBH_CLOSURE_NoPTRS(closure))
 
 #define SPEC_RBH_BQ_LOCN                       (SPEC_RBH_HS)
 #define SPEC_RBH_BQ(closure)                   (((P_)(closure))[SPEC_RBH_BQ_LOCN])
 
 #define SPEC_RBH_BQ_LOCN                       (SPEC_RBH_HS)
 #define SPEC_RBH_BQ(closure)                   (((P_)(closure))[SPEC_RBH_BQ_LOCN])
index 5a5c33c..5cbbf06 100644 (file)
@@ -229,7 +229,7 @@ included only if required.
 \begin{code}
 #define PROFILING_INFO_OFFSET  (FIXED_INFO_WORDS)
 
 \begin{code}
 #define PROFILING_INFO_OFFSET  (FIXED_INFO_WORDS)
 
-#if !defined(USE_COST_CENTRES)
+#if !defined(PROFILING)
 # define PROFILING_INFO_WORDS  0
 # define INCLUDE_PROFILING_INFO(base_name)
 # define INREGS_PROFILING_INFO    
 # define PROFILING_INFO_WORDS  0
 # define INCLUDE_PROFILING_INFO(base_name)
 # define INREGS_PROFILING_INFO    
@@ -555,27 +555,10 @@ included only if required.
 # define INFO_EVAC_2S(infoptr)  (((FP_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET])
 # define INFO_SCAV_2S(infoptr)  (((FP_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET + 1])
 
 # define INFO_EVAC_2S(infoptr)  (((FP_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET])
 # define INFO_SCAV_2S(infoptr)  (((FP_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET + 1])
 
-# if defined(UPDATES_ENTERED_COUNT)
-
-/* Don't commmon up CONST CHARLIKE and INTLIKE treat as SPEC 1_0 closure */
-/* This broke it -- turning it off. Use LARGE heap so no GC needed */
-#  if 0
-#   define INCLUDE_COPYING_INFO_CONST(evac, scav) \
-       INCLUDE_COPYING_INFO(_Evacuate_1,_Scavenge_1_0)
-#  endif /* 0 */
-
-#  define INCLUDE_COPYING_INFO_CONST(evac, scav) \
-       INCLUDE_COPYING_INFO(evac, scav)
-# else
-#  define INCLUDE_COPYING_INFO_CONST(evac, scav) \
-       INCLUDE_COPYING_INFO(evac, scav)
-# endif
-
 #else  /* ! _INFO_COPYING */
 
 # define COPY_INFO_WORDS 0
 # define INCLUDE_COPYING_INFO(evac, scav)
 #else  /* ! _INFO_COPYING */
 
 # define COPY_INFO_WORDS 0
 # define INCLUDE_COPYING_INFO(evac, scav)
-# define INCLUDE_COPYING_INFO_CONST(evac, scav)
 
 #endif /* ! _INFO_COPYING */
 \end{code}
 
 #endif /* ! _INFO_COPYING */
 \end{code}
@@ -1264,7 +1247,6 @@ the parallel Pack code (@Pack.lc@) and possibly to-be-written debug
 code.
 
 \begin{code}
 code.
 
 \begin{code}
-
 #define STATIC_ITBL(infolbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
 #define STATIC_ITBL(infolbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
@@ -1284,11 +1266,10 @@ MAYBE_DECLARE_RTBL(Static,,)
        INCLUDE_TYPE_INFO(STATIC)       \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED) /* NB: in info table! */ \
        INCLUDE_PAR_INFO                 \
        INCLUDE_TYPE_INFO(STATIC)       \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED) /* NB: in info table! */ \
        INCLUDE_PAR_INFO                 \
-       INCLUDE_COPYING_INFO(_Evacuate_Static,_Scavenge_Static) \
+       INCLUDE_COPYING_INFO(_Evacuate_Static,_Dummy_Static_entry) \
        INCLUDE_COMPACTING_INFO(_Dummy_Static_entry,_PRStart_Static, \
                                _Dummy_Static_entry,_Dummy_Static_entry) \
        }
        INCLUDE_COMPACTING_INFO(_Dummy_Static_entry,_PRStart_Static, \
                                _Dummy_Static_entry,_Dummy_Static_entry) \
        }
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -1354,8 +1335,6 @@ using @SPEC@ closures but this requires explicit use of the value of
 MAYBE_DECLARE_RTBL(BH,U,)
 MAYBE_DECLARE_RTBL(BH,N,)
 
 MAYBE_DECLARE_RTBL(BH,U,)
 MAYBE_DECLARE_RTBL(BH,N,)
 
-#define BH_U_SIZE   MIN_UPD_SIZE
-#define BH_N_SIZE   MIN_NONUPD_SIZE
 #define BH_RTBL(kind)                                                          \
     const W_ MK_REP_LBL(BH,kind,)[] = {                                                \
        INCLUDE_TYPE_INFO(BH)                                                   \
 #define BH_RTBL(kind)                                                          \
     const W_ MK_REP_LBL(BH,kind,)[] = {                                                \
        INCLUDE_TYPE_INFO(BH)                                                   \
@@ -1376,7 +1355,7 @@ MAYBE_DECLARE_RTBL(BH,N,)
 
 An indirection simply extracts the pointer from the
 @IND_CLOSURE_PTR(closure)@ field. The garbage collection routines will
 
 An indirection simply extracts the pointer from the
 @IND_CLOSURE_PTR(closure)@ field. The garbage collection routines will
-short out the indirection.
+short out the indirection (normally).
 \begin{code}
 
 #define IND_ITBL(infolbl,ind_code,localness,entry_localness) \
 \begin{code}
 
 #define IND_ITBL(infolbl,ind_code,localness,entry_localness) \
@@ -1409,7 +1388,7 @@ look exactly like regular indirections, but they are not short-circuited
 on garbage collection.
 
 \begin{code}
 on garbage collection.
 
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
 
 # define PERM_IND_ITBL(infolbl,ind_code,localness,entry_localness) \
     entry_localness(ind_code);                         \
 
 # define PERM_IND_ITBL(infolbl,ind_code,localness,entry_localness) \
     entry_localness(ind_code);                         \
@@ -1468,35 +1447,33 @@ closure, in fact, it may be another @CAF@. This will cause the second
 @CAF@'s evacuation code to be called before the @CAF@ has been
 evacuated, returning an unevacuated pointer.
 
 @CAF@'s evacuation code to be called before the @CAF@ has been
 evacuated, returning an unevacuated pointer.
 
-Another scheme leaves updating the @CAF@ indirections to the end
-of the garbage collection.
-All the references are evacuated and scavenged as usual (including the
-@CAFlist@). Once collection is complete the @CAFlist@ is traversed
-updating the @CAF@ references with the result of evacuating the
-referenced closure again. This will immediately return as it must be a
-forward reference, a static closure, or a @CAF@ which will indirect by
-evacuating its reference.
+Another scheme leaves updating the @CAF@ indirections to the end of
+the garbage collection.  All the references are evacuated and
+scavenged as usual (including the @CAFlist@). Once collection is
+complete the @CAFlist@ is traversed updating the @CAF@ references with
+the result of evacuating the referenced closure again. This will
+immediately return as it must be a forward reference, a static
+closure, or a @CAF@ which will indirect by evacuating its reference.
 
 The crux of the problem is that the @CAF@ evacuation code needs to
 
 The crux of the problem is that the @CAF@ evacuation code needs to
-know if its reference has already been evacuated and updated. If not, then
-the reference can be evacuated, updated and returned safely (possibly
-evacuating another @CAF@). If it has, then the updated reference can be
-returned. This can be done using two @CAF@ info-tables. At the start
-of a collection the @CAFlist@ is traversed and set to an internal {\em
-evacuate and update} info-table. During collection, evacution of such a
-@CAF@ also results in the info-table being reset back to the standard
-@CAF@ {\em return reference} info-table. Thus subsequent evacuations
-will simply return the updated reference. On completion of the
-collection all @CAF@s will have {\em return reference} info-tables
+know if its reference has already been evacuated and updated. If not,
+then the reference can be evacuated, updated and returned safely
+(possibly evacuating another @CAF@). If it has, then the updated
+reference can be returned. This can be done using two @CAF@
+info-tables. At the start of a collection the @CAFlist@ is traversed
+and set to an internal {\em evacuate and update} info-table. During
+collection, evacution of such a @CAF@ also results in the info-table
+being reset back to the standard @CAF@ info-table. Thus subsequent
+evacuations will simply return the updated reference. On completion of
+the collection all @CAF@s will have {\em return reference} info-tables
 again.
 
 This is the scheme we adopt. A @CAF@ indirection has evacuation code
 which returns the evacuated and updated reference. During garbage
 again.
 
 This is the scheme we adopt. A @CAF@ indirection has evacuation code
 which returns the evacuated and updated reference. During garbage
-collection all the @CAF@s are overwritten with an internal @CAF@ info
+collection, all the @CAF@s are overwritten with an internal @CAF@ info
 table which has evacuation code which performs this evacuate and
 update and restores the original @CAF@ code. At some point during the
 table which has evacuation code which performs this evacuate and
 update and restores the original @CAF@ code. At some point during the
-collection we must ensure that all the @CAF@s are indeed
-evacuated.
+collection we must ensure that all the @CAF@s are indeed evacuated.
 
 The only potential problem with this scheme is a cyclic list of @CAF@s
 all directly referencing (possibly via indirections) another @CAF@!
 
 The only potential problem with this scheme is a cyclic list of @CAF@s
 all directly referencing (possibly via indirections) another @CAF@!
@@ -1510,15 +1487,14 @@ reference is OK --- all the @CAF@s will now reference the same
 @CAF@ which will reference itself! Construction of such a structure
 indicates the program must be in an infinite loop.
 
 @CAF@ which will reference itself! Construction of such a structure
 indicates the program must be in an infinite loop.
 
-
 \subsubsection{Compacting Collector}
 
 \subsubsection{Compacting Collector}
 
-When shorting out a @CAF@, its reference must be marked. A first attempt
-might explicitly mark the @CAF@s, updating the reference with the
-marked reference (possibly short circuting indirections). The actual
-@CAF@ marking code can indicate that they have already been marked
-(though this might not have actually been done yet) and return the
-indirection pointer so it is shorted out. Unfortunately the @CAF@
+When shorting out a @CAF@, its reference must be marked. A first
+attempt might explicitly mark the @CAF@s, updating the reference with
+the marked reference (possibly short circuting indirections). The
+actual @CAF@ marking code can indicate that they have already been
+marked (though this might not have actually been done yet) and return
+the indirection pointer so it is shorted out. Unfortunately the @CAF@
 reference might point to an indirection which will be subsequently
 shorted out. Rather than returning the @CAF@ reference we treat the
 @CAF@ as an indirection, calling the mark code of the reference, which
 reference might point to an indirection which will be subsequently
 shorted out. Rather than returning the @CAF@ reference we treat the
 @CAF@ as an indirection, calling the mark code of the reference, which
@@ -1594,21 +1570,20 @@ commented out with @#if 0@.
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-This declares an info table for @CONST@ closures (size 0). 
-It is the info table for a dynamicaly-allocated closure which
-will redirect references to the corresponding
-static closure @<infolbl>_closure@ during garbage collection. 
-A pointer to the static closure is kept in the info table.  (It is
-assumed that this closure is declared elsewhere.)
+This declares an info table for @CONST@ closures (size 0).  It is the
+info table for a dynamicaly-allocated closure which will redirect
+references to the corresponding static closure @<infolbl>_closure@
+during garbage collection.  A pointer to the static closure is kept in
+the info table.  (It is assumed that this closure is declared
+elsewhere.)
 
 
-Why do such @CONST@ objects ever exist?  Why don't we just use the static
-object in the first place?  @CONST@ objects are used only for updating
-existing objects.  We could use an indirection, but that risks costing
-extra run-time indirections until the next gc shorts it out.  So
-we update with a @CONST@, and the next gc gets rid of it.
+Why do such @CONST@ objects ever exist?  Why don't we just use the
+static object in the first place?  @CONST@ objects are used only for
+updating existing objects.  We could use an indirection, but that
+risks costing extra run-time indirections until the next GC shorts it
+out.  So we update with a @CONST@, and the next GC gets rid of it.
 
 \begin{code}
 
 \begin{code}
-
 #define CONST_ITBL(infolbl,closurelbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) /*size,ptrs unused*/ \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
 #define CONST_ITBL(infolbl,closurelbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) /*size,ptrs unused*/ \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
@@ -1624,16 +1599,26 @@ we update with a @CONST@, and the next gc gets rid of it.
 
 MAYBE_DECLARE_RTBL(Const,,)
 
 
 MAYBE_DECLARE_RTBL(Const,,)
 
-#define CONST_RTBL()                                                   \
-    const W_ MK_REP_LBL(Const,,)[] = {                                 \
-       INCLUDE_TYPE_INFO(CONST)                                        \
-       INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)                      \
-       INCLUDE_PAR_INFO                                                \
-       INCLUDE_COPYING_INFO_CONST(_Evacuate_Const,_Scavenge_Const)     \
-       INCLUDE_COMPACTING_INFO(_Dummy_Const_entry,_PRStart_Const,      \
-                               _Dummy_Const_entry,_Dummy_Const_entry)  \
-    }
+#ifdef TICKY_TICKY
+    /* we need real routines if we may not be commoning up */
+#define CONST_Scav _Scavenge_0_0
+#define CONST_Link _ScanLink_0_0
+#define CONST_Move _ScanMove_0
+#else
+#define CONST_Scav _Dummy_Const_entry
+#define CONST_Link _Dummy_Const_entry
+#define CONST_Move _Dummy_Const_entry
+#endif
 
 
+#define CONST_RTBL()                                           \
+    const W_ MK_REP_LBL(Const,,)[] = {                         \
+       INCLUDE_TYPE_INFO(CONST)                                \
+       INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
+       INCLUDE_PAR_INFO                                        \
+       INCLUDE_COPYING_INFO(_Evacuate_Const,CONST_Scav)        \
+       INCLUDE_COMPACTING_INFO(CONST_Link,_PRStart_Const,      \
+                               CONST_Move,_Dummy_Const_entry)  \
+    }
 \end{code}
 
 This builds an info-table which will have pointers to the closure
 \end{code}
 
 This builds an info-table which will have pointers to the closure
@@ -1662,7 +1647,6 @@ pointers to the closure replaced with the appropriate element of the
 @CHARLIKE_closures@ array.
 
 \begin{code}
 @CHARLIKE_closures@ array.
 
 \begin{code}
-
 #define CHARLIKE_ITBL(infolbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) /*tag,size,ptrs unused*/ \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
 #define CHARLIKE_ITBL(infolbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) /*tag,size,ptrs unused*/ \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
@@ -1676,32 +1660,34 @@ pointers to the closure replaced with the appropriate element of the
 
 MAYBE_DECLARE_RTBL(CharLike,,)
 
 
 MAYBE_DECLARE_RTBL(CharLike,,)
 
-#define CHARLIKE_RTBL()                                                                \
-    const W_ MK_REP_LBL(CharLike,,)[] = {                                      \
-       INCLUDE_TYPE_INFO(CHARLIKE)                                             \
-       INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)                              \
-       INCLUDE_PAR_INFO                                                        \
-       INCLUDE_COPYING_INFO_CONST(_Evacuate_CharLike,_Scavenge_CharLike)       \
-       INCLUDE_COMPACTING_INFO(_Dummy_CharLike_entry,_PRStart_CharLike,        \
-                               _Dummy_CharLike_entry,_Dummy_CharLike_entry)    \
-       }
+#ifdef TICKY_TICKY
+    /* we need real routines if we may not be commoning up */
+#define CHARLIKE_Scav _Scavenge_1_0
+#define CHARLIKE_Link _ScanLink_1_0
+#define CHARLIKE_Move _ScanMove_1
+#else
+#define CHARLIKE_Scav _Dummy_CharLike_entry
+#define CHARLIKE_Link _Dummy_CharLike_entry
+#define CHARLIKE_Move _Dummy_CharLike_entry
+#endif
 
 
+#define CHARLIKE_RTBL()                                                        \
+    const W_ MK_REP_LBL(CharLike,,)[] = {                              \
+       INCLUDE_TYPE_INFO(CHARLIKE)                                     \
+       INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)                      \
+       INCLUDE_PAR_INFO                                                \
+       INCLUDE_COPYING_INFO(_Evacuate_CharLike,CHARLIKE_Scav)          \
+       INCLUDE_COMPACTING_INFO(CHARLIKE_Link,_PRStart_CharLike,        \
+                               CHARLIKE_Move,_PRIn_Error)              \
+       }
 \end{code}
 
 \end{code}
 
-
 Int-like: this builds the info-table required for intlike closures.
 The normal heap-allocated info-table for fixed-size integers (size
 Int-like: this builds the info-table required for intlike closures.
 The normal heap-allocated info-table for fixed-size integers (size
-@1@); it is used for updates too. 
-At GC, this is redirected to a static intlike closure if one is
-available.
-
-Note again the sneaky hiding of a reference to the real info-table in
-the part of the info-table that normally holds the size of the
-closure.
-THIS CHANGES IN THE COMMONED INFO-TABLE WORLD.
+@1@); it is used for updates too.  At GC, this is redirected to a
+static intlike closure if one is available.
 
 \begin{code}
 
 \begin{code}
-
 #define INTLIKE_ITBL(infolbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) /*tag,size,ptrs unused*/ \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
 #define INTLIKE_ITBL(infolbl,entry_code,upd_code,liveness,tag,size,ptrs,localness,entry_localness,kind,descr,type) /*tag,size,ptrs unused*/ \
     CAT_DECLARE(infolbl,kind,descr,type)       \
     entry_localness(entry_code);               \
@@ -1720,11 +1706,10 @@ MAYBE_DECLARE_RTBL(IntLike,,)
        INCLUDE_TYPE_INFO(INTLIKE)                                      \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)                      \
        INCLUDE_PAR_INFO                                                \
        INCLUDE_TYPE_INFO(INTLIKE)                                      \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)                      \
        INCLUDE_PAR_INFO                                                \
-       INCLUDE_COPYING_INFO_CONST(_Evacuate_IntLike,_Scavenge_1_0)     \
+       INCLUDE_COPYING_INFO(_Evacuate_IntLike,_Scavenge_1_0)           \
        INCLUDE_COMPACTING_INFO(_ScanLink_1_0,_PRStart_IntLike,         \
                                _ScanMove_1,_PRIn_Error)                \
     }
        INCLUDE_COMPACTING_INFO(_ScanLink_1_0,_PRStart_IntLike,         \
                                _ScanMove_1,_PRIn_Error)                \
     }
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index cb47a45..9fb25d8 100644 (file)
@@ -49,6 +49,9 @@ if it's not static.
 typedef I_ (StgScanFun)(STG_NO_ARGS);
 typedef I_ (*StgScanPtr)(STG_NO_ARGS);
 
 typedef I_ (StgScanFun)(STG_NO_ARGS);
 typedef I_ (*StgScanPtr)(STG_NO_ARGS);
 
+#ifdef TICKY_TICKY
+extern StgScanFun _ScanLink_0_0;
+#endif
 extern StgScanFun _ScanLink_1_0;
 extern StgScanFun _ScanLink_2_0;
 extern StgScanFun _ScanLink_3_0;
 extern StgScanFun _ScanLink_1_0;
 extern StgScanFun _ScanLink_2_0;
 extern StgScanFun _ScanLink_3_0;
@@ -78,7 +81,7 @@ extern StgScanFun _ScanLink_Tuple;
 extern StgScanFun _ScanLink_Data;
 extern StgScanFun _ScanLink_MuTuple;
 
 extern StgScanFun _ScanLink_Data;
 extern StgScanFun _ScanLink_MuTuple;
 
-#ifdef USE_COST_CENTRES
+#if defined(PROFILING) || defined(TICKY_TICKY)
 extern StgScanFun _ScanLink_PI;
 #endif
 
 extern StgScanFun _ScanLink_PI;
 #endif
 
@@ -128,6 +131,9 @@ extern StgScanFun _ScanLink_TSO;
 extern StgScanFun _ScanLink_BQ;
 #endif
 
 extern StgScanFun _ScanLink_BQ;
 #endif
 
+#ifdef TICKY_TICKY
+extern StgScanFun _ScanMove_0;
+#endif
 extern StgScanFun _ScanMove_1;
 extern StgScanFun _ScanMove_2;
 extern StgScanFun _ScanMove_3;
 extern StgScanFun _ScanMove_1;
 extern StgScanFun _ScanMove_2;
 extern StgScanFun _ScanMove_3;
@@ -147,7 +153,7 @@ extern StgScanFun _ScanMove_Tuple;
 extern StgScanFun _ScanMove_Data;
 extern StgScanFun _ScanMove_MuTuple;
 
 extern StgScanFun _ScanMove_Data;
 extern StgScanFun _ScanMove_MuTuple;
 
-#ifdef USE_COST_CENTRES
+#if defined(PROFILING) || defined(TICKY_TICKY)
 extern StgScanFun _ScanMove_PI;
 #endif
 
 extern StgScanFun _ScanMove_PI;
 #endif
 
index 0264eb3..252fbfc 100644 (file)
@@ -43,6 +43,9 @@ extern StgEvacFun _EvacuateSelector_10;
 extern StgEvacFun _EvacuateSelector_11;
 extern StgEvacFun _EvacuateSelector_12;
 
 extern StgEvacFun _EvacuateSelector_11;
 extern StgEvacFun _EvacuateSelector_12;
 
+#ifdef TICKY_TICKY
+extern StgScavFun _Scavenge_0_0;
+#endif
 extern StgScavFun _Scavenge_1_0;
 extern StgScavFun _Scavenge_2_0;
 extern StgScavFun _Scavenge_3_0;
 extern StgScavFun _Scavenge_1_0;
 extern StgScavFun _Scavenge_2_0;
 extern StgScavFun _Scavenge_3_0;
@@ -126,7 +129,6 @@ extern StgEvacFun _Evacuate_BH_U;
 extern StgScavFun _Scavenge_BH_U;
 
 extern StgEvacFun _Evacuate_Static;
 extern StgScavFun _Scavenge_BH_U;
 
 extern StgEvacFun _Evacuate_Static;
-extern StgScavFun _Scavenge_Static;
 
 extern StgEvacFun _Evacuate_Ind;
 extern StgScavFun _Scavenge_Ind;
 
 extern StgEvacFun _Evacuate_Ind;
 extern StgScavFun _Scavenge_Ind;
@@ -134,19 +136,16 @@ extern StgScavFun _Scavenge_Ind;
 extern StgEvacFun _Evacuate_Caf;
 extern StgScavFun _Scavenge_Caf;
 
 extern StgEvacFun _Evacuate_Caf;
 extern StgScavFun _Scavenge_Caf;
 
-#ifdef USE_COST_CENTRES
+#if defined(PROFILING) || defined(TICKY_TICKY)
 extern StgEvacFun _Evacuate_PI;
 extern StgScavFun _Scavenge_PI;
 #endif
 
 extern StgEvacFun _Evacuate_Const;
 extern StgEvacFun _Evacuate_PI;
 extern StgScavFun _Scavenge_PI;
 #endif
 
 extern StgEvacFun _Evacuate_Const;
-extern StgScavFun _Scavenge_Const;
 
 extern StgEvacFun _Evacuate_CharLike;
 
 extern StgEvacFun _Evacuate_CharLike;
-extern StgScavFun _Scavenge_CharLike;
 
 extern StgEvacFun _Evacuate_IntLike;
 
 extern StgEvacFun _Evacuate_IntLike;
-extern StgScavFun _Scavenge_IntLike;
 
 #ifdef CONCURRENT
 extern StgEvacFun _Evacuate_BQ;
 
 #ifdef CONCURRENT
 extern StgEvacFun _Evacuate_BQ;
@@ -158,7 +157,6 @@ extern StgScavFun _Scavenge_TSO;
 extern StgEvacFun _Evacuate_StkO;
 extern StgScavFun _Scavenge_StkO;
 #endif
 extern StgEvacFun _Evacuate_StkO;
 extern StgScavFun _Scavenge_StkO;
 #endif
-
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
index 0622d4d..86279f1 100644 (file)
@@ -96,12 +96,12 @@ Answer: They're on the heap in a "Stable Pointer Table". (ADR)
 
 The storage manager is accessed exclusively through these routines:
 \begin{code}
 
 The storage manager is accessed exclusively through these routines:
 \begin{code}
-IF_RTS(I_ initSM           PROTO((I_ rts_argc, char **rts_argv, FILE *statsfile));)
-IF_RTS(I_ exitSM           PROTO((smInfo *sm));)
-IF_RTS(I_ initStacks       PROTO((smInfo *sm));)
-IF_RTS(I_ initHeap         PROTO((smInfo *sm));)
+IF_RTS(void    initSM      (STG_NO_ARGS);)
+IF_RTS(rtsBool exitSM      PROTO((smInfo *sm));)
+IF_RTS(rtsBool initStacks   PROTO((smInfo *sm));)
+IF_RTS(rtsBool initHeap            PROTO((smInfo *sm));)
 #ifdef CONCURRENT
 #ifdef CONCURRENT
-IF_RTS(rtsBool initThreadPool PROTO((I_ size));)
+IF_RTS(rtsBool initThreadPools (STG_NO_ARGS);)
 #endif
 #ifdef PAR
 IF_RTS(void init_gr_profiling PROTO((int, char **, int, char **));)
 #endif
 #ifdef PAR
 IF_RTS(void init_gr_profiling PROTO((int, char **, int, char **));)
@@ -111,7 +111,7 @@ I_ collectHeap          PROTO((W_ reqsize, smInfo *sm, rtsBool do_full_collection));
 
 IF_RTS(void unmapMiddleStackPage PROTO((char *, int));) /* char * == caddr_t ? */
 
 
 IF_RTS(void unmapMiddleStackPage PROTO((char *, int));) /* char * == caddr_t ? */
 
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
 IF_RTS(void handle_tick_serial(STG_NO_ARGS);)
 IF_RTS(void handle_tick_noserial(STG_NO_ARGS);)
 #endif
 IF_RTS(void handle_tick_serial(STG_NO_ARGS);)
 IF_RTS(void handle_tick_noserial(STG_NO_ARGS);)
 #endif
@@ -130,10 +130,7 @@ void RebuildGAtables PROTO((rtsBool full));
 
 \end{code}
 
 
 \end{code}
 
-@initSM@ processes any runtime parameters directed towards the storage
-manager. The @statsfile@ parameter is an open file, which will contain
-any garbage collection statistics requested by the user.  This file
-must be opened for writing.
+@initSM@ finalizes any runtime parameters of the storage manager.
 
 @exitSM@ does any cleaning up required by the storage manager before
 the program is executed. Its main purpose is to print any summary
 
 @exitSM@ does any cleaning up required by the storage manager before
 the program is executed. Its main purpose is to print any summary
index 3a762a3..2c6cb0b 100644 (file)
@@ -45,7 +45,7 @@ extern F_ _PRStart_Tuple(STG_NO_ARGS);
 extern F_ _PRStart_Data(STG_NO_ARGS);
 extern F_ _PRStart_MuTuple(STG_NO_ARGS);
 
 extern F_ _PRStart_Data(STG_NO_ARGS);
 extern F_ _PRStart_MuTuple(STG_NO_ARGS);
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
 extern F_ _PRStart_PI(STG_NO_ARGS);
 #endif
 
 extern F_ _PRStart_PI(STG_NO_ARGS);
 #endif
 
@@ -139,7 +139,7 @@ extern F_ _PRIn_I_MallocPtr(STG_NO_ARGS);
 
 extern F_ _PRIn_Error(STG_NO_ARGS);
 
 
 extern F_ _PRIn_Error(STG_NO_ARGS);
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
 extern F_ _PRIn_PI(STG_NO_ARGS);
 #endif
 
 extern F_ _PRIn_PI(STG_NO_ARGS);
 #endif
 
index 146bd0a..7da6a10 100644 (file)
@@ -158,7 +158,7 @@ EXTFUN(PrimUnderflow);
 #define PUSH_SuB(frame, sub)           (frame)[BREL(UF_SUB)] = (W_)(sub)
 #define PUSH_SuA(frame, sua)           (frame)[BREL(UF_SUA)] = (W_)(sua)
 
 #define PUSH_SuB(frame, sub)           (frame)[BREL(UF_SUB)] = (W_)(sub)
 #define PUSH_SuA(frame, sua)           (frame)[BREL(UF_SUA)] = (W_)(sua)
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 #define        PUSH_STD_CCC(frame) (frame)[BREL(UF_COST_CENTRE)] = (W_)(CCC)
 #else
 #define        PUSH_STD_CCC(frame)
 #define        PUSH_STD_CCC(frame) (frame)[BREL(UF_COST_CENTRE)] = (W_)(CCC)
 #else
 #define        PUSH_STD_CCC(frame)
@@ -245,32 +245,21 @@ block when attempting to enter a closure already under evaluation.
                                        /* BHed on entry -- GC cant do it */
 \end{code}
 
                                        /* BHed on entry -- GC cant do it */
 \end{code}
 
-Finally we indicate to the storage manager if it is required to trace
-closures on the B stack and overwrite them with black holes.
-
-\begin{code}
-/* define SM_DO_BH_UPDATE if B stack closures to be BHed by GC */
-#if !defined(CONCURRENT)
-#define SM_DO_BH_UPDATE           
-#endif
-\end{code}
-
-
 %************************************************************************
 %*                                                                     *
 \subsubsection[caf-update]{Entering CAFs}
 %*                                                                     *
 %************************************************************************
 
 %************************************************************************
 %*                                                                     *
 \subsubsection[caf-update]{Entering CAFs}
 %*                                                                     *
 %************************************************************************
 
-When we enter a CAF we update it with an indirection to a heap
-allocated black hole. The @UPD_CAF@ macro updates the CAF with an
-@CAF@ indirection to the heap allocated closure and adds the updated
+When we enter a CAF, we update it with an indirection to a
+heap-allocated black hole. The @UPD_CAF@ macro updates the CAF with an
+@CAF@ indirection to the heap-allocated closure and adds the updated
 CAF to the list of CAFs. It is up to the entry code to allocate the
 black hole.
 
 CAF to the list of CAFs. It is up to the entry code to allocate the
 black hole.
 
-The @CAF@ info table used is the @Caf_Return@ table. It will be
+The @CAF@ info table used is the @Caf_info@ table. It will be
 overwritten at the start of garbage collection with the @Caf_Evac_Upd@
 overwritten at the start of garbage collection with the @Caf_Evac_Upd@
-and then reset to @Caf_Return@ during garbage collection.
+and then reset to @Caf_info@ during garbage collection.
 
 In the parallel case, the new black hole will be a local node
 (with a GA of 0).  This means that the code to update indirections
 
 In the parallel case, the new black hole will be a local node
 (with a GA of 0).  This means that the code to update indirections
@@ -280,18 +269,16 @@ update CAFs across the parallel machine), you should check @UPD_IND@
 etc.
 
 \begin{code}
 etc.
 
 \begin{code}
-
 EXTDATA_RO(Caf_info);
 EXTFUN(Caf_entry);
 
 #define UPD_CAF(cafptr, bhptr)                                 \
   do {                                                         \
   SET_INFO_PTR(cafptr, Caf_info);                              \
 EXTDATA_RO(Caf_info);
 EXTFUN(Caf_entry);
 
 #define UPD_CAF(cafptr, bhptr)                                 \
   do {                                                         \
   SET_INFO_PTR(cafptr, Caf_info);                              \
-  IND_CLOSURE_PTR(cafptr) = (W_) (bhptr);                      \
+  IND_CLOSURE_PTR(cafptr)  = (W_) (bhptr);                     \
   IND_CLOSURE_LINK(cafptr) = (W_) StorageMgrInfo.CAFlist;      \
   IND_CLOSURE_LINK(cafptr) = (W_) StorageMgrInfo.CAFlist;      \
-  StorageMgrInfo.CAFlist = (P_) (cafptr);                      \
+  StorageMgrInfo.CAFlist   = (P_) (cafptr);                    \
   } while(0)
   } while(0)
-
 \end{code}
 
 
 \end{code}
 
 
@@ -309,14 +296,14 @@ Overwrites the updatable closure @updclosure@ with an indirection to
 @heapptr@.
 
 \item[@UPD_INPLACE_NOPTRS(updclosure, livemask)@]\ \\
 @heapptr@.
 
 \item[@UPD_INPLACE_NOPTRS(updclosure, livemask)@]\ \\
-This prepares the closure pointed to by @updclosure@ to be updated in-place 
-with a closure of size @MIN_UPD_SIZE@ containing no pointers.
+This prepares the closure pointed to by @updclosure@ to be updated
+in-place with a closure of size @MIN_UPD_SIZE@ containing no pointers.
 
 \item[@UPD_INPLACE_PTRS(updclosure, livemask)@]\ \\
 
 \item[@UPD_INPLACE_PTRS(updclosure, livemask)@]\ \\
-This prepares the closure pointed to by @updclosure@ to be updated in-place 
-with a closure of size @MIN_UPD_SIZE@ which may contain pointers. It checks
-whether @updclosure@ is allowed to be updated inplace. If it is not
-it:
+This prepares the closure pointed to by @updclosure@ to be updated
+in-place with a closure of size @MIN_UPD_SIZE@ which may contain
+pointers. It checks whether @updclosure@ is allowed to be updated
+inplace. If it is not it:
 \begin{enumerate}
 \item Allocates space for a new closure of size @MIN_UPD_SIZE@ (by
 calling @HEAP_CHK_RETRY@);
 \begin{enumerate}
 \item Allocates space for a new closure of size @MIN_UPD_SIZE@ (by
 calling @HEAP_CHK_RETRY@);
@@ -335,24 +322,6 @@ body to be filled out.
 The @UPD_IND@ and @UPDATE_INPLACE@ macros may have different
 definitions depending on the garbage collection schemes in use.
 
 The @UPD_IND@ and @UPDATE_INPLACE@ macros may have different
 definitions depending on the garbage collection schemes in use.
 
-First we have the declarations which trace updates. These are calls to
-tracing routines inserted if @DO_RUNTIME_TRACE_UPDATES@ is defined and
-printed if @traceUpdates@ is true.
-
-\begin{code}
-#if defined(DO_RUNTIME_TRACE_UPDATES)
-
-extern I_ traceUpdates;
-extern void TRACE_UPDATE_Ind();
-extern void TRACE_UPDATE_Inplace_NoPtrs();
-extern void TRACE_UPDATE_Inplace_Ptrs();
-
-#define TRACE_UPDATE(_trace) _trace
-#else
-#define TRACE_UPDATE(_trace) /* nothing */
-#endif
-\end{code}
-
 Before describing the update macros we declare the partial application
 entry and update code (See \tr{StgUpdate.lhc}).
 
 Before describing the update macros we declare the partial application
 entry and update code (See \tr{StgUpdate.lhc}).
 
@@ -371,67 +340,73 @@ EXTFUN(UpdatePAP);
 \begin{code}
 #ifdef CONCURRENT
 
 \begin{code}
 #ifdef CONCURRENT
 
+/* In the concurrent world, the targed of an update might
+   be a black hole with a blocking queue attached.  If so,
+   it will already be on the mutables list, and we have to be careful
+   not to put it on twice else it screws up the list. */
 #define ALREADY_LINKED(closure)        \
     (IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) != MUT_NOT_LINKED)
 
 #define ALREADY_LINKED(closure)        \
     (IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) != MUT_NOT_LINKED)
 
-#if defined(GRAN)
+# if defined(GRAN)
 extern I_ AwakenBlockingQueue PROTO((P_));
 extern I_ AwakenBlockingQueue PROTO((P_));
-#else
+# else
 extern void AwakenBlockingQueue PROTO((P_));
 extern void AwakenBlockingQueue PROTO((P_));
-#endif
+# endif
 
 
-#ifdef MAIN_REG_MAP
-#define AWAKEN_BQ(updatee)                                             \
+# ifdef MAIN_REG_MAP
+#  define AWAKEN_BQ(updatee)                                           \
 do { if (IS_BQ_CLOSURE(updatee))                                       \
  STGCALL1(void,(void *, P_), AwakenBlockingQueue, (P_) BQ_ENTRIES(updatee)); \
 } while(0);
 do { if (IS_BQ_CLOSURE(updatee))                                       \
  STGCALL1(void,(void *, P_), AwakenBlockingQueue, (P_) BQ_ENTRIES(updatee)); \
 } while(0);
-#endif
+# endif
 
 
-#ifdef NULL_REG_MAP
-#define AWAKEN_BQ(updatee)                     \
+# ifdef NULL_REG_MAP
+#  define AWAKEN_BQ(updatee)                   \
 do { if (IS_BQ_CLOSURE(updatee))               \
  AwakenBlockingQueue((P_)BQ_ENTRIES(updatee)); \
 } while(0);
 do { if (IS_BQ_CLOSURE(updatee))               \
  AwakenBlockingQueue((P_)BQ_ENTRIES(updatee)); \
 } while(0);
-#endif
+# endif
 
 
-#define AWAKEN_INPLACE_BQ()
+# define AWAKEN_INPLACE_BQ()
 
 
-#else
+#else /* !CONCURRENT */
 
 
-#define ALREADY_LINKED(closure)        0
+# define ALREADY_LINKED(closure) 0 /* NB: see note above in CONCURRENT */
 
 
-#define AWAKEN_BQ(updatee)
-#define AWAKEN_INPLACE_BQ()
+# define AWAKEN_BQ(updatee)
+# define AWAKEN_INPLACE_BQ()
 
 
-#endif
+#endif /* CONCURRENT */
 
 EXTDATA_RO(Ind_info);
 EXTFUN(Ind_entry);
 
 EXTDATA_RO(Ind_info);
 EXTFUN(Ind_entry);
+#ifndef TICKY_TICKY
+# define Ind_info_TO_USE Ind_info
+#else
+EXTDATA_RO(Perm_Ind_info);
+EXTFUN(Perm_Ind_entry);
+
+# define Ind_info_TO_USE ((AllFlags.doUpdEntryCounts) ? Perm_Ind_info : Ind_info)
+#endif
 
 #if defined(GC2s) || defined(GC1s) || defined(GCdu)
 
 
 #if defined(GC2s) || defined(GC1s) || defined(GCdu)
 
+#define INPLACE_UPD_HDR(closure,infolbl,cc,size,ptrs)          \
+       UPD_FIXED_HDR(closure,infolbl,cc)
+
 #define UPD_IND(updclosure, heapptr)                                   \
 #define UPD_IND(updclosure, heapptr)                                   \
-       TRACE_UPDATE(TRACE_UPDATE_Ind(updclosure,heapptr));     \
-       UPDATED_SET_UPDATED(updclosure); /* subs entry count */ \
-       UPDATE_PROFILE_CLOSURE((P_)updclosure);                 \
+       UPDATED_SET_UPDATED(updclosure); /* ticky */            \
        AWAKEN_BQ(updclosure);                                  \
        AWAKEN_BQ(updclosure);                                  \
-       SET_INFO_PTR(updclosure, Ind_info);                     \
+       SET_INFO_PTR(updclosure, Ind_info_TO_USE);              \
        IND_CLOSURE_PTR(updclosure) = (W_)(heapptr)
 
 #define UPD_INPLACE_NOPTRS(livemask)                           \
        IND_CLOSURE_PTR(updclosure) = (W_)(heapptr)
 
 #define UPD_INPLACE_NOPTRS(livemask)                           \
-       TRACE_UPDATE(TRACE_UPDATE_Inplace_NoPtrs(Node));        \
-       UPDATED_SET_UPDATED(Node); /* subs entry count */       \
-       UPDATE_PROFILE_CLOSURE(Node);                           \
+       UPDATED_SET_UPDATED(Node); /* ticky */                  \
        AWAKEN_BQ(Node);
 
 #define UPD_INPLACE_PTRS(livemask)                             \
        AWAKEN_BQ(Node);
 
 #define UPD_INPLACE_PTRS(livemask)                             \
-       TRACE_UPDATE(TRACE_UPDATE_Inplace_Ptrs(Node,hp));       \
-       UPDATED_SET_UPDATED(Node); /* subs entry count */       \
-       UPDATE_PROFILE_CLOSURE(Node);                           \
+       UPDATED_SET_UPDATED(Node); /* ticky */                  \
        AWAKEN_BQ(Node);
        AWAKEN_BQ(Node);
-
-#define INPLACE_UPD_HDR(closure,infolbl,cc,size,ptrs)          \
-       UPD_FIXED_HDR(closure,infolbl,cc)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -445,86 +420,81 @@ which are updated. They must be updated with an indirection and linked
 onto the list of old generation closures.
 
 \begin{code}
 onto the list of old generation closures.
 
 \begin{code}
-#else
-#if defined(GCap) || defined(GCgn)
-
-#define UPD_IND(updclosure, heapptr)                           \
-{ TRACE_UPDATE(TRACE_UPDATE_Ind(updclosure,heapptr));          \
-  if ( ((P_)(updclosure)) <= StorageMgrInfo.OldLim) {          \
-      UPD_OLD_IND();                                           \
-      if(!ALREADY_LINKED(updclosure)) {                                \
-          MUT_LINK(updclosure)                                 \
-             = (W_) StorageMgrInfo.OldMutables;                \
-          StorageMgrInfo.OldMutables = (P_) (updclosure);      \
-      }                                                                \
-  } else {                                                     \
-      UPD_NEW_IND();                                           \
-  }                                                            \
-  AWAKEN_BQ(updclosure);                                       \
-  SET_INFO_PTR(updclosure, Ind_info);                          \
-  IND_CLOSURE_PTR(updclosure) = (W_)(heapptr);                 \
+#else /* !(2s/1s/du) */
+# if defined(GCap) || defined(GCgn)
+
+/* same as before */
+#define INPLACE_UPD_HDR(closure,infolbl,cc,size,ptrs)                  \
+  UPD_FIXED_HDR(closure,infolbl,cc)
+
+/* updclosure is the updatee, heapptr is what to update it with */
+#define UPD_IND(updclosure, heapptr)                                   \
+{ UPDATED_SET_UPDATED(updclosure); /* ticky */                         \
+  if ( ((P_)(updclosure)) > StorageMgrInfo.OldLim ) {                  \
+      UPD_NEW_IND(); /*ticky*/                                         \
+  } else {                                                             \
+      UPD_OLD_IND(); /*ticky*/                                                 \
+      if(!ALREADY_LINKED(updclosure)) {                                        \
+          MUT_LINK(updclosure) = (W_) StorageMgrInfo.OldMutables;      \
+          StorageMgrInfo.OldMutables = (P_) (updclosure);              \
+      }                                                                        \
+  }                                                                    \
+  AWAKEN_BQ(updclosure);                                               \
+  SET_INFO_PTR(updclosure, Ind_info_TO_USE);                           \
+  IND_CLOSURE_PTR(updclosure) = (W_)(heapptr);                         \
 }
 
 /* 
  * In threaded-land, we have to do the same nonsense as UPD_INPLACE_PTRS if
  * we were a blocking queue on the old mutables list.
  */
 }
 
 /* 
  * In threaded-land, we have to do the same nonsense as UPD_INPLACE_PTRS if
  * we were a blocking queue on the old mutables list.
  */
-#define UPD_INPLACE_NOPTRS(live_regs_mask)             \
-  TRACE_UPDATE(TRACE_UPDATE_Inplace_NoPtrs(Node));     \
-  if ( Node <= StorageMgrInfo.OldLim) {                \
-      UPD_OLD_IN_PLACE_NOPTRS();                               \
-      if(ALREADY_LINKED(Node)) {                               \
-          /* We are already on the old mutables list, so we    \
-            can't update in place any more */                  \
-          HEAP_CHK(live_regs_mask, _FHS+MIN_UPD_SIZE, 0);      \
-           /* ticky-ticky (NB: was ALLOC_UPD_CON) */           \
-          ALLOC_CON(_FHS,1,MIN_UPD_SIZE-1,_FHS+MIN_UPD_SIZE);  \
-          CC_ALLOC(CCC,_FHS+MIN_UPD_SIZE,CON_K);               \
-         /* must awaken after any possible GC */       \
-         AWAKEN_BQ(Node);                              \
-          SET_INFO_PTR(Node, Ind_info);                        \
-          IND_CLOSURE_PTR(Node) =                      \
-           (W_)(Hp-(_FHS+MIN_UPD_SIZE-1));             \
-          Node = Hp-(_FHS+MIN_UPD_SIZE-1);             \
-      }                                                        \
-  } else {                                             \
-      UPD_NEW_IN_PLACE_NOPTRS();                       \
-      AWAKEN_BQ(Node);                                 \
+#define UPD_INPLACE_NOPTRS(live_regs_mask)                             \
+  UPDATED_SET_UPDATED(Node); /* ticky */                               \
+  if ( Node > StorageMgrInfo.OldLim) {                                         \
+      UPD_NEW_IN_PLACE_NOPTRS(); /*ticky*/                             \
+      AWAKEN_BQ(Node);                                                 \
+  } else {                                                             \
+      UPD_OLD_IN_PLACE_NOPTRS(); /*ticky*/                             \
+      if(ALREADY_LINKED(Node)) {                                       \
+          /* We are already on the old mutables list, so we            \
+            can't update in place any more */                          \
+          HEAP_CHK(live_regs_mask, _FHS+MIN_UPD_SIZE, 0);              \
+           /* ticky-ticky (NB: was ALLOC_UPD_CON) */                   \
+          ALLOC_CON(_FHS,1,MIN_UPD_SIZE-1,_FHS+MIN_UPD_SIZE);          \
+          CC_ALLOC(CCC,_FHS+MIN_UPD_SIZE,CON_K);                       \
+         /* must awaken after any possible GC */                       \
+         AWAKEN_BQ(Node);                                              \
+          SET_INFO_PTR(Node, Ind_info_TO_USE);                         \
+          IND_CLOSURE_PTR(Node) = (W_)(Hp-(_FHS+MIN_UPD_SIZE-1));      \
+          Node = Hp-(_FHS+MIN_UPD_SIZE-1);                             \
+      }                                                                        \
   }
 
   }
 
-#define UPD_INPLACE_PTRS(live_regs_mask)               \
-  TRACE_UPDATE(TRACE_UPDATE_Inplace_Ptrs(Node,hp));    \
-  if ( Node <= StorageMgrInfo.OldLim) {                        \
-      /* redirect update with indirection */                   \
-      UPD_OLD_IN_PLACE_PTRS();                                         \
-      /* Allocate */                                           \
-      HEAP_CHK(live_regs_mask, _FHS+MIN_UPD_SIZE, 0);          \
-       /* ticky-ticky (NB: was ALLOC_UPD_CON) */               \
-      ALLOC_CON(_FHS,1,MIN_UPD_SIZE-1,_FHS+MIN_UPD_SIZE);      \
-      CC_ALLOC(CCC,_FHS+MIN_UPD_SIZE,CON_K);                   \
-                                                               \
-      if (!ALREADY_LINKED(Node)) {                     \
-          MUT_LINK(Node)                               \
-           = (W_) StorageMgrInfo.OldMutables;          \
-          StorageMgrInfo.OldMutables = (P_) (Node);    \
-      }                                                        \
-      /* must awaken after any possible GC */          \
-      AWAKEN_BQ(Node);                                 \
-      SET_INFO_PTR(Node, Ind_info);                    \
-      IND_CLOSURE_PTR(Node)                            \
-       = (W_)(Hp-(_FHS+MIN_UPD_SIZE-1));               \
-      Node = Hp-(_FHS+MIN_UPD_SIZE-1);                 \
-  } else {                                             \
-      UPD_NEW_IN_PLACE_PTRS();                                 \
-      AWAKEN_BQ(Node);                                 \
-  }                                                    \
-
-
-/* same as before */
-#define INPLACE_UPD_HDR(closure,infolbl,cc,size,ptrs)          \
-  UPD_FIXED_HDR(closure,infolbl,cc)
-
-#endif /* GCap || GCgn */
+#define UPD_INPLACE_PTRS(live_regs_mask)                               \
+  UPDATED_SET_UPDATED(Node); /* ticky */                               \
+  if ( Node > StorageMgrInfo.OldLim) {                                 \
+      UPD_NEW_IN_PLACE_PTRS(); /*ticky*/                                       \
+      AWAKEN_BQ(Node);                                                 \
+  } else {                                                             \
+      /* redirect update with indirection */                           \
+      UPD_OLD_IN_PLACE_PTRS(); /*ticky*/                               \
+      /* Allocate */                                                   \
+      HEAP_CHK(live_regs_mask, _FHS+MIN_UPD_SIZE, 0);                  \
+       /* ticky-ticky (NB: was ALLOC_UPD_CON) */                       \
+      ALLOC_CON(_FHS,1,MIN_UPD_SIZE-1,_FHS+MIN_UPD_SIZE);              \
+      CC_ALLOC(CCC,_FHS+MIN_UPD_SIZE,CON_K);                           \
+                                                                       \
+      if (!ALREADY_LINKED(Node)) {                                     \
+          MUT_LINK(Node) = (W_) StorageMgrInfo.OldMutables;            \
+          StorageMgrInfo.OldMutables = (P_) (Node);                    \
+      }                                                                        \
+      /* must awaken after any possible GC */                          \
+      AWAKEN_BQ(Node);                                                 \
+      SET_INFO_PTR(Node, Ind_info_TO_USE);                             \
+      IND_CLOSURE_PTR(Node) = (W_)(Hp-(_FHS+MIN_UPD_SIZE-1));          \
+      Node = Hp-(_FHS+MIN_UPD_SIZE-1);                                 \
+  }
+# endif /* GCap || GCgn */
 #endif
 \end{code}
 
 #endif
 \end{code}
 
@@ -551,6 +521,5 @@ do it so better profiling information is provided.
        SET_INFO_PTR(freezeclosure, immutinfo)
 #endif
 
        SET_INFO_PTR(freezeclosure, immutinfo)
 #endif
 
-
 #endif /* SMUPDATE_H */
 \end{code}
 #endif /* SMUPDATE_H */
 \end{code}
index f74d18a..5435220 100644 (file)
@@ -142,37 +142,27 @@ than (x-a < n).
 
 \begin{code}
 #define ARGS_CHK_A(n)                                          \
 
 \begin{code}
 #define ARGS_CHK_A(n)                                          \
-       SET_ACTIVITY(ACT_ARGS_CHK); /* SPAT counting */         \
        if (SuA /*SUBTRACT_A_STK( SpA, SuA )*/ < (SpA+(n))) {   \
                JMP_( UpdatePAP );                              \
        if (SuA /*SUBTRACT_A_STK( SpA, SuA )*/ < (SpA+(n))) {   \
                JMP_( UpdatePAP );                              \
-       }                                                       \
-       SET_ACTIVITY(ACT_TAILCALL)
+       }
 
 #define ARGS_CHK_A_LOAD_NODE(n, closure_addr)                  \
 
 #define ARGS_CHK_A_LOAD_NODE(n, closure_addr)                  \
-       SET_ACTIVITY(ACT_ARGS_CHK); /* SPAT counting */         \
        if (SuA /*SUBTRACT_A_STK( SpA, SuA )*/ < (SpA+(n))) {   \
                Node = (P_) closure_addr;                       \
                JMP_( UpdatePAP );                              \
        if (SuA /*SUBTRACT_A_STK( SpA, SuA )*/ < (SpA+(n))) {   \
                Node = (P_) closure_addr;                       \
                JMP_( UpdatePAP );                              \
-       }                                                       \
-       SET_ACTIVITY(ACT_TAILCALL)
-
+       }
 
 #define ARGS_CHK_B(n)                                          \
 
 #define ARGS_CHK_B(n)                                          \
-       SET_ACTIVITY(ACT_ARGS_CHK); /* SPAT counting */         \
        if (SpB /*SUBTRACT_B_STK( SpB, SuB )*/ < (SuB-(n))) {   \
                JMP_( UpdatePAP );                              \
        if (SpB /*SUBTRACT_B_STK( SpB, SuB )*/ < (SuB-(n))) {   \
                JMP_( UpdatePAP );                              \
-       }                                                       \
-       SET_ACTIVITY(ACT_TAILCALL)
+       }
 
 
 #define ARGS_CHK_B_LOAD_NODE(n, closure_addr)                  \
 
 
 #define ARGS_CHK_B_LOAD_NODE(n, closure_addr)                  \
-       SET_ACTIVITY(ACT_ARGS_CHK); /* SPAT counting */         \
        if (SpB /*SUBTRACT_B_STK( SpB, SuB )*/ < (SuB-(n))) {   \
                Node = (P_) closure_addr;                       \
                JMP_( UpdatePAP );                              \
        if (SpB /*SUBTRACT_B_STK( SpB, SuB )*/ < (SuB-(n))) {   \
                Node = (P_) closure_addr;                       \
                JMP_( UpdatePAP );                              \
-       }                                                       \
-       SET_ACTIVITY(ACT_TAILCALL)
-
+       }
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -190,6 +180,7 @@ words of A stack and @b@ words of B stack.  If not, it calls
 NB: args @a@ and @b@ are pre-direction-ified!
 \begin{code}
 extern I_ SqueezeUpdateFrames PROTO((P_, P_, P_));
 NB: args @a@ and @b@ are pre-direction-ified!
 \begin{code}
 extern I_ SqueezeUpdateFrames PROTO((P_, P_, P_));
+int sanityChk_StkO (P_ stko); /* ToDo: move to a sane place */
 
 #if ! defined(CONCURRENT)
 
 
 #if ! defined(CONCURRENT)
 
@@ -233,7 +224,6 @@ extern I_ StackOverflow PROTO((W_, W_));
 do {                                                           \
   DO_ASTK_HWM(); /* ticky-ticky profiling */                   \
   DO_BSTK_HWM();                                               \
 do {                                                           \
   DO_ASTK_HWM(); /* ticky-ticky profiling */                   \
   DO_BSTK_HWM();                                               \
-  /* SET_ACTIVITY(ACT_STK_CHK); /? SPAT counting -- no, using page faulting */ \
   if (STKS_OVERFLOW_OP((a_headroom) + 1, (b_headroom) + 1)) {  \
     STACK_OVERFLOW(liveness_mask,a_headroom,b_headroom,spa,spb,ret_type,reenter);\
   }                                                            \
   if (STKS_OVERFLOW_OP((a_headroom) + 1, (b_headroom) + 1)) {  \
     STACK_OVERFLOW(liveness_mask,a_headroom,b_headroom,spa,spb,ret_type,reenter);\
   }                                                            \
@@ -295,9 +285,7 @@ void StgPerformGarbageCollection(STG_NO_ARGS);
 
 #define HEAP_OVERFLOW(liveness,n,reenter)      \
     do {                                       \
 
 #define HEAP_OVERFLOW(liveness,n,reenter)      \
     do {                                       \
-    SET_ACTIVITY(ACT_GC); /* SPAT profiling */ \
     DO_GC((((W_)n)<<8)|(liveness));            \
     DO_GC((((W_)n)<<8)|(liveness));            \
-    SET_ACTIVITY(ACT_GC_STOP);                 \
     } while (0)
 
 #define REQSIZE_BITMASK        ((1L << ((BITS_IN(W_) - 8 + 1))) - 1)
     } while (0)
 
 #define REQSIZE_BITMASK        ((1L << ((BITS_IN(W_) - 8 + 1))) - 1)
@@ -311,9 +299,7 @@ extern void ReallyPerformThreadGC PROTO((W_, rtsBool));
 
 #define HEAP_OVERFLOW(liveness,n,reenter)      \
     do {                                       \
 
 #define HEAP_OVERFLOW(liveness,n,reenter)      \
     do {                                       \
-    SET_ACTIVITY(ACT_GC); /* SPAT profiling */ \
     DO_GC((((W_)(n))<<9)|((reenter)<<8)|(liveness)); \
     DO_GC((((W_)(n))<<9)|((reenter)<<8)|(liveness)); \
-    SET_ACTIVITY(ACT_GC_STOP);                 \
     } while (0)
 
 #define REQSIZE_BITMASK        ((1L << ((BITS_IN(W_) - 9 + 1))) - 1)
     } while (0)
 
 #define REQSIZE_BITMASK        ((1L << ((BITS_IN(W_) - 9 + 1))) - 1)
@@ -357,13 +343,10 @@ do {                                                      \
        /* THREAD_CONTEXT_SWITCH(liveness_mask,reenter); */             \
        ALLOC_HEAP(n); /* ticky profiling */                    \
         GRAN_ALLOC_HEAP(n,liveness_mask); /* Granularity Simulation */ \
        /* THREAD_CONTEXT_SWITCH(liveness_mask,reenter); */             \
        ALLOC_HEAP(n); /* ticky profiling */                    \
         GRAN_ALLOC_HEAP(n,liveness_mask); /* Granularity Simulation */ \
-       SET_ACTIVITY(ACT_HEAP_CHK); /* SPAT counting */         \
        if (((Hp = Hp + (n)) > HpLim)) {                        \
            /* Old:  STGCALL3_GC(PerformGC,liveness_mask,n,StgFalse); */\
            HEAP_OVERFLOW(liveness_mask,n,StgFalse); \
        if (((Hp = Hp + (n)) > HpLim)) {                        \
            /* Old:  STGCALL3_GC(PerformGC,liveness_mask,n,StgFalse); */\
            HEAP_OVERFLOW(liveness_mask,n,StgFalse); \
-       }                                                       \
-       SET_ACTIVITY(ACT_REDN); /* back to normal reduction */  \
-       }while(0)
+       }}while(0)
 
 #else
 
 
 #else
 
@@ -372,7 +355,6 @@ do {                                                        \
   /* TICKY_PARANOIA(__FILE__, __LINE__); */            \
   PRE_FETCH(n);                                                \
   ALLOC_HEAP(n); /* ticky profiling */                 \
   /* TICKY_PARANOIA(__FILE__, __LINE__); */            \
   PRE_FETCH(n);                                                \
   ALLOC_HEAP(n); /* ticky profiling */                 \
-  SET_ACTIVITY(ACT_HEAP_CHK); /* SPAT counting */      \
   if (((Hp = Hp + (n)) > HpLim) OR_INTERVAL_EXPIRED OR_CONTEXT_SWITCH OR_MSG_PENDING) {        \
     HEAP_OVERFLOW(liveness_mask,n,reenter);            \
   }                                                    \
   if (((Hp = Hp + (n)) > HpLim) OR_INTERVAL_EXPIRED OR_CONTEXT_SWITCH OR_MSG_PENDING) {        \
     HEAP_OVERFLOW(liveness_mask,n,reenter);            \
   }                                                    \
@@ -387,13 +369,10 @@ do {                                                      \
   /* TICKY_PARANOIA(__FILE__, __LINE__); */            \
   PRE_FETCH(n);                                                \
   ALLOC_HEAP(n); /* ticky profiling */                 \
   /* TICKY_PARANOIA(__FILE__, __LINE__); */            \
   PRE_FETCH(n);                                                \
   ALLOC_HEAP(n); /* ticky profiling */                 \
-  SET_ACTIVITY(ACT_HEAP_CHK); /* SPAT counting */      \
   if (((Hp = Hp + (n)) > HpLim) OR_INTERVAL_EXPIRED OR_CONTEXT_SWITCH OR_MSG_PENDING) {        \
     HEAP_OVERFLOW(liveness_mask,n,reenter);            \
     n = TSO_ARG1(CurrentTSO);                          \
   if (((Hp = Hp + (n)) > HpLim) OR_INTERVAL_EXPIRED OR_CONTEXT_SWITCH OR_MSG_PENDING) {        \
     HEAP_OVERFLOW(liveness_mask,n,reenter);            \
     n = TSO_ARG1(CurrentTSO);                          \
-  }                                                    \
-  SET_ACTIVITY(ACT_REDN); /* back to normal reduction */\
-} while(0)
+  }} while(0)
 
 #else
 
 
 #else
 
@@ -746,13 +725,11 @@ threaded land.
        UN_ALLOC_HEAP(n);       /* Undo ticky-ticky */  \
        SAVE_Hp = Hp;           /* Hand over the hp */  \
        DEBUG_SetGMPAllocBudget(n)                      \
        UN_ALLOC_HEAP(n);       /* Undo ticky-ticky */  \
        SAVE_Hp = Hp;           /* Hand over the hp */  \
        DEBUG_SetGMPAllocBudget(n)                      \
-       OptSaveHpLimRegister()                          \
        }while(0)
 
 #define GMP_HEAP_HANDBACK()                            \
        Hp = SAVE_Hp;                                   \
        }while(0)
 
 #define GMP_HEAP_HANDBACK()                            \
        Hp = SAVE_Hp;                                   \
-       DEBUG_ResetGMPAllocBudget()                     \
-       OptRestoreHpLimRegister()
+       DEBUG_ResetGMPAllocBudget()
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
@@ -770,22 +747,6 @@ extern StgInt DEBUG_GMPAllocBudget;
 #endif
 \end{code}
 
 #endif
 \end{code}
 
-\begin{code}
-#if defined (LIFE_PROFILE)
-
-#define OptSaveHpLimRegister() \
-       SAVE_HpLim = HpLim
-#define OptRestoreHpLimRegister() \
-       HpLim = SAVE_HpLim
-
-#else  /* ! LIFE_PROFILE */
-
-#define OptSaveHpLimRegister()     /* nothing */
-#define OptRestoreHpLimRegister()   /* nothing */
-
-#endif /* ! LIFE_PROFILE */
-\end{code}
-
 The real business (defining Integer primops):
 \begin{code}
 #define negateIntegerZh(ar,sr,dr, liveness, aa,sa,da) \
 The real business (defining Integer primops):
 \begin{code}
 #define negateIntegerZh(ar,sr,dr, liveness, aa,sa,da) \
@@ -928,18 +889,16 @@ Some floating-point format info, made with the \tr{enquire} program
  || alpha_TARGET_ARCH  \
  || hppa1_1_TARGET_ARCH        \
  || i386_TARGET_ARCH   \
  || alpha_TARGET_ARCH  \
  || hppa1_1_TARGET_ARCH        \
  || i386_TARGET_ARCH   \
- || i486_TARGET_ARCH   \
  || m68k_TARGET_ARCH   \
  || mipsel_TARGET_ARCH \
  || mipseb_TARGET_ARCH \
  || m68k_TARGET_ARCH   \
  || mipsel_TARGET_ARCH \
  || mipseb_TARGET_ARCH \
- || rs6000_TARGET_ARCH
+ || powerpc_TARGET_ARCH
 
 /* yes, it is IEEE floating point */
 #include "ieee-flpt.h"
 
 #if alpha_dec_osf1_TARGET      \
  || i386_TARGET_ARCH           \
 
 /* yes, it is IEEE floating point */
 #include "ieee-flpt.h"
 
 #if alpha_dec_osf1_TARGET      \
  || i386_TARGET_ARCH           \
- || i486_TARGET_ARCH           \
  || mipsel_TARGET_ARCH
 
 #undef BIGENDIAN /* little-endian weirdos... */
  || mipsel_TARGET_ARCH
 
 #undef BIGENDIAN /* little-endian weirdos... */
@@ -1037,7 +996,6 @@ which uses these anyway.)
 \begin{code}
 #if alpha_TARGET_ARCH  \
  || i386_TARGET_ARCH   \
 \begin{code}
 #if alpha_TARGET_ARCH  \
  || i386_TARGET_ARCH   \
- || i486_TARGET_ARCH   \
  || m68k_TARGET_ARCH
 
 #define ASSIGN_FLT(dst, src) *(StgFloat *)(dst) = (src);
  || m68k_TARGET_ARCH
 
 #define ASSIGN_FLT(dst, src) *(StgFloat *)(dst) = (src);
@@ -1183,13 +1141,16 @@ extern I_ byteArrayHasNUL__ PROTO((const char *, I_));
 
 OK, the easy ops first: (all except \tr{newArr*}:
 
 
 OK, the easy ops first: (all except \tr{newArr*}:
 
-VERY IMPORTANT!         The read/write/index primitive ops
+(OLD:) VERY IMPORTANT! The read/write/index primitive ops
 on @ByteArray#@s index the array using a {\em BYTE} offset, even
 if the thing begin gotten out is a multi-byte @Int#@, @Float#@ etc.
 This is because you might be trying to take apart a C struct, where
 the offset from the start of the struct isn't a multiple of the
 size of the thing you're getting.  Hence the @(char *)@ casts.
 
 on @ByteArray#@s index the array using a {\em BYTE} offset, even
 if the thing begin gotten out is a multi-byte @Int#@, @Float#@ etc.
 This is because you might be trying to take apart a C struct, where
 the offset from the start of the struct isn't a multiple of the
 size of the thing you're getting.  Hence the @(char *)@ casts.
 
+EVEN MORE IMPORTANT! The above is a lie.  The offsets for BlahArrays
+are in Blahs.  WDP 95/08
+
 In the case of messing with @StgAddrs@ (@A_@), which are really \tr{void *},
 we cast to @P_@, because you can't index off an uncast \tr{void *}.
 
 In the case of messing with @StgAddrs@ (@A_@), which are really \tr{void *},
 we cast to @P_@, because you can't index off an uncast \tr{void *}.
 
@@ -1318,7 +1279,6 @@ void newArrZh_init PROTO((P_ result, I_ n, P_ init));
   for (p = result+MUTUPLE_HS; p < (result+MUTUPLE_HS+(n)); p++) { \
        *p = (W_) (init);                               \
   }                                                    \
   for (p = result+MUTUPLE_HS; p < (result+MUTUPLE_HS+(n)); p++) { \
        *p = (W_) (init);                               \
   }                                                    \
-  SET_ACTIVITY(ACT_REDN); /* back to normal reduction */\
                                                        \
   r = result;                                          \
 }
                                                        \
   r = result;                                          \
 }
@@ -1694,6 +1654,7 @@ void blockUserSignals(STG_NO_ARGS);
 void unblockUserSignals(STG_NO_ARGS);
 IF_RTS(void blockVtAlrmSignal(STG_NO_ARGS);)
 IF_RTS(void unblockVtAlrmSignal(STG_NO_ARGS);)
 void unblockUserSignals(STG_NO_ARGS);
 IF_RTS(void blockVtAlrmSignal(STG_NO_ARGS);)
 IF_RTS(void unblockVtAlrmSignal(STG_NO_ARGS);)
+IF_RTS(void AwaitEvent(I_ delta);)
 
 #ifdef _POSIX_SOURCE
 extern I_ sig_install PROTO((I_, I_, sigset_t *));
 
 #ifdef _POSIX_SOURCE
 extern I_ sig_install PROTO((I_, I_, sigset_t *));
@@ -1775,8 +1736,6 @@ IF_RTS(I_ catchSoftHeapOverflow   PROTO((StgStablePtr, I_));)
 IF_RTS(I_ getSoftHeapOverflowHandler(STG_NO_ARGS);)
 IF_RTS(extern StgStablePtr softHeapOverflowHandler;)
 IF_RTS(void shutdownHaskell(STG_NO_ARGS);)
 IF_RTS(I_ getSoftHeapOverflowHandler(STG_NO_ARGS);)
 IF_RTS(extern StgStablePtr softHeapOverflowHandler;)
 IF_RTS(void shutdownHaskell(STG_NO_ARGS);)
-IF_RTS(extern I_ noBlackHoles;)
-IF_RTS(extern I_ SM_word_stk_size;)
 
 EXTFUN(stopPerformIODirectReturn);
 EXTFUN(startPerformIO);
 
 EXTFUN(stopPerformIODirectReturn);
 EXTFUN(startPerformIO);
@@ -1989,9 +1948,12 @@ extern I_ required_thread_count;
   if (SHOULD_SPARK(node) &&                            \
    PendingSparksTl[ADVISORY_POOL] < PendingSparksLim[ADVISORY_POOL]) { \
     *PendingSparksTl[ADVISORY_POOL]++ = (P_)(node);    \
   if (SHOULD_SPARK(node) &&                            \
    PendingSparksTl[ADVISORY_POOL] < PendingSparksLim[ADVISORY_POOL]) { \
     *PendingSparksTl[ADVISORY_POOL]++ = (P_)(node);    \
-  } else if (DO_QP_PROF) {                             \
-    I_ tid = threadId++;                               \
-    SAFESTGCALL2(void,(I_, P_),QP_Event0,tid,node);    \
+  } else {                                             \
+    sparksIgnored++;                                   \
+    if (DO_QP_PROF) {                                  \
+      I_ tid = threadId++;                             \
+      SAFESTGCALL2(void,(I_, P_),QP_Event0,tid,node);  \
+    }                                                  \
   }                                                    \
   r = 1; /* Should not be necessary */                 \
 }
   }                                                    \
   r = 1; /* Should not be necessary */                 \
 }
@@ -2051,7 +2013,7 @@ be a register) to point to the fresh heap object.
 Question: what's this "SET_ACTIVITY" stuff - should I be doing this
 too?  (It's if you want to use the SPAT profiling tools to
 characterize program behavior by ``activity'' -- tail-calling,
 Question: what's this "SET_ACTIVITY" stuff - should I be doing this
 too?  (It's if you want to use the SPAT profiling tools to
 characterize program behavior by ``activity'' -- tail-calling,
-heap-checking, etc. -- see RednCounts.lh.  It is quite specialized.
+heap-checking, etc. -- see Ticky.lh.  It is quite specialized.
 WDP 95/1)
 
 \begin{code}
 WDP 95/1)
 
 \begin{code}
index 5cb6c85..31e2ce7 100644 (file)
@@ -25,7 +25,11 @@ EXTDATA_RO(vtbl_StdUpdFrame);
 
 /* Keep -Wmissing-prototypes from complaining */
 void SaveAllStgRegs(STG_NO_ARGS);
 
 /* Keep -Wmissing-prototypes from complaining */
 void SaveAllStgRegs(STG_NO_ARGS);
+#if i386_TARGET_ARCH
+void SaveAllStgContext(void * /*return address*/);
+#else
 void SaveAllStgContext(STG_NO_ARGS);
 void SaveAllStgContext(STG_NO_ARGS);
+#endif
 void SaveStgStackRegs(STG_NO_ARGS);
 void RestoreAllStgRegs(STG_NO_ARGS);
 void RestoreStackStgRegs(STG_NO_ARGS);
 void SaveStgStackRegs(STG_NO_ARGS);
 void RestoreAllStgRegs(STG_NO_ARGS);
 void RestoreStackStgRegs(STG_NO_ARGS);
@@ -33,6 +37,15 @@ void RestoreStackStgRegs(STG_NO_ARGS);
 extern STG_INLINE 
 void SaveAllStgRegs(STG_NO_ARGS)
 {
 extern STG_INLINE 
 void SaveAllStgRegs(STG_NO_ARGS)
 {
+#ifdef REG_Base
+# ifdef CONCURRENT
+    /* I do not think so: CurrentRegTable will not have changed
+       between entry to and exit from "Haskell land" (WDP 95/12)
+    */
+    /* CurrentRegTable = BaseReg; */
+# endif
+#endif
+
 #ifdef REG_R1
     SAVE_R1 = R1;      
 #endif
 #ifdef REG_R1
     SAVE_R1 = R1;      
 #endif
@@ -115,22 +128,27 @@ void SaveAllStgRegs(STG_NO_ARGS)
 
     SAVE_Hp    = Hp;   /* always! */
     SAVE_HpLim = HpLim; /* ditto! */
 
     SAVE_Hp    = Hp;   /* always! */
     SAVE_HpLim = HpLim; /* ditto! */
-
-#if defined(DO_INSTR_COUNTING)
-#ifdef REG_Activity
-    SAVE_Activity = ActivityReg;
-#endif
-#endif
 }
 
 extern STG_INLINE
 }
 
 extern STG_INLINE
-void SaveAllStgContext(STG_NO_ARGS)
+void
+#if i386_TARGET_ARCH
+SaveAllStgContext(void * ret_addr)
+#else
+SaveAllStgContext(STG_NO_ARGS)
+#endif
 {
     SaveAllStgRegs(); 
 #ifdef CONCURRENT
 {
     SaveAllStgRegs(); 
 #ifdef CONCURRENT
+# ifdef PAR
     TSO_CCC(CurrentTSO) = CCC;
     CCC = (CostCentre)STATIC_CC_REF(CC_MAIN);
     TSO_CCC(CurrentTSO) = CCC;
     CCC = (CostCentre)STATIC_CC_REF(CC_MAIN);
+# endif
+# if i386_TARGET_ARCH
+    SET_RETADDR(TSO_PC2(CurrentTSO), ret_addr)
+# else
     SET_RETADDR(TSO_PC2(CurrentTSO))
     SET_RETADDR(TSO_PC2(CurrentTSO))
+# endif
 #endif
 }
 
 #endif
 }
 
@@ -159,7 +177,11 @@ RestoreAllStgRegs (STG_NO_ARGS)
 {
 #ifdef REG_Base
     /* Re-initialise the register table pointer */
 {
 #ifdef REG_Base
     /* Re-initialise the register table pointer */
+# ifdef CONCURRENT
+    BaseReg = CurrentRegTable;
+# else 
     BaseReg = &MainRegTable;
     BaseReg = &MainRegTable;
+# endif
 #endif
 
 #ifdef REG_R1
 #endif
 
 #ifdef REG_R1
@@ -257,11 +279,7 @@ RestoreAllStgRegs (STG_NO_ARGS)
     StkStubReg = STK_STUB_closure;
 #endif
 
     StkStubReg = STK_STUB_closure;
 #endif
 
-#if defined(DO_INSTR_COUNTING) && defined(REG_Activity)
-    ActivityReg = SAVE_Activity;
-#endif
-
-#ifdef CONCURRENT
+#ifdef PAR
     CCC = TSO_CCC(CurrentTSO);
 #endif
 }
     CCC = TSO_CCC(CurrentTSO);
 #endif
 }
index 776000f..9a8dda1 100644 (file)
@@ -237,7 +237,7 @@ Also include the RTS types for the runtime system modules.
 
 \begin{code}
 
 
 \begin{code}
 
-#include "rtsTypes.h"
+#include "RtsTypes.h"
 
 #endif /* ! STGTYPES_H */
 \end{code}
 
 #endif /* ! STGTYPES_H */
 \end{code}
index f08ab9b..7236d7d 100644 (file)
@@ -27,8 +27,6 @@
 
 #else
 
 
 #else
 
-#define        DEFAULT_MAX_THREADS             (32)
-
 extern I_ do_gr_sim;                           /* Are we simulating granularity? */
 extern FILE *gr_file;
 
 extern I_ do_gr_sim;                           /* Are we simulating granularity? */
 extern FILE *gr_file;
 
@@ -41,16 +39,10 @@ extern FILE *qp_file;
 #define DO_QP_PROF do_qp_prof
 #endif
 
 #define DO_QP_PROF do_qp_prof
 #endif
 
-extern I_ MaxThreads;
-
 extern I_ context_switch;                      /* Flag set by signal handler */
 extern I_ context_switch;                      /* Flag set by signal handler */
-extern I_ contextSwitchTime;
-#if defined(USE_COST_CENTRES) || defined(GUM)
-extern I_ contextSwitchTicks;
-#endif
 
 
-#define CS_MAX_FREQUENCY       100                     /* context switches per second */
-#define CS_MIN_MILLISECS       (1000/CS_MAX_FREQUENCY) /* milliseconds per slice */
+#define CS_MAX_FREQUENCY 100                   /* context switches per second */
+#define CS_MIN_MILLISECS (1000/CS_MAX_FREQUENCY)/* milliseconds per slice */
 
 #ifdef __STG_GCC_REGS__
 #define OR_CONTEXT_SWITCH || context_switch
 
 #ifdef __STG_GCC_REGS__
 #define OR_CONTEXT_SWITCH || context_switch
@@ -72,9 +64,7 @@ extern I_ SparkLimit[SPARK_POOLS];
 extern P_ RunnableThreadsHd, RunnableThreadsTl;
 extern P_ WaitingThreadsHd, WaitingThreadsTl;
 
 extern P_ RunnableThreadsHd, RunnableThreadsTl;
 extern P_ WaitingThreadsHd, WaitingThreadsTl;
 
-#define DEFAULT_MAX_LOCAL_SPARKS 100
-
-extern I_ MaxLocalSparks;
+extern I_ sparksIgnored;
 
 IF_RTS(extern void AwaitEvent(I_);)
 
 
 IF_RTS(extern void AwaitEvent(I_);)
 
@@ -181,8 +171,6 @@ extern I_ PrintFetchMisses, fetch_misses;
 extern I_ nUPDs, nUPDs_old, nUPDs_new, nUPDs_BQ, nPAPs, BQ_lens;
 #endif
 
 extern I_ nUPDs, nUPDs_old, nUPDs_new, nUPDs_BQ, nPAPs, BQ_lens;
 #endif
 
-extern I_ do_gr_binary;
-extern I_ do_gr_profile;
 extern I_ no_gr_profile;
 extern I_ do_sp_profile;
 
 extern I_ no_gr_profile;
 extern I_ do_sp_profile;
 
@@ -193,7 +181,7 @@ extern void GranSimUnAllocate              PROTO((I_, P_, W_));
 extern I_   GranSimFetch                   PROTO((P_));
 extern void GranSimExec                    PROTO((W_,W_,W_,W_,W_));
 extern void GranSimSpark                   PROTO((W_,P_));
 extern I_   GranSimFetch                   PROTO((P_));
 extern void GranSimExec                    PROTO((W_,W_,W_,W_,W_));
 extern void GranSimSpark                   PROTO((W_,P_));
-extern void GranSimBlock                   PROTO(());
+extern void GranSimBlock                   (STG_NO_ARGS);
 extern void PerformReschedule              PROTO((W_, W_));
 
 #if 0   /* 'ngo Dochmey */
 extern void PerformReschedule              PROTO((W_, W_));
 
 #if 0   /* 'ngo Dochmey */
@@ -336,7 +324,7 @@ table for those values).
 \begin{code}
 #define TSO_INFO_WORDS 10
 
 \begin{code}
 #define TSO_INFO_WORDS 10
 
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
 #define TSO_REDN_WORDS 2
 #else
 #define TSO_REDN_WORDS 0
 #define TSO_REDN_WORDS 2
 #else
 #define TSO_REDN_WORDS 0
@@ -375,7 +363,7 @@ table for those values).
 #define TSO_SWITCH_LOCN                (TSO_INFO_START + 9)
 
 #define TSO_REDN_START         (TSO_INFO_START + TSO_INFO_WORDS)
 #define TSO_SWITCH_LOCN                (TSO_INFO_START + 9)
 
 #define TSO_REDN_START         (TSO_INFO_START + TSO_INFO_WORDS)
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
 #define TSO_AHWM_LOCN          (TSO_REDN_START + 0)
 #define TSO_BHWM_LOCN          (TSO_REDN_START + 1)
 #endif
 #define TSO_AHWM_LOCN          (TSO_REDN_START + 0)
 #define TSO_BHWM_LOCN          (TSO_REDN_START + 1)
 #endif
@@ -454,7 +442,7 @@ The types of threads (TSO_TYPE):
 The total space required to start a new thread (See NewThread in
 Threads.lc):
 \begin{code}
 The total space required to start a new thread (See NewThread in
 Threads.lc):
 \begin{code}
-#define THREAD_SPACE_REQUIRED (TSO_HS + TSO_CTS_SIZE + STKO_HS + StkOChunkSize)
+#define THREAD_SPACE_REQUIRED (TSO_HS + TSO_CTS_SIZE + STKO_HS + RTSflags.ConcFlags.stkChunkSize)
 \end{code}
 
 Here are the various queues for GrAnSim-type events.
 \end{code}
 
 Here are the various queues for GrAnSim-type events.
@@ -472,14 +460,14 @@ Here are the various queues for GrAnSim-type events.
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-#ifdef GUM
+#ifdef PAR
 
 P_ FindLocalSpark PROTO((rtsBool forexport));
 
 void DisposeSpark PROTO((P_ spark));
 rtsBool Spark PROTO((P_ closure, rtsBool required));
 
 
 P_ FindLocalSpark PROTO((rtsBool forexport));
 
 void DisposeSpark PROTO((P_ spark));
 rtsBool Spark PROTO((P_ closure, rtsBool required));
 
-#endif /*GUM*/
+#endif /*PAR*/
 
 #ifdef GRAN   /* For GrAnSim sparks are currently mallocated -- HWL */
 
 
 #ifdef GRAN   /* For GrAnSim sparks are currently mallocated -- HWL */
 
@@ -559,19 +547,15 @@ From a storage-manager point of view, these are {\em very special}
 objects.
 
 \begin{code}
 objects.
 
 \begin{code}
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
 #define STKO_VHS       (GC_MUT_RESERVED_WORDS + 9)
 #else
 #define STKO_VHS       (GC_MUT_RESERVED_WORDS + 7)
 #endif
 #define STKO_HS                (FIXED_HS + STKO_VHS)
 
 #define STKO_VHS       (GC_MUT_RESERVED_WORDS + 9)
 #else
 #define STKO_VHS       (GC_MUT_RESERVED_WORDS + 7)
 #endif
 #define STKO_HS                (FIXED_HS + STKO_VHS)
 
-#define DEFAULT_STKO_CHUNK_SIZE        1024
-
 #define MIN_STKO_CHUNK_SIZE 16 /* Rather arbitrary */
 
 #define MIN_STKO_CHUNK_SIZE 16 /* Rather arbitrary */
 
-extern I_ StkOChunkSize;
-
 #define STKO_CLOSURE_SIZE(closure)     STKO_SIZE(closure)
 
 #define STKO_CLOSURE_CTS_SIZE(closure) (STKO_CLOSURE_SIZE(closure) - STKO_VHS)
 #define STKO_CLOSURE_SIZE(closure)     STKO_SIZE(closure)
 
 #define STKO_CLOSURE_CTS_SIZE(closure) (STKO_CLOSURE_SIZE(closure) - STKO_VHS)
@@ -594,7 +578,7 @@ extern I_ StkOChunkSize;
          to debug things.
  */
 
          to debug things.
  */
 
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
 #define STKO_ADEP_LOCN      (STKO_HS - 9)
 #define STKO_BDEP_LOCN      (STKO_HS - 8)
 #endif
 #define STKO_ADEP_LOCN      (STKO_HS - 9)
 #define STKO_BDEP_LOCN      (STKO_HS - 8)
 #endif
@@ -762,7 +746,7 @@ The special info table used for stack objects (STKOs).
        INCLUDE_TYPE_INFO(STKO_STATIC)                          \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
        INCLUDE_PAR_INFO                                        \
        INCLUDE_TYPE_INFO(STKO_STATIC)                          \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
        INCLUDE_PAR_INFO                                        \
-       INCLUDE_COPYING_INFO(_Evacuate_Static,_Scavenge_Static) \
+       INCLUDE_COPYING_INFO(_Evacuate_Static,_Dummy_Static_entry) \
        INCLUDE_COMPACTING_INFO(_Dummy_Static_entry,_PRStart_Static, \
                                _Dummy_Static_entry,_PRIn_Error)    \
     }
        INCLUDE_COMPACTING_INFO(_Dummy_Static_entry,_PRStart_Static, \
                                _Dummy_Static_entry,_PRIn_Error)    \
     }
similarity index 71%
rename from ghc/includes/RednCounts.lh
rename to ghc/includes/Ticky.lh
index c2a1fef..fecee0a 100644 (file)
 %
 %************************************************************************
 %*                                                                     *
 %
 %************************************************************************
 %*                                                                     *
-\section[RednCounts.lh]{Interface (and macros) for reduction-count statistics}
+\section[Ticky.lh]{Interface (and macros) for reduction-count statistics}
 %*                                                                     *
 %************************************************************************
 
 Multi-slurp protection:
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 Multi-slurp protection:
 \begin{code}
-#ifndef REDNCOUNTS_H
-#define REDNCOUNTS_H
+#ifndef TICKY_H
+#define TICKY_H
 \end{code}
 
 There are macros in here for:
 \begin{enumerate}
 \item
 \end{code}
 
 There are macros in here for:
 \begin{enumerate}
 \item
-``SPAT-profiling'' (\tr{DO_SPAT_PROFILING}), counting instructions
-per ``activity,'' using the SPAT instruction-trace analysis tools.
-\item
-``Ticky-ticky profiling'' (\tr{DO_REDN_COUNTING}), counting the
+``Ticky-ticky profiling'' (\tr{TICKY_TICKY}), counting the
 number of various STG-events (updates, enters, etc.)
 
 number of various STG-events (updates, enters, etc.)
 
-This file goes with \tr{RednCounts.lc}, which initialises the counters
+This file goes with \tr{Ticky.lc}, which initialises the counters
 and does the printing [ticky-ticky only].
 
 %************************************************************************
 %*                                                                     *
 and does the printing [ticky-ticky only].
 
 %************************************************************************
 %*                                                                     *
-\subsection[SPAT-macros]{Macros for SPAT instruction counting}
+\subsection{Macros for using the `ticky' field in the fixed header}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-These definitions are for instruction tracing, e.g. using SPAT on the
-SPARC.
+\begin{code}
+#define TICKY_FIXED_HDR                        (TICKY_HDR_SIZE)
+#define TICKY_HDR_POSN                 AFTER_PROF_HDR
+#define AFTER_TICKY_HDR                        (TICKY_FIXED_HDR+TICKY_HDR_POSN)
+\end{code}
 
 \begin{code}
 
 \begin{code}
-#ifdef DO_SPAT_PROFILING
-
-#define ACT_BASE               0x000000ab /* random; to fit in 13 bits */
-
-#define        ACT_UNKNOWN             (0+ACT_BASE)
-#define        ACT_GC                  (1+ACT_BASE)
-#define        ACT_REDN                (2+ACT_BASE)
-#define        ACT_ASTK_STUB           (3+ACT_BASE)
-#define        ACT_FILL_IN_HEAP        (4+ACT_BASE)
-#define        ACT_HEAP_CHK            (5+ACT_BASE)
-#define ACT_RETURN             (6+ACT_BASE)
-#define        ACT_UPDATE              (7+ACT_BASE)
-#define        ACT_PUSH_UPDF           (8+ACT_BASE)
-#define ACT_ARGS_CHK           (9+ACT_BASE)
-#define ACT_UPDATE_PAP         (10+ACT_BASE)
-#define ACT_INDIRECT           (11+ACT_BASE)
-#define ACT_PRIM               (12+ACT_BASE)
-
-#define ACT_OVERHEAD           (14+ACT_BASE) /* only used in analyser */
-#define ACT_TAILCALL           (15+ACT_BASE)
-       /* Note: quite a lot gets lumped under TAILCALL; the analyser
-          untangles it with other info. WDP 95/01
-       */
-
-#define ACTIVITIES             16
-
-#define ACT_GC_STOP            (ACTIVITIES+1)
-#define ACT_PRIM_STOP          (ACTIVITIES+2)
-
-/* values that "signal" the start/stop of something,
-   thus suggesting to the analyser that it stop/start something.
-
-   I do not think they are used (WDP 95/01)
-*/
+#ifndef TICKY_TICKY
 
 
-#define ACT_SIGNAL_BASE                0xbababa00 /* pretty random; yes */
-
-#define ACT_START_GOING                (1+ACT_SIGNAL_BASE)
-#define ACT_STOP_GOING         (2+ACT_SIGNAL_BASE)
-#define ACT_START_GC           (3+ACT_SIGNAL_BASE)
-#define ACT_STOP_GC            (4+ACT_SIGNAL_BASE)
-
-#define SET_ACTIVITY(act)      do { /* ActivityReg = (act) */          \
-                               __asm__ volatile ("or %%g0,%1,%0"       \
-                               : "=r" (ActivityReg)                    \
-                               : "I" (act));                           \
-                               } while(0)
-
-#define ALLOC_HEAP(n)          /* nothing */
-#define UN_ALLOC_HEAP(n)       /* nothing */
-#define DO_ASTK_HWM()          /* nothing */
-#define DO_BSTK_HWM()          /* nothing */
-
-#define A_STK_STUB(n)          /* nothing */
-#define A_STK_REUSE(n)         /* not used at all */
-#define B_STK_REUSE(n)         /* ditto */
-
-#define ALLOC_FUN(a,g,s,t)     SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_THK(a,g,s,t)     SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_CON(a,g,s,t)     SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_TUP(a,g,s,t)     SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_BH(a,g,s,t)      SET_ACTIVITY(ACT_FILL_IN_HEAP)
-/*#define ALLOC_PAP(a,g,s,t)   SET_ACTIVITY(ACT_FILL_IN_HEAP)*/
-#define ALLOC_UPD_PAP(a,g,s,t)         SET_ACTIVITY(ACT_UPDATE_PAP) /* NB */
-/*#define ALLOC_UPD_CON(a,g,s,t) SET_ACTIVITY(ACT_FILL_IN_HEAP) */
-#define ALLOC_PRIM(a,g,s,t)    SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_PRIM2(w)         SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_STK(a,g,s)       SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_TSO(a,g,s)       SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_FMBQ(a,g,s)      SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_FME(a,g,s)       SET_ACTIVITY(ACT_FILL_IN_HEAP)
-#define ALLOC_BF(a,g,s)        SET_ACTIVITY(ACT_FILL_IN_HEAP)
-
-/* we only use the ENT_ macros to be sure activity is set to "reduction" */
-#define ENT_VIA_NODE()         /* nothing */
-#define ENT_THK()              SET_ACTIVITY(ACT_REDN)
-#define ENT_FUN_STD()          SET_ACTIVITY(ACT_REDN)
-#define ENT_FUN_DIRECT(f,f_str,f_arity,Aargs,Bargs,arg_kinds,wrap,wrap_kinds) \
-                               SET_ACTIVITY(ACT_REDN)
-#define ENT_CON(n)             SET_ACTIVITY(ACT_REDN)
-#define ENT_IND(n)             SET_ACTIVITY(ACT_REDN)
-#define ENT_PAP(n)             SET_ACTIVITY(ACT_UPDATE_PAP) /* NB */
-
-#define RET_NEW_IN_HEAP()      SET_ACTIVITY(ACT_RETURN)
-#define RET_NEW_IN_REGS()      SET_ACTIVITY(ACT_RETURN)
-#define RET_OLD_IN_HEAP()      SET_ACTIVITY(ACT_RETURN)
-#define RET_OLD_IN_REGS()      SET_ACTIVITY(ACT_RETURN)
-#define RET_SEMI_BY_DEFAULT()  SET_ACTIVITY(ACT_RETURN)
-#define RET_SEMI_IN_HEAP()     SET_ACTIVITY(ACT_RETURN)
-#define RET_SEMI_IN_REGS()     SET_ACTIVITY(ACT_RETURN)
-#define VEC_RETURN()           /* nothing */
-
-#define UPDF_OMITTED()         /* nothing (set directly by PUSH_STD_UPD_FRAME) */
-#define UPDF_STD_PUSHED()      SET_ACTIVITY(ACT_PUSH_UPDF)
-#define UPDF_CON_PUSHED()      /* nothing */
-#define UPDF_HOLE_PUSHED()     /* nothing */
-#define UPDF_RCC_PUSHED()      /* nothing */
-#define UPDF_RCC_OMITTED()     /* nothing */
+#define TICKY_HDR_SIZE                 0
+#define TICKY_HDR(closure)
+#define SET_TICKY_HDR(closure,to)
+#define        SET_STATIC_TICKY_HDR()
+
+#else
+
+#define TICKY_HDR_SIZE                 1
+#define TICKY_HDR(closure)     (((P_)(closure))[TICKY_HDR_POSN])
+#define SET_TICKY_HDR(closure,to) TICKY_HDR(closure) = (to)
+#define        SET_STATIC_TICKY_HDR()  ,0
 
 
-#define UPD_EXISTING()         /* nothing -- used in .lc code */
-#define UPD_CON_W_NODE()       SET_ACTIVITY(ACT_UPDATE)
-#define UPD_CON_IN_PLACE()     SET_ACTIVITY(ACT_UPDATE)
-#define UPD_PAP_IN_PLACE()     /* nothing -- UpdatePAP has its own activity */
-#define UPD_CON_IN_NEW()       SET_ACTIVITY(ACT_UPDATE)
-#define UPD_PAP_IN_NEW()       /* nothing -- UpdatePAP has its own activity */
+#endif /* TICKY_TICKY */
 \end{code}
 
 \end{code}
 
-For special subsequent enter counting:
+Here, we add the Ticky word to the fixed-header part of closures.
+This is used to record indicate if a closure has been updated but not
+yet entered. It is set when the closure is updated and cleared when
+subsequently entered.
+
+NB: It is {\em not} an ``entry count'', it is an
+``entries-after-update count.''
+
+The commoning up of @CONST@, @CHARLIKE@ and @INTLIKE@ closures is
+turned off(?) if this is required. This has only been done for 2s
+collection.  It is done using a nasty hack which defines the
+@_Evacuate@ and @_Scavenge@ code for @CONST@, @CHARLIKE@ and @INTLIKE@
+info tables to be @_Evacuate_1@ and @_Scavenge_1_0@.
+
 \begin{code}
 \begin{code}
+#ifndef TICKY_TICKY
+
 #define UPDATED_SET_UPDATED(n)  /* nothing */
 #define ENTERED_CHECK_UPDATED(n) /* nothing */
 #define UPDATED_SET_UPDATED(n)  /* nothing */
 #define ENTERED_CHECK_UPDATED(n) /* nothing */
-\end{code}
 
 
-For a generational collector:
-\begin{code}
-#define UPD_NEW_IND()                  /* nothing (set elsewhere [?]) */
-#define UPD_NEW_IN_PLACE_PTRS()                /* nothing */
-#define UPD_NEW_IN_PLACE_NOPTRS()      /* nothing */
-#define UPD_OLD_IND()                  /* nothing */
-#define UPD_OLD_IN_PLACE_PTRS()                /* nothing */
-#define UPD_OLD_IN_PLACE_NOPTRS()      /* nothing */
+#else
+
+#define UPDATED_SET_UPDATED(n) do { TICKY_HDR(n) = 1; } while(0)
+
+#define ENT_UPD_HISTO(n)                                       \
+       do { I_ __idx;                                          \
+         __idx = (n) - 1;                                      \
+                                                               \
+         /* once 9th enter is recorded, we do not tick anymore;*/\
+         /* we want "TotUpdates - <all 9 cols>" to equal */    \
+         /* "updates that were never entered" */               \
+         if ( __idx <= 8 )                                     \
+            UPD_ENTERED_hst[__idx] += 1;                       \
+                                                               \
+         /* now undo tick in previous histo slot ... */        \
+         if ( __idx >= 1 && __idx <= 8 )                       \
+            UPD_ENTERED_hst[(__idx - 1)] -= 1;                 \
+       } while(0)
+
+#define ENTERED_CHECK_UPDATED(n)                               \
+       do {                                                    \
+       I_ t_hdr = TICKY_HDR(n);                                \
+                                                               \
+       if (t_hdr != 0 && AllFlags.doUpdEntryCounts) {          \
+           ENT_UPD_HISTO(t_hdr);                               \
+           TICKY_HDR(n) += 1;                                  \
+       }} while(0)
 
 
-#endif /* DO_SPAT_PROFILING */
+#endif /* TICKY_TICKY */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -167,9 +110,7 @@ For a generational collector:
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-#ifdef DO_REDN_COUNTING
-
-#define SET_ACTIVITY(act)      /* quickly: make this do NOTHING */
+#ifdef TICKY_TICKY
 \end{code}
 
 Measure what proportion of ...:
 \end{code}
 
 Measure what proportion of ...:
@@ -453,23 +394,48 @@ Then we need to report it along with the update-in-place info.
 \end{display}
 
 \begin{code}
 \end{display}
 
 \begin{code}
-#define RET_NEW_IN_HEAP()      RET_NEW_IN_HEAP_ctr++
-#define RET_OLD_IN_HEAP()      RET_OLD_IN_HEAP_ctr++
+#define RET_HISTO(categ,n,offset) \
+       { I_ __idx;                                              \
+         __idx = (n) - (offset);                                \
+        CAT3(RET_,categ,_hst)[((__idx > 8) ? 8 : __idx)] += 1;} 
 
 
-#define RET_NEW_IN_REGS()      RET_NEW_IN_REGS_ctr++; \
-                               ReturnInRegsNodeValid = 0
-#define RET_OLD_IN_REGS()      RET_OLD_IN_REGS_ctr++; \
-                               ReturnInRegsNodeValid = 1
+/* "slide" histogramming by (__STG_REGS_AVAIL__ - 1) -- usually 7 --
+   so we do not collect lots and lots of useless zeros for _IN_HEAP.
+   WDP 95/11
+*/
+#define RET_NEW_IN_HEAP(n)     RET_NEW_IN_HEAP_ctr++;      \
+                               RET_HISTO(NEW_IN_HEAP,n,__STG_REGS_AVAIL__ - 1)
+#define RET_OLD_IN_HEAP(n)     RET_OLD_IN_HEAP_ctr++;      \
+                               RET_HISTO(OLD_IN_HEAP,n,__STG_REGS_AVAIL__ - 1)
+#define RET_SEMI_IN_HEAP(n)    RET_SEMI_IN_HEAP_ctr++;     \
+                               RET_HISTO(SEMI_IN_HEAP,n,__STG_REGS_AVAIL__ - 1)
+
+#define RET_NEW_IN_REGS(n)     RET_NEW_IN_REGS_ctr++;      \
+                               ReturnInRegsNodeValid = 0;  \
+                               RET_HISTO(NEW_IN_REGS,n,0)
+#define RET_OLD_IN_REGS(n)     RET_OLD_IN_REGS_ctr++;      \
+                               ReturnInRegsNodeValid = 1;  \
+                               RET_HISTO(OLD_IN_REGS,n,0)
+#define RET_SEMI_IN_REGS(n,u)  RET_SEMI_IN_REGS_ctr++;     \
+                               RET_SEMI_loads_avoided += ((n) - (u)); \
+                               RET_HISTO(SEMI_IN_REGS,u,0)
+
+#define RET_SEMI_BY_DEFAULT()/*???*/   RET_SEMI_BY_DEFAULT_ctr++
+
+#define RET_SEMI_FAILED(tag)   do {                                    \
+                               if ((tag) == INFO_IND_TAG)              \
+                                   RET_SEMI_FAILED_IND_ctr++;          \
+                               else                                    \
+                                   RET_SEMI_FAILED_UNEVAL_ctr++;       \
+                               } while (0)
 
 
-#define RET_SEMI_BY_DEFAULT()  RET_SEMI_BY_DEFAULT_ctr++
-#define RET_SEMI_IN_HEAP()     RET_SEMI_IN_HEAP_ctr++
-#define RET_SEMI_IN_REGS()     RET_SEMI_IN_REGS_ctr++
 \end{code}
 
 Of all the returns (sum of four categories above), how many were
 vectored?  (The rest were obviously unvectored).
 \begin{code}
 \end{code}
 
 Of all the returns (sum of four categories above), how many were
 vectored?  (The rest were obviously unvectored).
 \begin{code}
-#define VEC_RETURN()           VEC_RETURN_ctr++
+#define VEC_RETURN(n)          VEC_RETURN_ctr++;           \
+                               RET_HISTO(VEC_RETURN,n,0)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -521,29 +487,37 @@ Macro                     &       Where                                           \\ \hline
                        &                                                       \\
 \tr{UPD_EXISTING}      &       Updating with an indirection to something       \\
                        &       already in the heap                             \\
                        &                                                       \\
 \tr{UPD_EXISTING}      &       Updating with an indirection to something       \\
                        &       already in the heap                             \\
-
+\tr{UPD_SQUEEZED}      &       Same as \tr{UPD_EXISTING} but because           \\
+                       &       of stack-squeezing                              \\
 \tr{UPD_CON_W_NODE}    &       Updating with a CON: by indirecting to Node     \\
 \tr{UPD_CON_W_NODE}    &       Updating with a CON: by indirecting to Node     \\
-
 \tr{UPD_CON_IN_PLACE}  &       Ditto, but in place                             \\
 \tr{UPD_CON_IN_NEW}    &       Ditto, but allocating the object                \\
 \tr{UPD_CON_IN_PLACE}  &       Ditto, but in place                             \\
 \tr{UPD_CON_IN_NEW}    &       Ditto, but allocating the object                \\
-
 \tr{UPD_PAP_IN_PLACE}  &       Same, but updating w/ a PAP                     \\
 \tr{UPD_PAP_IN_NEW}    &                                                       \\\hline
 \end{tabular}
 %partain:\end{center}
 
 \begin{code}
 \tr{UPD_PAP_IN_PLACE}  &       Same, but updating w/ a PAP                     \\
 \tr{UPD_PAP_IN_NEW}    &                                                       \\\hline
 \end{tabular}
 %partain:\end{center}
 
 \begin{code}
+#define UPD_HISTO(categ,n) \
+       { I_ __idx;                                              \
+         __idx = (n);                                           \
+        CAT3(UPD_,categ,_hst)[((__idx > 8) ? 8 : __idx)] += 1;} 
+
 #define UPD_EXISTING()         UPD_EXISTING_ctr++
 #define UPD_EXISTING()         UPD_EXISTING_ctr++
+#define UPD_SQUEEZED()         UPD_SQUEEZED_ctr++
 
 #define UPD_CON_W_NODE()       UPD_CON_W_NODE_ctr++
 
 
 #define UPD_CON_W_NODE()       UPD_CON_W_NODE_ctr++
 
-#define UPD_CON_IN_NEW()       UPD_CON_IN_NEW_ctr++
-#define UPD_PAP_IN_NEW()       UPD_PAP_IN_NEW_ctr++
+#define UPD_CON_IN_NEW(n)      UPD_CON_IN_NEW_ctr++ ; \
+                               UPD_HISTO(CON_IN_NEW,n)
+#define UPD_PAP_IN_NEW(n)      UPD_PAP_IN_NEW_ctr++ ; \
+                               UPD_HISTO(PAP_IN_NEW,n)
 /* ToDo: UPD_NEW_COPY_ctr, as below */
 
 /* ToDo: UPD_NEW_COPY_ctr, as below */
 
-#define UPD_CON_IN_PLACE()     UPD_CON_IN_PLACE_ctr++ ; \
-                               UPD_IN_PLACE_COPY_ctr += ReturnInRegsNodeValid
-                               /* increments if True; otherwise, no */
+#define UPD_CON_IN_PLACE(n)    UPD_CON_IN_PLACE_ctr++ ; \
+                               UPD_IN_PLACE_COPY_ctr += ReturnInRegsNodeValid ; \
+                               /* increments if True; otherwise, no */ \
+                               UPD_HISTO(CON_IN_PLACE,n)
 #define UPD_PAP_IN_PLACE()     UPD_PAP_IN_PLACE_ctr++ ; \
                                UPD_IN_PLACE_COPY_ctr += ReturnInRegsNodeValid
                                /* increments if True; otherwise, no */
 #define UPD_PAP_IN_PLACE()     UPD_PAP_IN_PLACE_ctr++ ; \
                                UPD_IN_PLACE_COPY_ctr += ReturnInRegsNodeValid
                                /* increments if True; otherwise, no */
@@ -561,49 +535,25 @@ For a generational collector:
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsubsection[ticky-updates-entered]{Updates Subsequently Entered}
+\subsubsection[ticky-selectors]{Doing selectors at GC time}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-If @UPDATES_ENTERED_COUNT@ is defined we add the Age word to the
-closures.  This is used to record indicate if a closure has been
-updated but not yet entered. It is set when the closure is updated and
-cleared when subsequently entered.
-
-The commoning up of @CONST@, @CHARLIKE@ and @INTLIKE@ closures is
-turned if this is required. This has only been done for 2s collection.
-It is done using a nasty hack which defines the @_Evacuate@ and
-@_Scavenge@ code for @CONST@, @CHARLIKE@ and @INTLIKE@ info tables to
-be @_Evacuate_1@ and @_Scavenge_1_0@.
-
-Unfortunately this broke everything so it has not been done ;-(.
-Instead we have to run with enough heap so no garbage collection is
-needed for accurate numbers. ToDo: Fix this!
-
-As implemented it can not be used in conjunction with heap profiling
-or lifetime profiling becasue they make conflicting use the Age word!
+@GC_SEL_ABANDONED@: we could've done the selection, but we gave up
+(e.g., to avoid overflowing the C stack); @GC_SEL_MINOR@: did a
+selection in a minor GC; @GC_SEL_MAJOR@: ditto, but major GC.
 
 \begin{code}
 
 \begin{code}
-#if defined(UPDATES_ENTERED_COUNT)
-
-#define UPDATED_SET_UPDATED(n) AGE_HDR(n) = 1
-
-#define ENTERED_CHECK_UPDATED(n)       \
-       if (AGE_HDR(n)) {               \
-           if (AGE_HDR(n) == 1) {      \
-               UPD_ENTERED_ctr++;      \
-               AGE_HDR(n) += 1;        \
-           } else {                    \
-               UPD_ENTERED_AGAIN_ctr++; \
-               AGE_HDR(n) = 0;         \
-       }}
-
-#else  /* ! UPDATES_ENTERED_COUNT */
-
-#define UPDATED_SET_UPDATED(n)  /* nothing */
-#define ENTERED_CHECK_UPDATED(n) /* nothing */
-
-#endif /* ! UPDATES_ENTERED_COUNT */
+#define GC_SEL_ABANDONED()             GC_SEL_ABANDONED_ctr++;
+#define GC_SEL_MINOR()                 GC_SEL_MINOR_ctr++;
+#define GC_SEL_MAJOR()                 GC_SEL_MAJOR_ctr++;
+
+#define GC_SHORT_IND()                 GC_SHORT_IND_ctr++;
+#define GC_SHORT_CAF()                 GC_SHORT_CAF_ctr++;
+#define GC_COMMON_CHARLIKE()           GC_COMMON_CHARLIKE_ctr++;
+#define GC_COMMON_INTLIKE()            GC_COMMON_INTLIKE_ctr++;
+#define GC_COMMON_INTLIKE_FAIL()       GC_COMMON_INTLIKE_FAIL_ctr++;
+#define GC_COMMON_CONST()              GC_COMMON_CONST_ctr++;
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -714,8 +664,7 @@ extern I_ ENT_IND_ctr;
 extern I_ ENT_PAP_ctr;
 extern I_ ENT_THK_ctr;
 
 extern I_ ENT_PAP_ctr;
 extern I_ ENT_THK_ctr;
 
-extern I_ UPD_ENTERED_ctr;
-extern I_ UPD_ENTERED_AGAIN_ctr;
+extern I_ UPD_ENTERED_hst[9];
 
 extern I_ RET_NEW_IN_HEAP_ctr;
 extern I_ RET_NEW_IN_REGS_ctr;
 
 extern I_ RET_NEW_IN_HEAP_ctr;
 extern I_ RET_NEW_IN_REGS_ctr;
@@ -726,6 +675,20 @@ extern I_ RET_SEMI_IN_HEAP_ctr;
 extern I_ RET_SEMI_IN_REGS_ctr;
 extern I_ VEC_RETURN_ctr;
 
 extern I_ RET_SEMI_IN_REGS_ctr;
 extern I_ VEC_RETURN_ctr;
 
+extern I_ RET_SEMI_FAILED_IND_ctr;
+extern I_ RET_SEMI_FAILED_UNEVAL_ctr;
+
+extern I_ RET_SEMI_loads_avoided;
+
+extern I_ RET_NEW_IN_HEAP_hst[9];
+extern I_ RET_NEW_IN_REGS_hst[9];
+extern I_ RET_OLD_IN_HEAP_hst[9];
+extern I_ RET_OLD_IN_REGS_hst[9];
+/*no such thing: extern I_ RET_SEMI_BY_DEFAULT_hst[9]; */
+extern I_ RET_SEMI_IN_HEAP_hst[9];
+extern I_ RET_SEMI_IN_REGS_hst[9];
+extern I_ RET_VEC_RETURN_hst[9];
+
 extern I_ ReturnInRegsNodeValid; /* see below */
 
 extern I_ UPDF_OMITTED_ctr;
 extern I_ ReturnInRegsNodeValid; /* see below */
 
 extern I_ UPDF_OMITTED_ctr;
@@ -737,12 +700,17 @@ extern I_ UPDF_RCC_PUSHED_ctr;
 extern I_ UPDF_RCC_OMITTED_ctr;
 
 extern I_ UPD_EXISTING_ctr;
 extern I_ UPDF_RCC_OMITTED_ctr;
 
 extern I_ UPD_EXISTING_ctr;
+extern I_ UPD_SQUEEZED_ctr;
 extern I_ UPD_CON_W_NODE_ctr;
 extern I_ UPD_CON_IN_PLACE_ctr;
 extern I_ UPD_PAP_IN_PLACE_ctr;
 extern I_ UPD_CON_IN_NEW_ctr;
 extern I_ UPD_PAP_IN_NEW_ctr;
 
 extern I_ UPD_CON_W_NODE_ctr;
 extern I_ UPD_CON_IN_PLACE_ctr;
 extern I_ UPD_PAP_IN_PLACE_ctr;
 extern I_ UPD_CON_IN_NEW_ctr;
 extern I_ UPD_PAP_IN_NEW_ctr;
 
+extern I_ UPD_CON_IN_PLACE_hst[9];
+extern I_ UPD_CON_IN_NEW_hst[9];
+extern I_ UPD_PAP_IN_NEW_hst[9];
+
 extern I_ UPD_NEW_IND_ctr;
 extern I_ UPD_NEW_IN_PLACE_PTRS_ctr;
 extern I_ UPD_NEW_IN_PLACE_NOPTRS_ctr;
 extern I_ UPD_NEW_IND_ctr;
 extern I_ UPD_NEW_IN_PLACE_PTRS_ctr;
 extern I_ UPD_NEW_IN_PLACE_NOPTRS_ctr;
@@ -752,19 +720,27 @@ extern I_ UPD_OLD_IN_PLACE_NOPTRS_ctr;
 
 extern I_ UPD_IN_PLACE_COPY_ctr; /* see below */
 
 
 extern I_ UPD_IN_PLACE_COPY_ctr; /* see below */
 
-#endif /* DO_REDN_COUNTING */
+extern I_ GC_SEL_ABANDONED_ctr;
+extern I_ GC_SEL_MINOR_ctr;
+extern I_ GC_SEL_MAJOR_ctr;
+extern I_ GC_SHORT_IND_ctr;
+extern I_ GC_SHORT_CAF_ctr;
+extern I_ GC_COMMON_CHARLIKE_ctr;
+extern I_ GC_COMMON_INTLIKE_ctr;
+extern I_ GC_COMMON_INTLIKE_FAIL_ctr;
+extern I_ GC_COMMON_CONST_ctr;
+
+#endif /* TICKY_TICKY */
 \end{code}
 
 %************************************************************************
 %*                                                                     *
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[RednCounts-nonmacros]{Un-macros for ``none of the above''}
+\subsection[Ticky-nonmacros]{Un-macros for ``none of the above''}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-#if ! (defined(DO_SPAT_PROFILING) || defined(DO_REDN_COUNTING))
-
-#define SET_ACTIVITY(act) /* nothing */
+#ifndef TICKY_TICKY
 
 #define ALLOC_HEAP(n)   /* nothing */
 #define UN_ALLOC_HEAP(n) /* nothing */
 
 #define ALLOC_HEAP(n)   /* nothing */
 #define UN_ALLOC_HEAP(n) /* nothing */
@@ -800,14 +776,15 @@ extern I_ UPD_IN_PLACE_COPY_ctr; /* see below */
 #define ENT_IND(n)     /* nothing */
 #define ENT_PAP(n)     /* nothing */
 
 #define ENT_IND(n)     /* nothing */
 #define ENT_PAP(n)     /* nothing */
 
-#define RET_NEW_IN_HEAP()      /* nothing */
-#define RET_NEW_IN_REGS()      /* nothing */
-#define RET_OLD_IN_HEAP()      /* nothing */
-#define RET_OLD_IN_REGS()      /* nothing */
+#define RET_NEW_IN_HEAP(n)     /* nothing */
+#define RET_NEW_IN_REGS(n)     /* nothing */
+#define RET_OLD_IN_HEAP(n)     /* nothing */
+#define RET_OLD_IN_REGS(n)     /* nothing */
 #define RET_SEMI_BY_DEFAULT()  /* nothing */
 #define RET_SEMI_BY_DEFAULT()  /* nothing */
-#define RET_SEMI_IN_HEAP()     /* nothing */
-#define RET_SEMI_IN_REGS()     /* nothing */
-#define VEC_RETURN()           /* nothing */
+#define RET_SEMI_IN_HEAP(n)    /* nothing */
+#define RET_SEMI_IN_REGS(n,u)  /* nothing */
+#define RET_SEMI_FAILED(t)     /* nothing */
+#define VEC_RETURN(n)          /* nothing */
 
 #define UPDF_OMITTED()         /* nothing */
 #define UPDF_STD_PUSHED()      /* nothing */
 
 #define UPDF_OMITTED()         /* nothing */
 #define UPDF_STD_PUSHED()      /* nothing */
@@ -818,17 +795,23 @@ extern I_ UPD_IN_PLACE_COPY_ctr; /* see below */
 #define UPDF_RCC_OMITTED()     /* nothing */
 
 #define UPD_EXISTING()         /* nothing */
 #define UPDF_RCC_OMITTED()     /* nothing */
 
 #define UPD_EXISTING()         /* nothing */
+#define UPD_SQUEEZED()         /* nothing */
 #define UPD_CON_W_NODE()       /* nothing */
 #define UPD_CON_W_NODE()       /* nothing */
-#define UPD_CON_IN_PLACE()     /* nothing */
+#define UPD_CON_IN_PLACE(n)    /* nothing */
 #define UPD_PAP_IN_PLACE()     /* nothing */
 #define UPD_PAP_IN_PLACE()     /* nothing */
-#define UPD_CON_IN_NEW()       /* nothing */
-#define UPD_PAP_IN_NEW()       /* nothing */
-\end{code}
-
-For special subsequent enter counting:
-\begin{code}
-#define UPDATED_SET_UPDATED(n)  /* nothing */
-#define ENTERED_CHECK_UPDATED(n) /* nothing */
+#define UPD_CON_IN_NEW(n)      /* nothing */
+#define UPD_PAP_IN_NEW(n)      /* nothing */
+
+#define GC_SEL_ABANDONED()     /* nothing */
+#define GC_SEL_MINOR()         /* nothing */
+#define GC_SEL_MAJOR()         /* nothing */
+
+#define GC_SHORT_IND()         /* nothing */
+#define GC_SHORT_CAF()         /* nothing */
+#define GC_COMMON_CHARLIKE()   /* nothing */
+#define GC_COMMON_INTLIKE()    /* nothing */
+#define GC_COMMON_INTLIKE_FAIL()/* nothing */
+#define GC_COMMON_CONST()      /* nothing */
 \end{code}
 
 For a generational collector:
 \end{code}
 
 For a generational collector:
@@ -845,5 +828,5 @@ For a generational collector:
 
 End of file multi-slurp protection:
 \begin{code}
 
 End of file multi-slurp protection:
 \begin{code}
-#endif /* ! REDNCOUNTS_H */
+#endif /* ! TICKY_H */
 \end{code}
 \end{code}
index e1e4057..92201e8 100644 (file)
@@ -10,11 +10,11 @@ extern int rl_pending_input;
 
 
 /* Our C Hackery stuff for Callbacks */
 
 
 /* Our C Hackery stuff for Callbacks */
-typedef int KeyCode;
+typedef I_ KeyCode;
 extern StgStablePtr cbackList;
 extern StgStablePtr cbackList;
-extern int genericRlCback ();
+extern I_ genericRlCback PROTO((I_, I_));
 extern StgStablePtr haskellRlEntry;
 extern StgStablePtr haskellRlEntry;
-extern int current_narg, rl_return;
+extern I_ current_narg, rl_return;
 extern KeyCode current_kc;
 extern char* rl_prompt_hack;
 
 extern KeyCode current_kc;
 extern char* rl_prompt_hack;
 
index c4f51c7..2e2ae88 100644 (file)
 
 #define OFFSET(table, x) ((StgUnion *) &(x) - (StgUnion *) (&table))
 
 
 #define OFFSET(table, x) ((StgUnion *) &(x) - (StgUnion *) (&table))
 
-#define OFFSET_Dbl1 OFFSET(MainRegTable, RTBL_Dbl1)
-#define OFFSET_Dbl2 OFFSET(MainRegTable, RTBL_Dbl2)
-#define OFFSET_Flt1 OFFSET(MainRegTable, RTBL_Flt1)
-#define OFFSET_Flt2 OFFSET(MainRegTable, RTBL_Flt2)
-#define OFFSET_Flt3 OFFSET(MainRegTable, RTBL_Flt3)
-#define OFFSET_Flt4 OFFSET(MainRegTable, RTBL_Flt4)
-#define OFFSET_R1 OFFSET(MainRegTable, RTBL_R1)
-#define OFFSET_R2 OFFSET(MainRegTable, RTBL_R2)
-#define OFFSET_R3 OFFSET(MainRegTable, RTBL_R3)
-#define OFFSET_R4 OFFSET(MainRegTable, RTBL_R4)
-#define OFFSET_R5 OFFSET(MainRegTable, RTBL_R5)
-#define OFFSET_R6 OFFSET(MainRegTable, RTBL_R6)
-#define OFFSET_R7 OFFSET(MainRegTable, RTBL_R7)
-#define OFFSET_R8 OFFSET(MainRegTable, RTBL_R8)
-#define OFFSET_SpA OFFSET(MainRegTable, RTBL_SpA)
-#define OFFSET_SuA OFFSET(MainRegTable, RTBL_SuA)
-#define OFFSET_SpB OFFSET(MainRegTable, RTBL_SpB)
-#define OFFSET_SuB OFFSET(MainRegTable, RTBL_SuB)
-#define OFFSET_Hp OFFSET(MainRegTable, RTBL_Hp)
-#define OFFSET_HpLim OFFSET(MainRegTable, RTBL_HpLim)
-#define OFFSET_Tag OFFSET(MainRegTable, RTBL_Tag)
-#define OFFSET_Ret OFFSET(MainRegTable, RTBL_Ret)
-#define OFFSET_Activity OFFSET(MainRegTable, RTBL_Activity)
-#define OFFSET_StkO OFFSET(MainRegTable, RTBL_StkO)
-#define OFFSET_Liveness OFFSET(MainRegTable, RTBL_Liveness)
+#define OFFSET_Dbl1 OFFSET(MainRegTable, MAIN_Dbl1)
+#define OFFSET_Dbl2 OFFSET(MainRegTable, MAIN_Dbl2)
+#define OFFSET_Flt1 OFFSET(MainRegTable, MAIN_Flt1)
+#define OFFSET_Flt2 OFFSET(MainRegTable, MAIN_Flt2)
+#define OFFSET_Flt3 OFFSET(MainRegTable, MAIN_Flt3)
+#define OFFSET_Flt4 OFFSET(MainRegTable, MAIN_Flt4)
+#define OFFSET_R1 OFFSET(MainRegTable, MAIN_R1)
+#define OFFSET_R2 OFFSET(MainRegTable, MAIN_R2)
+#define OFFSET_R3 OFFSET(MainRegTable, MAIN_R3)
+#define OFFSET_R4 OFFSET(MainRegTable, MAIN_R4)
+#define OFFSET_R5 OFFSET(MainRegTable, MAIN_R5)
+#define OFFSET_R6 OFFSET(MainRegTable, MAIN_R6)
+#define OFFSET_R7 OFFSET(MainRegTable, MAIN_R7)
+#define OFFSET_R8 OFFSET(MainRegTable, MAIN_R8)
+#define OFFSET_SpA OFFSET(MainRegTable, MAIN_SpA)
+#define OFFSET_SuA OFFSET(MainRegTable, MAIN_SuA)
+#define OFFSET_SpB OFFSET(MainRegTable, MAIN_SpB)
+#define OFFSET_SuB OFFSET(MainRegTable, MAIN_SuB)
+#define OFFSET_Hp OFFSET(MainRegTable, MAIN_Hp)
+#define OFFSET_HpLim OFFSET(MainRegTable, MAIN_HpLim)
+#define OFFSET_Tag OFFSET(MainRegTable, MAIN_Tag)
+#define OFFSET_Ret OFFSET(MainRegTable, MAIN_Ret)
+#define OFFSET_StkO OFFSET(MainRegTable, MAIN_StkO)
+#define OFFSET_Liveness OFFSET(MainRegTable, MAIN_Liveness)
 
 #define SM_HP OFFSET(StorageMgrInfo, StorageMgrInfo.hp)
 #define SM_HPLIM OFFSET(StorageMgrInfo, StorageMgrInfo.hplim)
 
 #define SM_HP OFFSET(StorageMgrInfo, StorageMgrInfo.hp)
 #define SM_HPLIM OFFSET(StorageMgrInfo, StorageMgrInfo.hplim)
@@ -79,7 +78,6 @@ main()
     printf("#define OFFSET_HpLim %d\n", OFFSET_HpLim);
     printf("#define OFFSET_Tag %d\n", OFFSET_Tag);
     printf("#define OFFSET_Ret %d\n", OFFSET_Ret);
     printf("#define OFFSET_HpLim %d\n", OFFSET_HpLim);
     printf("#define OFFSET_Tag %d\n", OFFSET_Tag);
     printf("#define OFFSET_Ret %d\n", OFFSET_Ret);
-    printf("#define OFFSET_Activity %d\n", OFFSET_Activity);
 #ifdef CONCURRENT
     printf("#define OFFSET_StkO %d\n", OFFSET_StkO);
     printf("#define OFFSET_Liveness %d\n", OFFSET_Liveness);
 #ifdef CONCURRENT
     printf("#define OFFSET_StkO %d\n", OFFSET_StkO);
     printf("#define OFFSET_Liveness %d\n", OFFSET_Liveness);
index e04ebee..88b0f40 100644 (file)
@@ -39,6 +39,11 @@ void _stgAssert PROTO((char *, unsigned int));
 #else
 #define _POSIX_SOURCE 1
 #define _POSIX_C_SOURCE 199301L
 #else
 #define _POSIX_SOURCE 1
 #define _POSIX_C_SOURCE 199301L
+/* Alphas set _POSIX_VERSION (unistd.h) */
+/* ditto _POSIX2_C_VERSION
+        _POSIX2_VERSION
+        _POSIX_4SOURCE
+*/
 #include <unistd.h>
 #include <signal.h>
 #endif
 #include <unistd.h>
 #include <signal.h>
 #endif
@@ -121,6 +126,21 @@ yikes! no register map defined!
 /* macros to deal with stacks (no longer heap) growing in either dirn */
 #include "StgDirections.h"
 
 /* macros to deal with stacks (no longer heap) growing in either dirn */
 #include "StgDirections.h"
 
+/* declarations for all the runtime flags for the RTS */
+#ifdef IN_GHC_RTS
+#include "RtsFlags.h"
+#endif
+/* and those that are visible *everywhere* (RTS + Haskell code) */
+struct ALL_FLAGS {
+#ifdef TICKY_TICKY
+    W_ doUpdEntryCounts;    /* if true, we cannot short-circuit Inds,
+                                common-up {Int,Char}Likes or Consts
+                           */
+#endif
+    W_ dummy_entry; /* so there is *something* in it... */
+};
+extern struct ALL_FLAGS AllFlags;
+
 /* declarations for garbage collection routines */
 #include "SMinterface.h"
 
 /* declarations for garbage collection routines */
 #include "SMinterface.h"
 
@@ -129,12 +149,11 @@ yikes! no register map defined!
 #include "COptRegs.h"
 #include "COptWraps.h"
 
 #include "COptRegs.h"
 #include "COptWraps.h"
 
-/* these will come into play if you use -DDO_RUNTIME_PROFILING (default: off) */
-#include "RednCounts.h"
+/* these will come into play if you use -DTICKY_TICKY (default: off) */
+#include "Ticky.h"
 
 
-extern hash_t hash_str   PROTO((char *str));
-extern hash_t hash_fixed PROTO((char *data, I_ len));
-extern I_     decode    PROTO((char *s));
+hash_t hash_str   PROTO((char *str));
+hash_t hash_fixed PROTO((char *data, I_ len));
 
 /* ullong (64bit) formatting */
 char *ullong_format_string PROTO((ullong x, char *s, rtsBool with_commas));
 
 /* ullong (64bit) formatting */
 char *ullong_format_string PROTO((ullong x, char *s, rtsBool with_commas));
@@ -149,19 +168,13 @@ char *ullong_format_string PROTO((ullong x, char *s, rtsBool with_commas));
 #include "Threads.h"
 #include "Parallel.h"
 
 #include "Threads.h"
 #include "Parallel.h"
 
-/* Things will happen in here if the driver does -DUSE_COST_CENTRES */
+/* Things will happen in here if the driver does -DPROFILING */
 #include "CostCentre.h"
 
 #include "CostCentre.h"
 
-/* These will come into play if you use -DLIFE_PROFILE or -DHEAP_PROF_WITH_AGE */
-#include "AgeProfile.h"
-
-/* These will come into play if you use -DFORCE_GC  */
-#include "Force_GC.h"
-
 /* GRAN and PAR stuff */
 #include "GranSim.h"
 
 /* GRAN and PAR stuff */
 #include "GranSim.h"
 
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
 char * time_str(STG_NO_ARGS);
 #endif
 
 char * time_str(STG_NO_ARGS);
 #endif
 
@@ -176,9 +189,9 @@ extern StgFunPtr impossible_jump_after_switch(STG_NO_ARGS);
 
 /* hooks: user might write some of their own */
 extern void ErrorHdrHook       PROTO((FILE *));
 
 /* hooks: user might write some of their own */
 extern void ErrorHdrHook       PROTO((FILE *));
-extern void OutOfHeapHook      PROTO((W_, W_));
+extern void OutOfHeapHook      PROTO((W_));
 extern void StackOverflowHook  PROTO((I_));
 extern void StackOverflowHook  PROTO((I_));
-extern void MallocFailHook     PROTO((I_));
+extern void MallocFailHook     PROTO((I_, char *));
 extern void PatErrorHdrHook    PROTO((FILE *));
 extern void PreTraceHook       PROTO((FILE *));
 extern void PostTraceHook      PROTO((FILE *));
 extern void PatErrorHdrHook    PROTO((FILE *));
 extern void PreTraceHook       PROTO((FILE *));
 extern void PostTraceHook      PROTO((FILE *));
@@ -191,15 +204,17 @@ EXTFUN(resumeThread);
 #endif
 
 extern char **prog_argv; /* from runtime/main/main.lc */
 #endif
 
 extern char **prog_argv; /* from runtime/main/main.lc */
-extern I_     prog_argc;
+extern int    prog_argc;
 extern char **environ; /* we can get this one straight */
 
 EXTDATA(STK_STUB_closure);
 
 /* now these really *DO* need to be somewhere else... */
 extern char **environ; /* we can get this one straight */
 
 EXTDATA(STK_STUB_closure);
 
 /* now these really *DO* need to be somewhere else... */
-extern char    *time_str(STG_NO_ARGS);
-extern I_      stg_exit PROTO((I_));
-extern I_      _stg_rem PROTO((I_, I_));
+char   *time_str(STG_NO_ARGS);
+I_     stg_exit PROTO((I_));
+I_     _stg_rem PROTO((I_, I_));
+char   *stgMallocBytes PROTO((I_, char *));
+char   *stgMallocWords PROTO((I_, char *));
 
 /* definitions for closures */
 #include "SMClosures.h"
 
 /* definitions for closures */
 #include "SMClosures.h"
index 3efd834..f4708f3 100644 (file)
@@ -14,7 +14,7 @@ StgInt closeFile PROTO((StgAddr));
 StgInt createDirectory PROTO((StgByteArray));
 
 /* env.lc */
 StgInt createDirectory PROTO((StgByteArray));
 
 /* env.lc */
-char * strdup          PROTO((const char *));
+char * strdup          PROTO((char *));
 int    setenviron      PROTO((char **));
 int    copyenv         (STG_NO_ARGS);
 int    setenv          PROTO((char *));
 int    setenviron      PROTO((char **));
 int    copyenv         (STG_NO_ARGS);
 int    setenv          PROTO((char *));
@@ -58,7 +58,7 @@ StgInt        getBufferMode PROTO((StgAddr));
 StgInt getClockTime PROTO((StgByteArray, StgByteArray));
 
 /* getCPUTime.lc */
 StgInt getClockTime PROTO((StgByteArray, StgByteArray));
 
 /* getCPUTime.lc */
-StgAddr getCPUTime(STG_NO_ARGS);
+StgByteArray getCPUTime PROTO((StgByteArray));
 
 /* getCurrentDirectory.lc */
 StgAddr getCurrentDirectory(STG_NO_ARGS);
 
 /* getCurrentDirectory.lc */
 StgAddr getCurrentDirectory(STG_NO_ARGS);
@@ -105,19 +105,19 @@ StgInt    setBuffering PROTO((StgAddr, StgInt));
 StgInt setCurrentDirectory PROTO((StgByteArray));
 
 /* showTime.lc */
 StgInt setCurrentDirectory PROTO((StgByteArray));
 
 /* showTime.lc */
-StgAddr showTime PROTO((StgInt, StgByteArray));
+StgAddr showTime PROTO((StgInt, StgByteArray, StgByteArray));
 
 /* system.lc */
 StgInt systemCmd PROTO((StgByteArray));
 
 /* toLocalTime.lc */
 
 /* system.lc */
 StgInt systemCmd PROTO((StgByteArray));
 
 /* toLocalTime.lc */
-StgAddr toLocalTime PROTO((StgInt, StgByteArray));
+StgAddr toLocalTime PROTO((StgInt, StgByteArray, StgByteArray));
 
 /* toUTCTime.lc */
 
 /* toUTCTime.lc */
-StgAddr toUTCTime PROTO((StgInt, StgByteArray));
+StgAddr toUTCTime PROTO((StgInt, StgByteArray, StgByteArray));
 
 /* toClockSec.lc */
 
 /* toClockSec.lc */
-StgAddr toClockSec PROTO((StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt));
+StgAddr toClockSec PROTO((StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgByteArray));
 
 /* writeFile.lc */
 StgInt writeFile PROTO((StgAddr, StgAddr, StgInt));
 
 /* writeFile.lc */
 StgInt writeFile PROTO((StgAddr, StgAddr, StgInt));
index e0aa2f0..75a287f 100644 (file)
 #endif
 
 #if HAVE_TM_ZONE
 #endif
 
 #if HAVE_TM_ZONE
-#define ZONE(x)            (((struct tm *)x)->tm_zone)
-#define GMTOFF(x)   (((struct tm *)x)->tm_gmtoff)
+#define ZONE(x)                 (((struct tm *)x)->tm_zone)
+#define SETZONE(x,z)     (((struct tm *)x)->tm_zone = z)
+#define GMTOFF(x)        (((struct tm *)x)->tm_gmtoff)
 #else 
 #if HAVE_TZNAME
 extern time_t timezone, altzone;
 extern char *tmzone[2];
 #else 
 #if HAVE_TZNAME
 extern time_t timezone, altzone;
 extern char *tmzone[2];
-#define ZONE(x)            (((struct tm *)x)->tm_isdst ? tmzone[1] : tmzone[0])
-#define GMTOFF(x)   (((struct tm *)x)->tm_isdst ? altzone : timezone)
+#define ZONE(x)                 (((struct tm *)x)->tm_isdst ? tmzone[1] : tmzone[0])
+#define SETZONE(x,z)
+#define GMTOFF(x)       (((struct tm *)x)->tm_isdst ? altzone : timezone)
 #endif
 #endif
 
 #endif
 #endif
 
-#endif
\ No newline at end of file
+#endif
index 4702053..c51e20d 100644 (file)
@@ -209,6 +209,8 @@ CAT2(blob,_HC_l)    = $(CAT2(blob,_HS):.hs=_l.hc)   @@\
 CAT2(blob,_HC_m)    = $(CAT2(blob,_HS):.hs=_m.hc)      @@\
 CAT2(blob,_HC_n)    = $(CAT2(blob,_HS):.hs=_n.hc)      @@\
 CAT2(blob,_HC_o)    = $(CAT2(blob,_HS):.hs=_o.hc)      @@\
 CAT2(blob,_HC_m)    = $(CAT2(blob,_HS):.hs=_m.hc)      @@\
 CAT2(blob,_HC_n)    = $(CAT2(blob,_HS):.hs=_n.hc)      @@\
 CAT2(blob,_HC_o)    = $(CAT2(blob,_HS):.hs=_o.hc)      @@\
+CAT2(blob,_HC_A)    = $(CAT2(blob,_HS):.hs=_A.hc)      @@\
+CAT2(blob,_HC_B)    = $(CAT2(blob,_HS):.hs=_B.hc)      @@\
                                                        @@\
 CAT2(blob,_DEP_norm) = $(CAT2(blob,_HC_norm):.hc=.o)   @@\
 CAT2(blob,_DEP_p)   = $(CAT2(blob,_HC_p):.hc=.o)       @@\
                                                        @@\
 CAT2(blob,_DEP_norm) = $(CAT2(blob,_HC_norm):.hc=.o)   @@\
 CAT2(blob,_DEP_p)   = $(CAT2(blob,_HC_p):.hc=.o)       @@\
@@ -237,6 +239,8 @@ CAT2(blob,_DEP_l)   = $(CAT2(blob,_HC_l):.hc=.o)    @@\
 CAT2(blob,_DEP_m)   = $(CAT2(blob,_HC_m):.hc=.o)       @@\
 CAT2(blob,_DEP_n)   = $(CAT2(blob,_HC_n):.hc=.o)       @@\
 CAT2(blob,_DEP_o)   = $(CAT2(blob,_HC_o):.hc=.o)       @@\
 CAT2(blob,_DEP_m)   = $(CAT2(blob,_HC_m):.hc=.o)       @@\
 CAT2(blob,_DEP_n)   = $(CAT2(blob,_HC_n):.hc=.o)       @@\
 CAT2(blob,_DEP_o)   = $(CAT2(blob,_HC_o):.hc=.o)       @@\
+CAT2(blob,_DEP_A)   = $(CAT2(blob,_HC_A):.hc=.o)       @@\
+CAT2(blob,_DEP_B)   = $(CAT2(blob,_HC_B):.hc=.o)       @@\
                                                        @@\
 CAT2(blob,_HIs_p)   = $(CAT2(blob,_HIs):.hi=_p.hi)     @@\
 CAT2(blob,_HIs_t)   = $(CAT2(blob,_HIs):.hi=_t.hi)     @@\
                                                        @@\
 CAT2(blob,_HIs_p)   = $(CAT2(blob,_HIs):.hi=_p.hi)     @@\
 CAT2(blob,_HIs_t)   = $(CAT2(blob,_HIs):.hi=_t.hi)     @@\
@@ -263,7 +267,9 @@ CAT2(blob,_HIs_k)   = $(CAT2(blob,_HIs):.hi=_k.hi)  @@\
 CAT2(blob,_HIs_l)   = $(CAT2(blob,_HIs):.hi=_l.hi)     @@\
 CAT2(blob,_HIs_m)   = $(CAT2(blob,_HIs):.hi=_m.hi)     @@\
 CAT2(blob,_HIs_n)   = $(CAT2(blob,_HIs):.hi=_n.hi)     @@\
 CAT2(blob,_HIs_l)   = $(CAT2(blob,_HIs):.hi=_l.hi)     @@\
 CAT2(blob,_HIs_m)   = $(CAT2(blob,_HIs):.hi=_m.hi)     @@\
 CAT2(blob,_HIs_n)   = $(CAT2(blob,_HIs):.hi=_n.hi)     @@\
-CAT2(blob,_HIs_o)   = $(CAT2(blob,_HIs):.hi=_o.hi)
+CAT2(blob,_HIs_o)   = $(CAT2(blob,_HIs):.hi=_o.hi)     @@\
+CAT2(blob,_HIs_A)   = $(CAT2(blob,_HIs):.hi=_A.hi)     @@\
+CAT2(blob,_HIs_B)   = $(CAT2(blob,_HIs):.hi=_B.hi)
 
 
 #define PrintFileStuff(blob,outf) \
 
 
 #define PrintFileStuff(blob,outf) \
@@ -295,6 +301,8 @@ CAT2(blob,_HIs_o)   = $(CAT2(blob,_HIs):.hi=_o.hi)
        @echo 'IfGhcBuild_m('  CAT2(blob,_HC_m)  = $(CAT2(blob,_HC_m))  ')' >> outf @@\
        @echo 'IfGhcBuild_n('  CAT2(blob,_HC_n)  = $(CAT2(blob,_HC_n))  ')' >> outf @@\
        @echo 'IfGhcBuild_o('  CAT2(blob,_HC_o)  = $(CAT2(blob,_HC_o))  ')' >> outf @@\
        @echo 'IfGhcBuild_m('  CAT2(blob,_HC_m)  = $(CAT2(blob,_HC_m))  ')' >> outf @@\
        @echo 'IfGhcBuild_n('  CAT2(blob,_HC_n)  = $(CAT2(blob,_HC_n))  ')' >> outf @@\
        @echo 'IfGhcBuild_o('  CAT2(blob,_HC_o)  = $(CAT2(blob,_HC_o))  ')' >> outf @@\
+       @echo 'IfGhcBuild_A('  CAT2(blob,_HC_A)  = $(CAT2(blob,_HC_A))  ')' >> outf @@\
+       @echo 'IfGhcBuild_B('  CAT2(blob,_HC_B)  = $(CAT2(blob,_HC_B))  ')' >> outf @@\
        @echo 'IfGhcBuild_p('  CAT2(blob,_DEP_p)  = $(CAT2(blob,_DEP_p))  ')' >> outf @@\
        @echo 'IfGhcBuild_t('  CAT2(blob,_DEP_t)  = $(CAT2(blob,_DEP_t))  ')' >> outf @@\
        @echo 'IfGhcBuild_u('  CAT2(blob,_DEP_u)  = $(CAT2(blob,_DEP_u))  ')' >> outf @@\
        @echo 'IfGhcBuild_p('  CAT2(blob,_DEP_p)  = $(CAT2(blob,_DEP_p))  ')' >> outf @@\
        @echo 'IfGhcBuild_t('  CAT2(blob,_DEP_t)  = $(CAT2(blob,_DEP_t))  ')' >> outf @@\
        @echo 'IfGhcBuild_u('  CAT2(blob,_DEP_u)  = $(CAT2(blob,_DEP_u))  ')' >> outf @@\
@@ -321,6 +329,8 @@ CAT2(blob,_HIs_o)   = $(CAT2(blob,_HIs):.hi=_o.hi)
        @echo 'IfGhcBuild_m('  CAT2(blob,_DEP_m)  = $(CAT2(blob,_DEP_m))  ')' >> outf @@\
        @echo 'IfGhcBuild_n('  CAT2(blob,_DEP_n)  = $(CAT2(blob,_DEP_n))  ')' >> outf @@\
        @echo 'IfGhcBuild_o('  CAT2(blob,_DEP_o)  = $(CAT2(blob,_DEP_o))  ')' >> outf @@\
        @echo 'IfGhcBuild_m('  CAT2(blob,_DEP_m)  = $(CAT2(blob,_DEP_m))  ')' >> outf @@\
        @echo 'IfGhcBuild_n('  CAT2(blob,_DEP_n)  = $(CAT2(blob,_DEP_n))  ')' >> outf @@\
        @echo 'IfGhcBuild_o('  CAT2(blob,_DEP_o)  = $(CAT2(blob,_DEP_o))  ')' >> outf @@\
+       @echo 'IfGhcBuild_A('  CAT2(blob,_DEP_A)  = $(CAT2(blob,_DEP_A))  ')' >> outf @@\
+       @echo 'IfGhcBuild_B('  CAT2(blob,_DEP_B)  = $(CAT2(blob,_DEP_B))  ')' >> outf @@\
        @echo 'IfGhcBuild_p('  CAT2(blob,_HIs_p)  = $(CAT2(blob,_HIs_p))  ')' >> outf @@\
        @echo 'IfGhcBuild_t('  CAT2(blob,_HIs_t)  = $(CAT2(blob,_HIs_t))  ')' >> outf @@\
        @echo 'IfGhcBuild_u('  CAT2(blob,_HIs_u)  = $(CAT2(blob,_HIs_u))  ')' >> outf @@\
        @echo 'IfGhcBuild_p('  CAT2(blob,_HIs_p)  = $(CAT2(blob,_HIs_p))  ')' >> outf @@\
        @echo 'IfGhcBuild_t('  CAT2(blob,_HIs_t)  = $(CAT2(blob,_HIs_t))  ')' >> outf @@\
        @echo 'IfGhcBuild_u('  CAT2(blob,_HIs_u)  = $(CAT2(blob,_HIs_u))  ')' >> outf @@\
@@ -346,7 +356,9 @@ CAT2(blob,_HIs_o)   = $(CAT2(blob,_HIs):.hi=_o.hi)
        @echo 'IfGhcBuild_l('  CAT2(blob,_HIs_l)  = $(CAT2(blob,_HIs_l))  ')' >> outf @@\
        @echo 'IfGhcBuild_m('  CAT2(blob,_HIs_m)  = $(CAT2(blob,_HIs_m))  ')' >> outf @@\
        @echo 'IfGhcBuild_n('  CAT2(blob,_HIs_n)  = $(CAT2(blob,_HIs_n))  ')' >> outf @@\
        @echo 'IfGhcBuild_l('  CAT2(blob,_HIs_l)  = $(CAT2(blob,_HIs_l))  ')' >> outf @@\
        @echo 'IfGhcBuild_m('  CAT2(blob,_HIs_m)  = $(CAT2(blob,_HIs_m))  ')' >> outf @@\
        @echo 'IfGhcBuild_n('  CAT2(blob,_HIs_n)  = $(CAT2(blob,_HIs_n))  ')' >> outf @@\
-       @echo 'IfGhcBuild_o('  CAT2(blob,_HIs_o)  = $(CAT2(blob,_HIs_o))  ')' >> outf
+       @echo 'IfGhcBuild_o('  CAT2(blob,_HIs_o)  = $(CAT2(blob,_HIs_o))  ')' >> outf @@\
+       @echo 'IfGhcBuild_A('  CAT2(blob,_HIs_A)  = $(CAT2(blob,_HIs_A))  ')' >> outf @@\
+       @echo 'IfGhcBuild_B('  CAT2(blob,_HIs_B)  = $(CAT2(blob,_HIs_B))  ')' >> outf
 
 BASIC_HS       = $(BASIC_LHS:.lhs=.hs) $(BASIC_HS_PREL)
 BASIC_OBJS_DIRS        = $(BASIC_HS:.hs=)
 
 BASIC_HS       = $(BASIC_LHS:.lhs=.hs) $(BASIC_HS_PREL)
 BASIC_OBJS_DIRS        = $(BASIC_HS:.hs=)
@@ -534,6 +546,8 @@ IfGhcBuild_l(hcs_l   :: $(BASIC_HC_l)  $(ONE3_HC_l)  $(GHCLIB_HC_l)  $(HBCLIB_HC
 IfGhcBuild_m(hcs_m   :: $(BASIC_HC_m)  $(ONE3_HC_m)  $(GHCLIB_HC_m)  $(HBCLIB_HC_m))
 IfGhcBuild_n(hcs_n   :: $(BASIC_HC_n)  $(ONE3_HC_n)  $(GHCLIB_HC_n)  $(HBCLIB_HC_n))
 IfGhcBuild_o(hcs_o   :: $(BASIC_HC_o)  $(ONE3_HC_o)  $(GHCLIB_HC_o)  $(HBCLIB_HC_o))
 IfGhcBuild_m(hcs_m   :: $(BASIC_HC_m)  $(ONE3_HC_m)  $(GHCLIB_HC_m)  $(HBCLIB_HC_m))
 IfGhcBuild_n(hcs_n   :: $(BASIC_HC_n)  $(ONE3_HC_n)  $(GHCLIB_HC_n)  $(HBCLIB_HC_n))
 IfGhcBuild_o(hcs_o   :: $(BASIC_HC_o)  $(ONE3_HC_o)  $(GHCLIB_HC_o)  $(HBCLIB_HC_o))
+IfGhcBuild_A(hcs_A   :: $(BASIC_HC_A)  $(ONE3_HC_A)  $(GHCLIB_HC_A)  $(HBCLIB_HC_A))
+IfGhcBuild_B(hcs_B   :: $(BASIC_HC_B)  $(ONE3_HC_B)  $(GHCLIB_HC_B)  $(HBCLIB_HC_B))
 
 IfGhcBuild_normal(libs:: libHS.a    libHS13.a    libHSghc.a    libHShbc.a)
 IfGhcBuild_p(libs_p   :: libHS_p.a  libHS13_p.a  libHSghc_p.a  libHShbc_p.a)
 
 IfGhcBuild_normal(libs:: libHS.a    libHS13.a    libHSghc.a    libHShbc.a)
 IfGhcBuild_p(libs_p   :: libHS_p.a  libHS13_p.a  libHSghc_p.a  libHShbc_p.a)
@@ -562,9 +576,11 @@ IfGhcBuild_l(libs_l   :: libHS_l.a  libHS13_l.a  libHSghc_l.a  libHShbc_l.a)
 IfGhcBuild_m(libs_m   :: libHS_m.a  libHS13_m.a  libHSghc_m.a  libHShbc_m.a)
 IfGhcBuild_n(libs_n   :: libHS_n.a  libHS13_n.a  libHSghc_n.a  libHShbc_n.a)
 IfGhcBuild_o(libs_o   :: libHS_o.a  libHS13_o.a  libHSghc_o.a  libHShbc_o.a)
 IfGhcBuild_m(libs_m   :: libHS_m.a  libHS13_m.a  libHSghc_m.a  libHShbc_m.a)
 IfGhcBuild_n(libs_n   :: libHS_n.a  libHS13_n.a  libHSghc_n.a  libHShbc_n.a)
 IfGhcBuild_o(libs_o   :: libHS_o.a  libHS13_o.a  libHSghc_o.a  libHShbc_o.a)
+IfGhcBuild_A(libs_A   :: libHS_A.a  libHS13_A.a  libHSghc_A.a  libHShbc_A.a)
+IfGhcBuild_B(libs_B   :: libHS_B.a  libHS13_B.a  libHSghc_B.a  libHShbc_B.a)
 
 /* maybe for GNU make only? */
 
 /* maybe for GNU make only? */
-.PHONY :: hcs hcs_p hcs_t hcs_mg hcs_mr hcs_mt hcs_mp hcs_mg hcs_a hcs_b hcs_c hcs_d hcs_e hcs_f hcs_g hcs_h hcs_i hcs_j hcs_k hcs_l hcs_m hcs_n hcs_o
+.PHONY :: hcs hcs_p hcs_t hcs_mg hcs_mr hcs_mt hcs_mp hcs_mg hcs_a hcs_b hcs_c hcs_d hcs_e hcs_f hcs_g hcs_h hcs_i hcs_j hcs_k hcs_l hcs_m hcs_n hcs_o hcs_A hcs_B
 
 #endif /* reasonable make */
 
 
 #endif /* reasonable make */
 
@@ -900,6 +916,20 @@ IfGhcBuild_o(BigBuildTarget(_o,'*_o.o',his_o       \
 , $(ONE3_DEP_o),   $(ONE3_HIs_o)               \
 ))
 
 , $(ONE3_DEP_o),   $(ONE3_HIs_o)               \
 ))
 
+IfGhcBuild_A(BigBuildTarget(_A,'*_A.o',his_A   \
+, $(BASIC_DEP_A),  $(BASIC_HIs_A)              \
+, $(GHCLIB_DEP_A), $(GHCLIB_HIs_A)             \
+, $(HBCLIB_DEP_A), $(HBCLIB_HIs_A)             \
+, $(ONE3_DEP_A),   $(ONE3_HIs_A)               \
+))
+
+IfGhcBuild_B(BigBuildTarget(_B,'*_B.o',his_B   \
+, $(BASIC_DEP_B),  $(BASIC_HIs_B)              \
+, $(GHCLIB_DEP_B), $(GHCLIB_HIs_B)             \
+, $(HBCLIB_DEP_B), $(HBCLIB_HIs_B)             \
+, $(ONE3_DEP_B),   $(ONE3_HIs_B)               \
+))
+
 /****************************************************************
 *                                                              *
 * Creating the individual .hc files:                           *
 /****************************************************************
 *                                                              *
 * Creating the individual .hc files:                           *
@@ -972,7 +1002,9 @@ IfGhcBuild_k(DoHs(file,isuf,_k,   flags $(GHC_OPTS_k),   '_k.o',  '*_k.o'))        \
 IfGhcBuild_l(DoHs(file,isuf,_l,   flags $(GHC_OPTS_l),   '_l.o',  '*_l.o'))    \
 IfGhcBuild_m(DoHs(file,isuf,_m,   flags $(GHC_OPTS_m),   '_m.o',  '*_m.o'))    \
 IfGhcBuild_n(DoHs(file,isuf,_n,   flags $(GHC_OPTS_n),   '_n.o',  '*_n.o'))    \
 IfGhcBuild_l(DoHs(file,isuf,_l,   flags $(GHC_OPTS_l),   '_l.o',  '*_l.o'))    \
 IfGhcBuild_m(DoHs(file,isuf,_m,   flags $(GHC_OPTS_m),   '_m.o',  '*_m.o'))    \
 IfGhcBuild_n(DoHs(file,isuf,_n,   flags $(GHC_OPTS_n),   '_n.o',  '*_n.o'))    \
-IfGhcBuild_o(DoHs(file,isuf,_o,   flags $(GHC_OPTS_o),   '_o.o',  '*_o.o'))
+IfGhcBuild_o(DoHs(file,isuf,_o,   flags $(GHC_OPTS_o),   '_o.o',  '*_o.o'))    \
+IfGhcBuild_A(DoHs(file,isuf,_A,   flags $(GHC_OPTS_A),   '_A.o',  '*_A.o'))    \
+IfGhcBuild_B(DoHs(file,isuf,_B,   flags $(GHC_OPTS_B),   '_B.o',  '*_B.o'))
 
 /* now use the macro: */
 
 
 /* now use the macro: */
 
@@ -1085,7 +1117,7 @@ CompilePreludishly(ghc/Readline,lhs,      -ighc -fhaskell-1.3 '-#include"ghcReadline.
 #endif
 #if GhcWithSockets == YES
 CompilePreludishly(ghc/Socket,lhs,     -ighc -fhaskell-1.3)
 #endif
 #if GhcWithSockets == YES
 CompilePreludishly(ghc/Socket,lhs,     -ighc -fhaskell-1.3)
-CompilePreludishly(ghc/SocketPrim,lhs, -ighc -fhaskell-1.3 -K2m -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"')
+CompilePreludishly(ghc/SocketPrim,lhs, -ighc -fhaskell-1.3 -H12m -K2m -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"')
 CompilePreludishly(ghc/BSD,lhs,                -ighc -fhaskell-1.3 -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"')
 CompilePreludishly(ghc/CError,lhs,     -ighc -fhaskell-1.3 -K2m -fomit-derived-read)
 #endif
 CompilePreludishly(ghc/BSD,lhs,                -ighc -fhaskell-1.3 -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"')
 CompilePreludishly(ghc/CError,lhs,     -ighc -fhaskell-1.3 -K2m -fomit-derived-read)
 #endif
@@ -1148,6 +1180,10 @@ print_file_list5 :
 /* now include the extra dependencies so generated */
 #include "Jmake.inc5"
 
 /* now include the extra dependencies so generated */
 #include "Jmake.inc5"
 
+/* for unix-libs.lit */
+LitSuffixRule(.lhs,.hs)
+LitDocRootTarget(unix-libs,lit)
+
 /* should be *LAST* */
 #if HaskellCompilerType != HC_USE_HC_FILES
     /* otherwise, the dependencies jeopardize our .hc files --
 /* should be *LAST* */
 #if HaskellCompilerType != HC_USE_HC_FILES
     /* otherwise, the dependencies jeopardize our .hc files --
index ad080d7..a47f870 100644 (file)
@@ -3,7 +3,7 @@ interface BSD where
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
-data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-}
+data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-}
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
@@ -65,8 +65,8 @@ instance Ord Family
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 361e1b8..5c19f8e 100644 (file)
@@ -375,12 +375,28 @@ unvectorizeHostAddrs :: _Addr -> Int -> PrimIO [_Word]
 unvectorizeHostAddrs ptr n 
   | str == ``NULL'' = returnPrimIO []
   | otherwise = 
 unvectorizeHostAddrs ptr n 
   | str == ``NULL'' = returnPrimIO []
   | otherwise = 
-       _casm_ ``%r = (W_)ntohl(((struct hostent*)%0)->h_addr_list[(int)%1]);''
+       _casm_ ``{ u_long tmp;
+                  if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL)
+                     tmp=(W_)0;
+                  else
+                     tmp = (W_)ntohl(((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr); 
+                  %r=(W_)tmp;} ''
                ptr n                               `thenPrimIO` \ x ->
        unvectorizeHostAddrs ptr (n+1)              `thenPrimIO` \ xs ->
        returnPrimIO (x : xs)
   where str = indexAddrOffAddr ptr n
 
                ptr n                               `thenPrimIO` \ x ->
        unvectorizeHostAddrs ptr (n+1)              `thenPrimIO` \ xs ->
        returnPrimIO (x : xs)
   where str = indexAddrOffAddr ptr n
 
+{-
+unvectorizeHostAddrs :: _Addr -> Int -> PrimIO [_Word]
+unvectorizeHostAddrs ptr n 
+  | str == ``NULL'' = returnPrimIO []
+  | otherwise = 
+       _casm_ ``%r = (W_)ntohl(((struct hostent*)%0)->h_addr_list[(int)%1]);''
+               ptr n                               `thenPrimIO` \ x ->
+       unvectorizeHostAddrs ptr (n+1)              `thenPrimIO` \ xs ->
+       returnPrimIO (x : xs)
+  where str = indexAddrOffAddr ptr n
+-}
 -------------------------------------------------------------------------------
 
 mutByteArr2Addr :: _MutableByteArray _RealWorld Int -> PrimIO  _Addr
 -------------------------------------------------------------------------------
 
 mutByteArr2Addr :: _MutableByteArray _RealWorld Int -> PrimIO  _Addr
index ad080d7..a47f870 100644 (file)
@@ -3,7 +3,7 @@ interface BSD where
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
-data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-}
+data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-}
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
@@ -65,8 +65,8 @@ instance Ord Family
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index ad080d7..2d4e906 100644 (file)
@@ -3,7 +3,7 @@ interface BSD where
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
-data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-}
+data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-}
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
@@ -66,7 +66,7 @@ instance Ord Family
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index ad080d7..a47f870 100644 (file)
@@ -3,7 +3,7 @@ interface BSD where
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
-data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-}
+data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-}
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
@@ -65,8 +65,8 @@ instance Ord Family
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index ad080d7..a47f870 100644 (file)
@@ -3,7 +3,7 @@ interface BSD where
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
-data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-}
+data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-}
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
@@ -65,8 +65,8 @@ instance Ord Family
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index ad080d7..a47f870 100644 (file)
@@ -3,7 +3,7 @@ interface BSD where
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
 import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import SocketPrim(Family)
-data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-}
+data Family    {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-}
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
 data HostEntry   = HostEntry [Char] [[Char]] Family [_Word]
 type HostName = [Char]
 type PortNumber = Int
@@ -65,8 +65,8 @@ instance Ord Family
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index e13f94b..e53d2de 100644 (file)
@@ -29,7 +29,7 @@ instance Ord CErrorCode
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index e13f94b..e53d2de 100644 (file)
@@ -29,7 +29,7 @@ instance Ord CErrorCode
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index e13f94b..e53d2de 100644 (file)
@@ -29,7 +29,7 @@ instance Ord CErrorCode
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index e13f94b..e53d2de 100644 (file)
@@ -29,7 +29,7 @@ instance Ord CErrorCode
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index e13f94b..e53d2de 100644 (file)
@@ -29,7 +29,7 @@ instance Ord CErrorCode
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index e13f94b..e53d2de 100644 (file)
@@ -29,7 +29,7 @@ instance Ord CErrorCode
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
 instance Text CErrorCode
        {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_
         readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 393bb4b..1e3fa44 100644 (file)
@@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 03f087a..56caa58 100644 (file)
@@ -715,6 +715,18 @@ pprX sty (Branch key elt sz fm_l fm_r)
              ppr sty key, ppSP, ppInt (IF_GHC(I# sz, sz)), ppSP,
              pprX sty fm_r, ppRparen]
 #endif
              ppr sty key, ppSP, ppInt (IF_GHC(I# sz, sz)), ppSP,
              pprX sty fm_r, ppRparen]
 #endif
+
+#if !defined(COMPILING_GHC)
+instance (Eq key, Eq elt) => Eq (FiniteMap key elt) where
+  fm_1 == fm_2 = (sizeFM   fm_1 == sizeFM   fm_2) &&   -- quick test
+                 (fmToList fm_1 == fmToList fm_2)
+
+{- NO: not clear what The Right Thing to do is:
+instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where
+  fm_1 <= fm_2 = (sizeFM   fm_1 <= sizeFM   fm_2) &&   -- quick test
+                 (fmToList fm_1 <= fmToList fm_2)
+-}
+#endif
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index 393bb4b..1e3fa44 100644 (file)
@@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 393bb4b..1e3fa44 100644 (file)
@@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 393bb4b..1e3fa44 100644 (file)
@@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 393bb4b..1e3fa44 100644 (file)
@@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 393bb4b..1e3fa44 100644 (file)
@@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 sizeFM :: FiniteMap a b -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 
 
index 54ed33c..df05e35 100644 (file)
@@ -264,8 +264,9 @@ replace (REmatch arr before@(_,b_end) match after lst)
          acc
        else
          let
          acc
        else
          let
-          x@(C# x#) = _headPS repl
-          xs        = _tailPS' repl
+          x  = _headPS repl
+         x# = case x of { C# c -> c }
+          xs = _tailPS' repl
          in
           case x# of
             '\\'# ->  
          in
           case x# of
             '\\'# ->  
index e772849..c792186 100644 (file)
@@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
+getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
@@ -44,12 +46,20 @@ nilPS :: _PackedString
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
+packBytesForC :: [Char] -> _ByteArray Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-}
+packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
+packStringST :: [Char] -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-}
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
index 9612ddd..00eea35 100644 (file)
@@ -3,56 +3,67 @@
 %
 \section[PackedString]{Packed strings}
 
 %
 \section[PackedString]{Packed strings}
 
-A non-weird interface to the wired-in @PackedString@ type.
+A non-weird/abstract interface to the wired-in @PackedString@ type.
 
 \begin{code}
 module PackedString (
        PackedString(..),
 
 
 \begin{code}
 module PackedString (
        PackedString(..),
 
-       packString,
-       packCString,
-       packCBytes,
+       packString,             -- :: [Char] -> PackedString
+       packCString,            -- :: _Addr  -> PackedString
+       packCBytes,             -- :: Int    -> _Addr -> PackedString
+
+       packStringST,           -- :: [Char] -> _ST s PackedString
+       packCBytesST,           -- :: Int    -> _Addr -> _ST s PackedString
+       packBytesForC,          -- :: [Char] -> _ByteArray Int
+       packBytesForCST,        -- :: [Char] -> _ST s (_ByteArray Int)
+
 --NO:  packStringForC,
 --NO:  packStringForC,
-       nilPS,
-       consPS,
-       byteArrayToPS,
-       psToByteArray,
+       nilPS,                  -- :: PackedString
+       consPS,                 -- :: Char -> PackedString -> PackedString
+       byteArrayToPS,          -- :: _ByteArray Int -> PackedString
+       psToByteArray,          -- :: PackedString -> _ByteArray Int
 
 
-       unpackPS,
+       unpackPS,               -- :: PackedString -> [Char]
 --NO:  unpackPS#,
 --NO:  unpackPS#,
-       putPS,
-
-       implode, explode, -- alt. names for packString, unpackPS
-
-       headPS,
-       tailPS,
-       nullPS,
-       appendPS,
-       lengthPS,
-       indexPS,
-       mapPS,
-       filterPS,
-       foldlPS,
-       foldrPS,
-       takePS,
-       dropPS,
-       splitAtPS,
-       takeWhilePS,
-       dropWhilePS,
-       spanPS,
-       breakPS,
-       linesPS,
-       wordsPS,
-       reversePS,
-       concatPS,
-
-       substrPS,
+       putPS,                  -- :: _FILE -> PackedString -> PrimIO ()
+       getPS,                  -- :: _FILE -> Int -> PrimIO PackedString
+
+        {- alt. names for packString, unpackPS -}
+       implode,                -- :: [Char] -> PackedString
+        explode,                       -- :: PackedString -> [Char]
+
+       headPS,                 -- :: PackedString -> Char
+       tailPS,                 -- :: PackedString -> PackedString
+       nullPS,                 -- :: PackedString -> Bool
+       appendPS,               -- :: PackedString -> PackedString -> PackedString
+       lengthPS,               -- :: PackedString -> Int
+       indexPS,                -- :: PackedString -> Int -> Char
+       mapPS,                  -- :: (Char -> Char) -> PackedString -> PackedString
+       filterPS,               -- :: (Char -> Bool) -> PackedString -> PackedString
+       foldlPS,                -- :: (a -> Char -> a) -> a -> PackedString -> a 
+       foldrPS,                -- :: (Char -> a -> a) -> a -> PackedString -> a
+       takePS,                 -- :: Int -> PackedString -> PackedString
+       dropPS,                 -- :: Int -> PackedString -> PackedString
+       splitAtPS,              -- :: Int -> PackedString -> PackedString
+       takeWhilePS,            -- :: (Char -> Bool) -> PackedString -> PackedString
+       dropWhilePS,            -- :: (Char -> Bool) -> PackedString -> PackedString
+       spanPS,                 -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
+       breakPS,                -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
+       linesPS,                -- :: PackedString -> [PackedString]
+       wordsPS,                -- :: PackedString -> [PackedString]
+       reversePS,              -- :: PackedString -> PackedString
+       concatPS,               -- :: [PackedString] -> PackedString
+
+       substrPS,               -- :: PackedString -> Int -> Int -> PackedString
 
        -- to make interface self-sufficient
        _PackedString, -- abstract!
        _FILE
     ) where
 
 
        -- to make interface self-sufficient
        _PackedString, -- abstract!
        _FILE
     ) where
 
+import PS
+
 type PackedString = _PackedString
 
 packString     = _packString
 type PackedString = _PackedString
 
 packString     = _packString
@@ -65,8 +76,14 @@ consPS               = _consPS
 byteArrayToPS  = _byteArrayToPS
 psToByteArray  = _psToByteArray
 
 byteArrayToPS  = _byteArrayToPS
 psToByteArray  = _psToByteArray
 
+packStringST    = _packStringST
+packCBytesST    = _packCBytesST
+packBytesForC   = _packBytesForC
+packBytesForCST = _packBytesForCST
+
 unpackPS       = _unpackPS
 putPS          = _putPS
 unpackPS       = _unpackPS
 putPS          = _putPS
+getPS          = _getPS
 
 implode                = _packString -- alt. names
 explode                = _unpackPS
 
 implode                = _packString -- alt. names
 explode                = _unpackPS
index e772849..c792186 100644 (file)
@@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
+getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
@@ -44,12 +46,20 @@ nilPS :: _PackedString
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
+packBytesForC :: [Char] -> _ByteArray Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-}
+packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
+packStringST :: [Char] -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-}
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
index e772849..c792186 100644 (file)
@@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
+getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
@@ -44,12 +46,20 @@ nilPS :: _PackedString
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
+packBytesForC :: [Char] -> _ByteArray Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-}
+packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
+packStringST :: [Char] -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-}
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
index e772849..c792186 100644 (file)
@@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
+getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
@@ -44,12 +46,20 @@ nilPS :: _PackedString
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
+packBytesForC :: [Char] -> _ByteArray Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-}
+packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
+packStringST :: [Char] -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-}
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
index e772849..c792186 100644 (file)
@@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-}
 foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-}
+getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
 headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-}
 implode :: [Char] -> _PackedString
@@ -44,12 +46,20 @@ nilPS :: _PackedString
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-}
 nullPS :: _PackedString -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-}
+packBytesForC :: [Char] -> _ByteArray Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-}
+packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCBytes :: Int -> _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
 packCString :: _Addr -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 packString :: [Char] -> _PackedString
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-}
+packStringST :: [Char] -> _State a -> (_PackedString, _State a)
+       {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-}
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
 psToByteArray :: _PackedString -> _ByteArray Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-}
 putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld)
index e3eeece..16cb021 100644 (file)
@@ -99,7 +99,7 @@ i.e. add the (KeyCode,RlCallbackFunction) key to the assoc. list and register
 the generic callback for this KeyCode.
 
 The entry point that $genericRlCback$ calls would then read the
 the generic callback for this KeyCode.
 
 The entry point that $genericRlCback$ calls would then read the
-global variables $current_i$ and $current_kc$ and do a lookup:
+global variables $current\_i$ and $current\_kc$ and do a lookup:
 
 \begin{code}
 rlAddDefun :: String ->                        -- Function Name
 
 \begin{code}
 rlAddDefun :: String ->                        -- Function Name
@@ -121,10 +121,10 @@ rlAddDefun name cback key =
 The C function $genericRlCallback$ puts the callback arguments into
 global variables and enters the Haskell world through the
 $haskellRlEntry$ function. Before exiting, the Haskell function will
 The C function $genericRlCallback$ puts the callback arguments into
 global variables and enters the Haskell world through the
 $haskellRlEntry$ function. Before exiting, the Haskell function will
-deposit its result in the global varariable $rl_return$.
+deposit its result in the global varariable $rl\_return$.
 
 In the Haskell action that is invoked via $enterStablePtr$, a match
 
 In the Haskell action that is invoked via $enterStablePtr$, a match
-between the Keycode in $current_kc$ and the Haskell callback needs to
+between the Keycode in $current\_kc$ and the Haskell callback needs to
 be made. To essentially keep the same assoc. list of (KeyCode,cback
 function) as Readline does, we make use of yet another global variable
 $cbackList$:
 be made. To essentially keep the same assoc. list of (KeyCode,cback
 function) as Readline does, we make use of yet another global variable
 $cbackList$:
index b0f9dee..ad1d956 100644 (file)
@@ -1,36 +1,38 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
-import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM)
+import FiniteMap(FiniteMap, keysFM, sizeFM)
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-type Set a = FiniteMap a ()
-elementOf :: Ord a => a -> FiniteMap a () -> Bool
+data Set a     {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-}
+cardinality :: Set a -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+elementOf :: Ord a => a -> Set a -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
-intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-}
-intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+emptySet :: Set a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+intersect :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+isEmptySet :: Set a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b ()
+mapSet :: Ord b => (a -> b) -> Set a -> Set b
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
-mkSet :: Ord a => [a] -> FiniteMap a ()
+minusSet :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+mkSet :: Ord a => [a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
-plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
-singletonSet :: a -> FiniteMap a ()
+setToList :: Set a -> [a]
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+singletonSet :: a -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
-unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a ()
+sizeFM :: FiniteMap a b -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+union :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+unionManySets :: Ord a => [Set a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance Eq a => Eq (Set a)
+       {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index c51160f..0ac419a 100644 (file)
@@ -1,5 +1,5 @@
 %
 %
-% (c) The AQUA Project, Glasgow University, 1994
+% (c) The AQUA Project, Glasgow University, 1994-1995
 %
 \section[Set]{An implementation of sets}
 
 %
 \section[Set]{An implementation of sets}
 
@@ -7,35 +7,26 @@ This new (94/04) implementation of sets sits squarely upon our
 implementation of @FiniteMaps@.  The interface is (roughly?) as
 before.
 
 implementation of @FiniteMaps@.  The interface is (roughly?) as
 before.
 
-See also the @UniqSet@ module (sets of things from which you can
-extract a @Unique@).
+(95/08: This module is no longer part of the GHC compiler proper; it
+is a GHC library module only, now.)
 
 \begin{code}
 
 \begin{code}
-#if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS)
-#define OUTPUTABLE_a , Outputable a
-#else
-#define OUTPUTABLE_a {--}
-#endif
-
 module Set (
 module Set (
-#if defined(__GLASGOW_HASKELL__)
-       Set(..),    -- abstract type: NOT
-#else
        -- not a synonym so we can make it abstract
        Set,
        -- not a synonym so we can make it abstract
        Set,
-#endif
 
        mkSet, setToList, emptySet, singletonSet,
        union, unionManySets, minusSet,
        elementOf, mapSet,
 
        mkSet, setToList, emptySet, singletonSet,
        union, unionManySets, minusSet,
        elementOf, mapSet,
-       intersect, isEmptySet
+       intersect, isEmptySet,
+       cardinality
        
        -- to make the interface self-sufficient
 #if defined(__GLASGOW_HASKELL__)
        , FiniteMap   -- abstract
 
        -- for pragmas
        
        -- to make the interface self-sufficient
 #if defined(__GLASGOW_HASKELL__)
        , FiniteMap   -- abstract
 
        -- for pragmas
-       , intersectFM, minusFM, keysFM, plusFM
+       , keysFM, sizeFM
 #endif
     ) where
 
 #endif
     ) where
 
@@ -45,28 +36,11 @@ import Maybes               ( maybeToBool
                           , Maybe(..)
 #endif
                        )
                           , Maybe(..)
 #endif
                        )
-#if defined(__GLASGOW_HASKELL__)
--- I guess this is here so that our friend USE_ATTACK_PRAGMAS can
--- do his job of seeking out and destroying information hiding. ADR
-import Util            --OLD: hiding ( Set(..), emptySet )
-#endif
-
-#if defined(COMPILING_GHC)
-import Outputable
-#endif
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-#if defined(__GLASGOW_HASKELL__)
-
-type Set a = FiniteMap a ()
-
-#define MkSet {--}
-
-#else
 -- This can't be a type synonym if you want to use constructor classes.
 data Set a = MkSet (FiniteMap a ()) {-# STRICT #-}
 -- This can't be a type synonym if you want to use constructor classes.
 data Set a = MkSet (FiniteMap a ()) {-# STRICT #-}
-#endif
 
 emptySet :: Set a
 emptySet = MkSet emptyFM
 
 emptySet :: Set a
 emptySet = MkSet emptyFM
@@ -77,27 +51,40 @@ singletonSet x = MkSet (singletonFM x ())
 setToList :: Set a -> [a]
 setToList (MkSet set) = keysFM set
 
 setToList :: Set a -> [a]
 setToList (MkSet set) = keysFM set
 
-mkSet :: (Ord a OUTPUTABLE_a) => [a]  -> Set a
+mkSet :: Ord a => [a]  -> Set a
 mkSet xs = MkSet (listToFM [ (x, ()) | x <- xs])
 
 mkSet xs = MkSet (listToFM [ (x, ()) | x <- xs])
 
-union :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a
+union :: Ord a => Set a -> Set a -> Set a
 union (MkSet set1) (MkSet set2) = MkSet (plusFM set1 set2)
 
 union (MkSet set1) (MkSet set2) = MkSet (plusFM set1 set2)
 
-unionManySets :: (Ord a OUTPUTABLE_a) => [Set a] -> Set a
+unionManySets :: Ord a => [Set a] -> Set a
 unionManySets ss = foldr union emptySet ss
 
 unionManySets ss = foldr union emptySet ss
 
-minusSet  :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a
+minusSet  :: Ord a => Set a -> Set a -> Set a
 minusSet (MkSet set1) (MkSet set2) = MkSet (minusFM set1 set2)
 
 minusSet (MkSet set1) (MkSet set2) = MkSet (minusFM set1 set2)
 
-intersect :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a
+intersect :: Ord a => Set a -> Set a -> Set a
 intersect (MkSet set1) (MkSet set2) = MkSet (intersectFM set1 set2)
 
 intersect (MkSet set1) (MkSet set2) = MkSet (intersectFM set1 set2)
 
-elementOf :: (Ord a OUTPUTABLE_a) => a -> Set a -> Bool
+elementOf :: Ord a => a -> Set a -> Bool
 elementOf x (MkSet set) = maybeToBool(lookupFM set x)
 
 isEmptySet :: Set a -> Bool
 isEmptySet (MkSet set) = sizeFM set == 0
 
 elementOf x (MkSet set) = maybeToBool(lookupFM set x)
 
 isEmptySet :: Set a -> Bool
 isEmptySet (MkSet set) = sizeFM set == 0
 
-mapSet :: (Ord a OUTPUTABLE_a) => (b -> a) -> Set b -> Set a
+mapSet :: Ord a => (b -> a) -> Set b -> Set a
 mapSet f (MkSet set) = MkSet (listToFM [ (f key, ()) | key <- keysFM set ])
 mapSet f (MkSet set) = MkSet (listToFM [ (f key, ()) | key <- keysFM set ])
+
+cardinality :: Set a -> Int
+cardinality (MkSet set) = sizeFM set
+
+-- fair enough...
+instance (Eq a) => Eq (Set a) where
+  (MkSet set_1) == (MkSet set_2) = set_1 == set_2
+
+-- but not so clear what the right thing to do is:
+{- NO:
+instance (Ord a) => Ord (Set a) where
+  (MkSet set_1) <= (MkSet set_2) = set_1 <= set_2
+-}
 \end{code}
 \end{code}
index b0f9dee..ad1d956 100644 (file)
@@ -1,36 +1,38 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
-import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM)
+import FiniteMap(FiniteMap, keysFM, sizeFM)
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-type Set a = FiniteMap a ()
-elementOf :: Ord a => a -> FiniteMap a () -> Bool
+data Set a     {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-}
+cardinality :: Set a -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+elementOf :: Ord a => a -> Set a -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
-intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-}
-intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+emptySet :: Set a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+intersect :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+isEmptySet :: Set a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b ()
+mapSet :: Ord b => (a -> b) -> Set a -> Set b
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
-mkSet :: Ord a => [a] -> FiniteMap a ()
+minusSet :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+mkSet :: Ord a => [a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
-plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
-singletonSet :: a -> FiniteMap a ()
+setToList :: Set a -> [a]
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+singletonSet :: a -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
-unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a ()
+sizeFM :: FiniteMap a b -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+union :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+unionManySets :: Ord a => [Set a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance Eq a => Eq (Set a)
+       {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index b0f9dee..ad1d956 100644 (file)
@@ -1,36 +1,38 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
-import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM)
+import FiniteMap(FiniteMap, keysFM, sizeFM)
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-type Set a = FiniteMap a ()
-elementOf :: Ord a => a -> FiniteMap a () -> Bool
+data Set a     {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-}
+cardinality :: Set a -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+elementOf :: Ord a => a -> Set a -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
-intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-}
-intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+emptySet :: Set a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+intersect :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+isEmptySet :: Set a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b ()
+mapSet :: Ord b => (a -> b) -> Set a -> Set b
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
-mkSet :: Ord a => [a] -> FiniteMap a ()
+minusSet :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+mkSet :: Ord a => [a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
-plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
-singletonSet :: a -> FiniteMap a ()
+setToList :: Set a -> [a]
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+singletonSet :: a -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
-unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a ()
+sizeFM :: FiniteMap a b -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+union :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+unionManySets :: Ord a => [Set a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance Eq a => Eq (Set a)
+       {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index b0f9dee..ad1d956 100644 (file)
@@ -1,36 +1,38 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
-import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM)
+import FiniteMap(FiniteMap, keysFM, sizeFM)
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-type Set a = FiniteMap a ()
-elementOf :: Ord a => a -> FiniteMap a () -> Bool
+data Set a     {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-}
+cardinality :: Set a -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+elementOf :: Ord a => a -> Set a -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
-intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-}
-intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+emptySet :: Set a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+intersect :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+isEmptySet :: Set a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b ()
+mapSet :: Ord b => (a -> b) -> Set a -> Set b
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
-mkSet :: Ord a => [a] -> FiniteMap a ()
+minusSet :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+mkSet :: Ord a => [a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
-plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
-singletonSet :: a -> FiniteMap a ()
+setToList :: Set a -> [a]
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+singletonSet :: a -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
-unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a ()
+sizeFM :: FiniteMap a b -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+union :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+unionManySets :: Ord a => [Set a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance Eq a => Eq (Set a)
+       {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index b0f9dee..ad1d956 100644 (file)
@@ -1,36 +1,38 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
-import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM)
+import FiniteMap(FiniteMap, keysFM, sizeFM)
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-type Set a = FiniteMap a ()
-elementOf :: Ord a => a -> FiniteMap a () -> Bool
+data Set a     {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-}
+cardinality :: Set a -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+elementOf :: Ord a => a -> Set a -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
-intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-}
-intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+emptySet :: Set a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+intersect :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+isEmptySet :: Set a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b ()
+mapSet :: Ord b => (a -> b) -> Set a -> Set b
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
-mkSet :: Ord a => [a] -> FiniteMap a ()
+minusSet :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+mkSet :: Ord a => [a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
-plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
-singletonSet :: a -> FiniteMap a ()
+setToList :: Set a -> [a]
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+singletonSet :: a -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
-unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a ()
+sizeFM :: FiniteMap a b -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+union :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+unionManySets :: Ord a => [Set a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance Eq a => Eq (Set a)
+       {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index b0f9dee..ad1d956 100644 (file)
@@ -1,36 +1,38 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Set where
-import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM)
+import FiniteMap(FiniteMap, keysFM, sizeFM)
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
 data FiniteMap a b     {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-type Set a = FiniteMap a ()
-elementOf :: Ord a => a -> FiniteMap a () -> Bool
+data Set a     {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-}
+cardinality :: Set a -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+elementOf :: Ord a => a -> Set a -> Bool
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-emptySet :: FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-}
-intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-}
-intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-isEmptySet :: FiniteMap a () -> Bool
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
+emptySet :: Set a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
+intersect :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+isEmptySet :: Set a -> Bool
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 keysFM :: FiniteMap b a -> [b]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b ()
+mapSet :: Ord b => (a -> b) -> Set a -> Set b
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-}
-minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-}
-mkSet :: Ord a => [a] -> FiniteMap a ()
+minusSet :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+mkSet :: Ord a => [a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-}
-plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-}
-setToList :: FiniteMap a () -> [a]
-       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-}
-singletonSet :: a -> FiniteMap a ()
+setToList :: Set a -> [a]
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_  _TYAPP_  _TYAPP_  _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-}
+singletonSet :: a -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
-union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a ()
-       {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_  _TYAPP_  _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-}
-unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a ()
+sizeFM :: FiniteMap a b -> Int
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM  -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-}
+union :: Ord a => Set a -> Set a -> Set a
+       {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-}
+unionManySets :: Ord a => [Set a] -> Set a
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance (Eq a, Eq b) => Eq (FiniteMap a b)
+       {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
+instance Eq a => Eq (Set a)
+       {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 
 
index 5326dd7..1ab6bf2 100644 (file)
@@ -26,20 +26,15 @@ module Socket (
     Socket
 ) where
 
     Socket
 ) where
 
-
 import BSD
 import SocketPrim renaming (accept to socketPrim_accept
                        , socketPort to socketPort_prim
                        )
 import BSD
 import SocketPrim renaming (accept to socketPrim_accept
                        , socketPort to socketPort_prim
                        )
-
-           
-
 \end{code} 
 
 \end{code} 
 
-
 %***************************************************************************
 %*                                                                         *
 %***************************************************************************
 %*                                                                         *
-\subsection[Socket-Setup]{High Level "Setup" functions}
+\subsection[Socket-Setup]{High Level ``Setup'' functions}
 %*                                                                         *
 %***************************************************************************
 
 %*                                                                         *
 %***************************************************************************
 
@@ -62,26 +57,25 @@ data PortID =
 type Hostname = String
 -- Maybe consider this alternative.
 -- data Hostname = Name String | IP Int Int Int Int
 type Hostname = String
 -- Maybe consider this alternative.
 -- data Hostname = Name String | IP Int Int Int Int
-
-
 \end{code}
    
 If more control over the socket type is required then $socketPrim$
 should be used instead.
 
 \end{code}
    
 If more control over the socket type is required then $socketPrim$
 should be used instead.
 
-
-
 \begin{code}
 connectTo :: Hostname ->               -- Hostname
             PortID ->                  -- Port Identifier
             IO Handle                  -- Connected Socket
 \begin{code}
 connectTo :: Hostname ->               -- Hostname
             PortID ->                  -- Port Identifier
             IO Handle                  -- Connected Socket
+
 connectTo hostname (Service serv) =
     getProtocolNumber "tcp"                    >>= \ proto ->
     socket AF_INET Stream proto                        >>= \ sock ->
     getServicePortNumber serv                  >>= \ port ->
     getHostByName hostname     >>= \ (HostEntry _ _ _ haddrs) ->
     connect sock (SockAddrInet port (head haddrs))     >>
 connectTo hostname (Service serv) =
     getProtocolNumber "tcp"                    >>= \ proto ->
     socket AF_INET Stream proto                        >>= \ sock ->
     getServicePortNumber serv                  >>= \ port ->
     getHostByName hostname     >>= \ (HostEntry _ _ _ haddrs) ->
     connect sock (SockAddrInet port (head haddrs))     >>
-    socketToHandle sock
+    socketToHandle sock                >>= \ h ->
+    hSetBuffering h NoBuffering >>
+    return h
 connectTo hostname (PortNumber port) =
     getProtocolNumber "tcp"                    >>= \ proto ->
     socket AF_INET Stream proto                        >>= \ sock ->
 connectTo hostname (PortNumber port) =
     getProtocolNumber "tcp"                    >>= \ proto ->
     socket AF_INET Stream proto                        >>= \ sock ->
@@ -94,13 +88,13 @@ connectTo _ (UnixSocket path) =
     socketToHandle sock
 \end{code}
 
     socketToHandle sock
 \end{code}
 
-
 The dual to the $connectTo$ call. This creates the server side
 socket which has been bound to the specified port.
 
 \begin{code}
 listenOn ::  PortID ->                 -- Port Identifier
             IO Socket                  -- Connected Socket
 The dual to the $connectTo$ call. This creates the server side
 socket which has been bound to the specified port.
 
 \begin{code}
 listenOn ::  PortID ->                 -- Port Identifier
             IO Socket                  -- Connected Socket
+
 listenOn (Service serv) =
     getProtocolNumber "tcp"                    >>= \ proto ->
     socket AF_INET Stream proto                        >>= \ sock ->
 listenOn (Service serv) =
     getProtocolNumber "tcp"                    >>= \ proto ->
     socket AF_INET Stream proto                        >>= \ sock ->
@@ -124,6 +118,7 @@ listeOn (UnixSocket path) =
 accept :: Socket ->            -- Listening Socket
          IO (Handle,           -- StdIO Handle for read/write
              HostName)         -- HostName of Peer socket
 accept :: Socket ->            -- Listening Socket
          IO (Handle,           -- StdIO Handle for read/write
              HostName)         -- HostName of Peer socket
+
 accept sock =
     socketPrim_accept sock         >>= \ (sock', (SockAddrInet _ haddr)) ->
     getHostByAddr AF_INET haddr            >>= \ (HostEntry peer _ _ _) ->
 accept sock =
     socketPrim_accept sock         >>= \ (sock', (SockAddrInet _ haddr)) ->
     getHostByAddr AF_INET haddr            >>= \ (HostEntry peer _ _ _) ->
@@ -142,17 +137,16 @@ sendTo :: Hostname ->                     -- Hostname
          PortID->                      -- Port Number
          String ->                     -- Message to send
          IO ()
          PortID->                      -- Port Number
          String ->                     -- Message to send
          IO ()
+
 sendTo h p msg = 
     connectTo h p                      >>= \ s ->
     hPutStr s msg                      >>
     hClose s
 
 sendTo h p msg = 
     connectTo h p                      >>= \ s ->
     hPutStr s msg                      >>
     hClose s
 
-
-
-
 recvFrom :: Hostname ->                        -- Hostname
            PortID->                    -- Port Number
            IO String                   -- Received Data
 recvFrom :: Hostname ->                        -- Hostname
            PortID->                    -- Port Number
            IO String                   -- Received Data
+
 recvFrom host port =
     listenOn port                      >>= \ s ->
     let 
 recvFrom host port =
     listenOn port                      >>= \ s ->
     let 
@@ -170,13 +164,13 @@ recvFrom host port =
        waiting                         >>= \ message ->
        sClose s                        >>
        return message
        waiting                         >>= \ message ->
        sClose s                        >>
        return message
-
 \end{code}
 
 
 
 \begin{code}
 socketPort :: Socket -> IO PortID
 \end{code}
 
 
 
 \begin{code}
 socketPort :: Socket -> IO PortID
+
 socketPort s =
     getSocketName s                    >>= \ sockaddr ->
     return (case sockaddr of
 socketPort s =
     getSocketName s                    >>= \ sockaddr ->
     return (case sockaddr of
@@ -185,5 +179,4 @@ socketPort s =
                SockAddrUnix path       ->
                    (UnixSocket path)
            )
                SockAddrUnix path       ->
                    (UnixSocket path)
            )
-
 \end{code}
 \end{code}
index 4595611..6ba97a6 100644 (file)
@@ -5,7 +5,7 @@ import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
-data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX
+data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
@@ -112,14 +112,14 @@ instance Ord SocketType
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 917b68f..5720a10 100644 (file)
@@ -3,8 +3,10 @@
 %
 % Last Modified: Fri Jul 21 15:14:43 1995
 % Darren J Moffat <moffatd@dcs.gla.ac.uk>
 %
 % Last Modified: Fri Jul 21 15:14:43 1995
 % Darren J Moffat <moffatd@dcs.gla.ac.uk>
-\section[Socket]{Haskell 1.3 Socket bindings}
+\section[SocketPrim]{Low-level socket bindings}
 
 
+The @SocketPrim@ module is for when you want full control over the
+sockets, something like what you have in C (which is very messy).
 
 \begin{code}      
 module SocketPrim (
 
 \begin{code}      
 module SocketPrim (
@@ -98,27 +100,26 @@ on sockets.
 
 
 \begin{code}  
 
 
 \begin{code}  
-data SocketStatus = 
-                -- Returned Status               Function called
-                  NotConnected                 -- socket
-                | Bound                        -- bindSocket
-                | Listening                    -- listen
-                | Connected                    -- connect/accept
-                | Error String                 -- Any
-                  deriving (Eq, Text)
-
-data Socket = MkSocket 
-               Int                                     -- File Descriptor Part
-               Family
-               SocketType
-               Int                                     -- Protocol Number
-               (MutableVar _RealWorld SocketStatus)    -- Status Flag
-
-
+data SocketStatus
+  -- Returned Status   Function called
+  = NotConnected       -- socket
+  | Bound              -- bindSocket
+  | Listening          -- listen
+  | Connected          -- connect/accept
+  | Error String       -- Any
+  deriving (Eq, Text)
+
+data Socket
+  = MkSocket 
+     Int                                 -- File Descriptor Part
+     Family                              
+     SocketType                                  
+     Int                                 -- Protocol Number
+     (MutableVar _RealWorld SocketStatus) -- Status Flag
 \end{code}
 
 \end{code}
 
-In C bind takes either a $struct sockaddr_in$ or a $struct
-sockaddr_un$ but these are always type cast to $struct sockaddr$.  We
+In C bind takes either a $struct sockaddr\_in$ or a $struct
+sockaddr\_un$ but these are always type cast to $struct sockaddr$.  We
 attempt to emulate this and provide better type checking. Note that
 the socket family fields are redundant since this is caputured in the
 constructor names, it has thus be left out of the Haskell $SockAddr$
 attempt to emulate this and provide better type checking. Note that
 the socket family fields are redundant since this is caputured in the
 constructor names, it has thus be left out of the Haskell $SockAddr$
@@ -128,16 +129,15 @@ data type.
 \begin{code}
 type HostAddress = _Word
 
 \begin{code}
 type HostAddress = _Word
 
-data SockAddr =                -- C Names                              
-    SockAddrUnix       -- struct sockaddr_un
+data SockAddr          -- C Names                              
+  = SockAddrUnix       -- struct sockaddr_un
        String          -- sun_path
                  
   | SockAddrInet       -- struct sockaddr_in
        Int             -- sin_port
        HostAddress     -- sin_addr
 
        String          -- sun_path
                  
   | SockAddrInet       -- struct sockaddr_in
        Int             -- sin_port
        HostAddress     -- sin_addr
 
-    deriving Eq
-      
+  deriving Eq
 \end{code}
 
 
 \end{code}
 
 
@@ -155,7 +155,6 @@ be noted that some of these names used in the C library, bind in
 particular, have a different meaning to many Haskell programmers and
 have thus been renamed by appending the prefix Socket.
 
 particular, have a different meaning to many Haskell programmers and
 have thus been renamed by appending the prefix Socket.
 
-
 Create an unconnected socket of the given family, type and protocol.
 The most common invocation of $socket$ is the following:
 \begin{verbatim}
 Create an unconnected socket of the given family, type and protocol.
 The most common invocation of $socket$ is the following:
 \begin{verbatim}
@@ -202,7 +201,7 @@ Given a port number this {\em binds} the socket to that port. This
 means that the programmer is only interested in data being sent to
 that port number. The $Family$ passed to $bindSocket$ must
 be the same as that passed to $socket$.         If the special port
 means that the programmer is only interested in data being sent to
 that port number. The $Family$ passed to $bindSocket$ must
 be the same as that passed to $socket$.         If the special port
-number $aNY_PORT$ is passed then the system assigns the next
+number $aNY\_PORT$ is passed then the system assigns the next
 available use port.
 
 Port numbers for standard unix services can be found by calling
 available use port.
 
 Port numbers for standard unix services can be found by calling
@@ -210,7 +209,7 @@ $getServiceEntry$.  These are traditionally port numbers below
 1000; although there are afew, namely NFS and IRC, which used higher
 numbered ports.
 
 1000; although there are afew, namely NFS and IRC, which used higher
 numbered ports.
 
-The port number allocated to a socket bound by using $aNY_PORT$ can be
+The port number allocated to a socket bound by using $aNY\_PORT$ can be
 found by calling $port$
 
 \begin{code}
 found by calling $port$
 
 \begin{code}
@@ -251,7 +250,6 @@ bindSocket (MkSocket s family stype protocol status) addr =
        else
          writeVar status (Bound)                               `seqPrimIO`
          return ()
        else
          writeVar status (Bound)                               `seqPrimIO`
          return ()
-
 \end{code}
        
 
 \end{code}
        
 
@@ -403,7 +401,6 @@ accept sock@(MkSocket s family stype protocol status) =
            unpackSockAddr ptr                  `thenPrimIO` \ addr ->
            newVar Connected                    `thenPrimIO` \ status ->
            return ((MkSocket sock family stype protocol status), addr)
            unpackSockAddr ptr                  `thenPrimIO` \ addr ->
            newVar Connected                    `thenPrimIO` \ status ->
            return ((MkSocket sock family stype protocol status), addr)
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -520,12 +517,11 @@ readSocketAll s =
            return xs
     in
        loop ""
            return xs
     in
        loop ""
-
 \end{code}
 
 The port number the given socket is currently connected to can be
 determined by calling $port$, is generally only useful when bind
 \end{code}
 
 The port number the given socket is currently connected to can be
 determined by calling $port$, is generally only useful when bind
-was given $aNY_PORT$.
+was given $aNY\_PORT$.
 
 \begin{code}
 socketPort :: Socket ->                        -- Connected & Bound Socket
 
 \begin{code}
 socketPort :: Socket ->                        -- Connected & Bound Socket
@@ -618,9 +614,9 @@ A calling sequence table for the main functions is shown in the table below.
 \begin{center}
 \begin{tabular}{|l|c|c|c|c|c|c|c|}
 \hline
 \begin{center}
 \begin{tabular}{|l|c|c|c|c|c|c|c|}
 \hline
-\textbf{A Call to} & socket & connect & bindSocket & listen & accept & read & write \\
+{\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\
 \hline
 \hline
-\textbf{Precedes} & & & & & & & \\
+{\bf Precedes} & & & & & & & \\
 \hline 
 socket &       &         &            &        &        &      & \\
 \hline
 \hline 
 socket &       &         &            &        &        &      & \\
 \hline
@@ -644,7 +640,7 @@ write  &    &   +     &            &  +     &  +     &  +   & + \\
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsection[Socket-OSDefs]{OS Dependant Definitions}
+\subsection[Socket-OSDefs]{OS Dependent Definitions}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
@@ -653,8 +649,8 @@ The following Family and Socket Type declarations were manually derived
 from /usr/include/sys/socket.h on the appropriate machines.
 
 Maybe a configure script that could parse the socket.h file to produce
 from /usr/include/sys/socket.h on the appropriate machines.
 
 Maybe a configure script that could parse the socket.h file to produce
-the following declaration is required to make it "portable" rather than
-using the dreded \#ifdefs.
+the following declaration is required to make it ``portable'' rather than
+using the dreaded \#ifdefs.
 
 Presently only the following machine/os combinations are supported:
 
 
 Presently only the following machine/os combinations are supported:
 
@@ -666,7 +662,6 @@ Presently only the following machine/os combinations are supported:
 \end{itemize}
 
 \begin{code}
 \end{itemize}
 
 \begin{code}
-
 unpackFamily   :: Int -> Family
 packFamily     :: Family -> Int
 
 unpackFamily   :: Int -> Family
 packFamily     :: Family -> Int
 
@@ -795,7 +790,6 @@ data SocketType =
 
 packSocketType stype = 1 + (index (Stream, Packet) stype)      
 #endif
 
 packSocketType stype = 1 + (index (Stream, Packet) stype)      
 #endif
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
index 4595611..6ba97a6 100644 (file)
@@ -5,7 +5,7 @@ import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
-data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX
+data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
@@ -112,14 +112,14 @@ instance Ord SocketType
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 4595611..64a96f2 100644 (file)
@@ -5,7 +5,7 @@ import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
-data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX
+data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
@@ -113,13 +113,13 @@ instance Ord SocketType
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 4595611..6ba97a6 100644 (file)
@@ -5,7 +5,7 @@ import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
-data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX
+data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
@@ -112,14 +112,14 @@ instance Ord SocketType
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 4595611..6ba97a6 100644 (file)
@@ -5,7 +5,7 @@ import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
-data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX
+data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
@@ -112,14 +112,14 @@ instance Ord SocketType
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index 4595611..6ba97a6 100644 (file)
@@ -5,7 +5,7 @@ import PreludeIOError(IOError13)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
 import PreludeMonadicIO(Either)
 import PreludePrimIO(_MVar)
 import PreludeStdIO(_Handle)
-data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX
+data Family   = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
 type HostAddress = _Word
 data SockAddr   = SockAddrUnix [Char] | SockAddrInet Int _Word
 data Socket 
@@ -112,14 +112,14 @@ instance Ord SocketType
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Family
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text SocketType
        {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-        showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
+        showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
index def8023..96b9599 100644 (file)
@@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
@@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> ((
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
index a4db1d2..75d4f45 100644 (file)
@@ -705,8 +705,28 @@ readVar  :: MutableVar s a -> _ST s a
 writeVar :: MutableVar s a -> a -> _ST s ()
 sameVar  :: MutableVar s a -> MutableVar s a -> Bool
 
 writeVar :: MutableVar s a -> a -> _ST s ()
 sameVar  :: MutableVar s a -> MutableVar s a -> Bool
 
+{- MUCH GRATUITOUS INEFFICIENCY: WDP 95/09:
+
 newVar init    s = newArray (0,0) init s
 readVar v      s = readArray v 0 s
 writeVar v val s = writeArray v 0 val s
 sameVar v1 v2    = sameMutableArray v1 v2
 newVar init    s = newArray (0,0) init s
 readVar v      s = readArray v 0 s
 writeVar v val s = writeArray v 0 val s
 sameVar v1 v2    = sameMutableArray v1 v2
+-}
+
+newVar init (S# s#)
+  = case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
+    (_MutableArray vAR_IXS arr#, S# s2#) }
+  where
+    vAR_IXS = error "Shouldn't access `bounds' of a MutableVar\n"
+
+readVar (_MutableArray _ var#) (S# s#)
+  = case readArray# var# 0# s# of { StateAndPtr# s2# r ->
+    (r, S# s2#) }
+
+writeVar (_MutableArray _ var#) val (S# s#)
+  = case writeArray# var# 0# val s# of { s2# ->
+    ((), S# s2#) }
+
+sameVar (_MutableArray _ var1#) (_MutableArray _ var2#)
+  = sameMutableArray# var1# var2#
 \end{code}
 \end{code}
index b771c3d..3f8a2b9 100644 (file)
@@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
@@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> ((
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
index def8023..96b9599 100644 (file)
@@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
@@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> ((
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
index def8023..96b9599 100644 (file)
@@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
@@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> ((
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
index def8023..96b9599 100644 (file)
@@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
@@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> ((
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
index def8023..96b9599 100644 (file)
@@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
 readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b)
        {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 readVar :: _MutableArray a Int b -> _State a -> (b, _State a)
-       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
 returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-}
 returnST :: b -> _State a -> (b, _State a)
@@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> ((
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
 writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b)
        {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-}
 writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b)
-       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
 instance Eq _FILE
        {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_
         (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
index c3db93e..5cba859 100644 (file)
@@ -10,12 +10,14 @@ import PreludeGlaST
 
 getCPUTime :: IO Integer
 getCPUTime =
 
 getCPUTime :: IO Integer
 getCPUTime =
-    _ccall_ getCPUTime                             `thenPrimIO` \ ptr@(A# ptr#) ->
-    if ptr /= ``NULL'' then
-        return (fromInt (I# (indexIntOffAddr# ptr# 0#)) * 1000000000 + 
-                fromInt (I# (indexIntOffAddr# ptr# 1#)) + 
-               fromInt (I# (indexIntOffAddr# ptr# 2#)) * 1000000000 + 
-                fromInt (I# (indexIntOffAddr# ptr# 3#)))
+    newIntArray (0,3)                              `thenPrimIO` \ marr ->
+    unsafeFreezeByteArray marr                     `thenPrimIO` \ barr@(_ByteArray _ frozen#) ->
+    _ccall_ getCPUTime barr                        `thenPrimIO` \ ptr ->
+    if (ptr::_Addr) /= ``NULL'' then
+        return (fromInt (I# (indexIntArray# frozen# 0#)) * 1000000000 + 
+                fromInt (I# (indexIntArray# frozen# 1#)) + 
+               fromInt (I# (indexIntArray# frozen# 2#)) * 1000000000 + 
+                fromInt (I# (indexIntArray# frozen# 3#)))
     else
        failWith (UnsupportedOperation "can't get CPU time")
 
     else
        failWith (UnsupportedOperation "can't get CPU time")
 
@@ -29,3 +31,4 @@ implementation-dependent.
 
 
 
 
 
 
index a6ec46f..6b61f3b 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
-import LibDirectory(removeDirectory)
+import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
@@ -54,6 +54,8 @@ type ProcessGroupID = Int
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
+getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
@@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
@@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
+setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
@@ -654,13 +658,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index e97215e..46b66a6 100644 (file)
@@ -27,9 +27,12 @@ module LibPosix  (
     ProcessGroupID(..),
     UserID(..),
     
     ProcessGroupID(..),
     UserID(..),
     
-    ExitCode
-    )  where
+    ExitCode,
+
+    -- make interface complete:
+    setCurrentDirectory{-pragmas-}, getCurrentDirectory{-pragmas-}
 
 
+    )  where
 
 import LibPosixDB
 import LibPosixErr
 
 import LibPosixDB
 import LibPosixErr
@@ -43,7 +46,7 @@ import LibPosixUtil
 -- runProcess is our candidate for the high-level OS-independent primitive 
 -- If accepted, it will be moved out of LibPosix into LibSystem.
 
 -- runProcess is our candidate for the high-level OS-independent primitive 
 -- If accepted, it will be moved out of LibPosix into LibSystem.
 
-import LibDirectory    ( setCurrentDirectory )
+import LibDirectory    ( setCurrentDirectory, getCurrentDirectory{-pragmas-} )
 
 import PreludeGlaST
 import PreludePrimIO   ( takeMVar, putMVar, _MVar )
 
 import PreludeGlaST
 import PreludePrimIO   ( takeMVar, putMVar, _MVar )
index 335aecc..c27d8e1 100644 (file)
@@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
index f2caeb4..d885c16 100644 (file)
@@ -247,7 +247,8 @@ openChannel name how maybe_mode append excl noctty nonblock trunc =
     creat# = case creat of { W# x -> x }
 
     flags = W# (creat# `or#` append# `or#` excl# `or#` 
     creat# = case creat of { W# x -> x }
 
     flags = W# (creat# `or#` append# `or#` excl# `or#` 
-                noctty# `or#` nonblock# `or#` trunc#)
+                noctty# `or#` nonblock# `or#` trunc# `or#` how#)
+    how#      = case (case how of { ReadOnly -> ``O_RDONLY'';WriteOnly -> ``O_WRONLY'';ReadWrite -> ``O_RDWR''}) of { W# x -> x }
     append#   = case (if append   then ``O_APPEND''   else ``0'') of { W# x -> x }
     excl#     = case (if excl     then ``O_EXCL''     else ``0'') of { W# x -> x }
     noctty#   = case (if noctty   then ``O_NOCTTY''   else ``0'') of { W# x -> x }
     append#   = case (if append   then ``O_APPEND''   else ``0'') of { W# x -> x }
     excl#     = case (if excl     then ``O_EXCL''     else ``0'') of { W# x -> x }
     noctty#   = case (if noctty   then ``O_NOCTTY''   else ``0'') of { W# x -> x }
index 335aecc..c27d8e1 100644 (file)
@@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
index 335aecc..c27d8e1 100644 (file)
@@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
index 335aecc..c27d8e1 100644 (file)
@@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
index 335aecc..c27d8e1 100644 (file)
@@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
index 335aecc..c27d8e1 100644 (file)
@@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
index b02e2ef..3c57a24 100644 (file)
@@ -180,13 +180,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index b02e2ef..3c57a24 100644 (file)
@@ -180,13 +180,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 866badf..22cabc1 100644 (file)
@@ -180,13 +180,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index b02e2ef..3c57a24 100644 (file)
@@ -180,13 +180,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index b02e2ef..3c57a24 100644 (file)
@@ -180,13 +180,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index a6ec46f..6b61f3b 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
-import LibDirectory(removeDirectory)
+import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
@@ -54,6 +54,8 @@ type ProcessGroupID = Int
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
+getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
@@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
@@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
+setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
@@ -654,13 +658,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index a6ec46f..2f7d0f0 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
-import LibDirectory(removeDirectory)
+import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
@@ -54,6 +54,8 @@ type ProcessGroupID = Int
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
+getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
@@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
@@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
+setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
index 2019d50..2a3026b 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
-import LibDirectory(removeDirectory)
+import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
@@ -54,6 +54,8 @@ type ProcessGroupID = Int
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
+getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
@@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
@@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
+setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
@@ -654,13 +658,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index a6ec46f..6b61f3b 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
-import LibDirectory(removeDirectory)
+import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
@@ -54,6 +54,8 @@ type ProcessGroupID = Int
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
+getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
@@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
@@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
+setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
@@ -654,13 +658,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index a6ec46f..6b61f3b 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface LibPosix where
-import LibDirectory(removeDirectory)
+import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
 import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell)
 import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem)
 import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes)
@@ -54,6 +54,8 @@ type ProcessGroupID = Int
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
 type ProcessID = Int
 type UserID = Int
 data ExitCode  {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-}
+getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
 removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld)
@@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
 nullFileMode :: _Word
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld)
-       {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+       {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-}
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
 openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld)
        {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-}
 otherExecuteMode :: _Word
@@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-}
+setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
 userGroupID :: UserEntry -> Int
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-}
 userID :: UserEntry -> Int
@@ -654,13 +658,13 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ProcessStatus
        {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 5569655..a82df1a 100644 (file)
@@ -28,7 +28,7 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 5569655..a82df1a 100644 (file)
@@ -28,7 +28,7 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 5569655..a82df1a 100644 (file)
@@ -28,7 +28,7 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 5569655..a82df1a 100644 (file)
@@ -28,7 +28,7 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 5569655..a82df1a 100644 (file)
@@ -28,7 +28,7 @@ instance Ord ExitCode
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
         _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Text ExitCode
        {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 36b2b28..e3d6607 100644 (file)
@@ -24,6 +24,7 @@ module LibTime (
 import PreludeIOError
 import PreludeGlaST
 import PS
 import PreludeIOError
 import PreludeGlaST
 import PS
+import LibPosixUtil (allocWords, allocChars)
 
 \end{code}
 
 
 \end{code}
 
@@ -47,7 +48,8 @@ we use the C library routines based on 32 bit integers.
 instance Text ClockTime where
     showsPrec p (TOD sec@(J# a# s# d#) nsec) = 
         showString (unsafePerformPrimIO (
 instance Text ClockTime where
     showsPrec p (TOD sec@(J# a# s# d#) nsec) = 
         showString (unsafePerformPrimIO (
-           _ccall_ showTime (I# s#) (_ByteArray (error "ClockTime.show") d#)
+           allocChars 32       `thenPrimIO` \ buf ->
+           _ccall_ showTime (I# s#) (_ByteArray (error "ClockTime.show") d#) buf
                                                    `thenPrimIO` \ str ->
             _ccall_ strlen str                     `thenPrimIO` \ len ->
             _packCBytesST len str                  `thenStrictlyST` \ ps ->
                                                    `thenPrimIO` \ str ->
             _ccall_ strlen str                     `thenPrimIO` \ len ->
             _packCBytesST len str                  `thenStrictlyST` \ ps ->
@@ -155,7 +157,10 @@ ignored.
 \begin{code}
 toCalendarTime :: ClockTime -> CalendarTime
 toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 \begin{code}
 toCalendarTime :: ClockTime -> CalendarTime
 toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
-    _ccall_ toLocalTime (I# s#) (_ByteArray (error "toCalendarTime") d#)
+    allocWords (``sizeof(struct tm)''::Int) `thenPrimIO` \ res ->
+    allocChars 32                          `thenPrimIO` \ zoneNm ->
+    _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm          `thenPrimIO` \ () ->
+    _ccall_ toLocalTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res
                                                    `thenPrimIO` \ tm ->
     if tm == (``NULL''::_Addr) then
        error "toCalendarTime{LibTime}: out of range"
                                                    `thenPrimIO` \ tm ->
     if tm == (``NULL''::_Addr) then
        error "toCalendarTime{LibTime}: out of range"
@@ -178,8 +183,8 @@ toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
                                                    `thenPrimIO` \ yday ->
        _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm
                                                    `thenPrimIO` \ isdst ->
                                                    `thenPrimIO` \ yday ->
        _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm
                                                    `thenPrimIO` \ isdst ->
-       _ccall_ ZONE tm                             `thenPrimIO` \ zone ->
-       _ccall_ GMTOFF tm                           `thenPrimIO` \ tz ->
+       _ccall_ ZONE tm                             `thenPrimIO` \ zone ->
+       _ccall_ GMTOFF tm                           `thenPrimIO` \ tz ->
         _ccall_ strlen zone                        `thenPrimIO` \ len ->
         _packCBytesST len zone                     `thenStrictlyST` \ tzname ->
         returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec 
         _ccall_ strlen zone                        `thenPrimIO` \ len ->
         _packCBytesST len zone                     `thenStrictlyST` \ tzname ->
         returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec 
@@ -188,7 +193,10 @@ toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 
 toUTCTime :: ClockTime -> CalendarTime
 toUTCTime  (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 
 toUTCTime :: ClockTime -> CalendarTime
 toUTCTime  (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
-        _ccall_ toUTCTime (I# s#) (_ByteArray (error "toCalendarTime") d#)
+       allocWords (``sizeof(struct tm)''::Int)                     `thenPrimIO` \ res ->
+        allocChars 32                                              `thenPrimIO` \ zoneNm ->
+        _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm `thenPrimIO` \ () ->
+        _ccall_ toUTCTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res
                                                    `thenPrimIO` \ tm ->
     if tm == (``NULL''::_Addr) then
        error "toUTCTime{LibTime}: out of range"
                                                    `thenPrimIO` \ tm ->
     if tm == (``NULL''::_Addr) then
        error "toUTCTime{LibTime}: out of range"
@@ -221,7 +229,8 @@ toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz is
         error "toClockTime{LibTime}: timezone offset out of range"
     else
         unsafePerformPrimIO (
         error "toClockTime{LibTime}: timezone offset out of range"
     else
         unsafePerformPrimIO (
-           _ccall_ toClockSec year mon mday hour min sec tz
+           allocWords (``sizeof(time_t)'') `thenPrimIO` \ res ->
+           _ccall_ toClockSec year mon mday hour min sec tz res
                                                    `thenPrimIO` \ ptr@(A# ptr#) ->
             if ptr /= ``NULL'' then
                returnPrimIO (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec)
                                                    `thenPrimIO` \ ptr@(A# ptr#) ->
             if ptr /= ``NULL'' then
                returnPrimIO (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec)
index 79e46a7..9203e3b 100644 (file)
@@ -22,7 +22,7 @@ instance Ord Time
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 79e46a7..9203e3b 100644 (file)
@@ -22,7 +22,7 @@ instance Ord Time
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 79e46a7..9203e3b 100644 (file)
@@ -22,7 +22,7 @@ instance Ord Time
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 79e46a7..9203e3b 100644 (file)
@@ -22,7 +22,7 @@ instance Ord Time
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 79e46a7..9203e3b 100644 (file)
@@ -22,7 +22,7 @@ instance Ord Time
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-}
 instance Text Time
        {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 3882e89..213f7e8 100644 (file)
@@ -17,7 +17,7 @@ while (<MKF>) {
                 '_mc', '_mr', '_mt', '_mp', '_mg',
                 '_2s', '_1s', '_du',
                 '_a', '_b', '_c', '_d', '_e', '_f', '_g', '_h',
                 '_mc', '_mr', '_mt', '_mp', '_mg',
                 '_2s', '_1s', '_du',
                 '_a', '_b', '_c', '_d', '_e', '_f', '_g', '_h',
-                '_i', '_j', '_k', '_o', '_m', '_n', '_o' ) {
+                '_i', '_j', '_k', '_o', '_m', '_n', '_o', '_A', '_B' ) {
        $copy = $_;
 
        # change all .hc and .hi
        $copy = $_;
 
        # change all .hc and .hi
index c396021..ff60c64 100644 (file)
@@ -8,6 +8,8 @@ absent# :: a
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
+parError# :: a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-}
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
index c710c9a..c8c2eef 100644 (file)
@@ -3,7 +3,8 @@ module PreludeBuiltin (
        _trace,
        absent#,
        error,
        _trace,
        absent#,
        error,
-       patError#
+       patError#,
+       parError#
     ) where
 
 import Cls
     ) where
 
 import Cls
@@ -66,6 +67,8 @@ error__ msg_hdr s
 
 absent# = error "Oops! The program has entered an `absent' argument!\n"
 
 
 absent# = error "Oops! The program has entered an `absent' argument!\n"
 
+parError# = error "Oops! Entered parError# (a GHC bug -- please report it!)\n"
+
 ---------------------------------------------------------------
 _runST m = case m (S# realWorld#) of
            (r,_) -> r
 ---------------------------------------------------------------
 _runST m = case m (S# realWorld#) of
            (r,_) -> r
index c396021..ff60c64 100644 (file)
@@ -8,6 +8,8 @@ absent# :: a
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
+parError# :: a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-}
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
index c396021..ff60c64 100644 (file)
@@ -8,6 +8,8 @@ absent# :: a
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
+parError# :: a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-}
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
index c396021..ff60c64 100644 (file)
@@ -8,6 +8,8 @@ absent# :: a
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
+parError# :: a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-}
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
index c396021..ff60c64 100644 (file)
@@ -8,6 +8,8 @@ absent# :: a
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
+parError# :: a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-}
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
index c396021..ff60c64 100644 (file)
@@ -8,6 +8,8 @@ absent# :: a
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-}
 error :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-}
+parError# :: a
+       {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_  _TYAPP_  _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-}
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
 patError# :: [Char] -> a
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-}
 
index dee15c0..848aeae 100644 (file)
@@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
index 4019287..94ed9c5 100644 (file)
@@ -8,15 +8,21 @@ Standard, unbounded channel abstraction.
 \begin{code}
 module Channel
        (
 \begin{code}
 module Channel
        (
-       {- abstract -}
+        {- abstract type defined -}
         Chan,
 
         Chan,
 
-       newChan,        -- :: IO (Chan a)
-       putChan,        -- :: Chan a -> a -> IO ()
-       getChan,        -- :: Chan a -> IO a
-       dupChan,        -- :: Chan a -> IO (Chan a)
-       unGetChan,      -- :: Chan a -> a -> IO ()
-       getChanContents -- :: Chan a -> IO [a]
+        {- creator -}
+       newChan,         -- :: IO (Chan a)
+
+        {- operators -}
+       putChan,         -- :: Chan a -> a -> IO ()
+       getChan,         -- :: Chan a -> IO a
+       dupChan,         -- :: Chan a -> IO (Chan a)
+       unGetChan,       -- :: Chan a -> a -> IO ()
+
+        {- stream interface -}
+       getChanContents, -- :: Chan a -> IO [a]
+       putList2Chan     -- :: Chan a -> [a] -> IO ()
 
        ) where
 
 
        ) where
 
@@ -107,14 +113,18 @@ unGetChan (Chan read write) val
 
 \end{code}
 
 
 \end{code}
 
+Operators for interfacing with functional streams.
+
 \begin{code}
 
 getChanContents :: Chan a -> IO [a]
 \begin{code}
 
 getChanContents :: Chan a -> IO [a]
-getChanContents ch
- = unsafeInterleavePrimIO (
-      getChan ch)         `thenPrimIO` \ ~(Right x) ->
-   unsafeInterleavePrimIO (
-      getChanContents ch) `thenPrimIO` \ ~(Right xs) ->
-   return (x:xs)
+getChanContents ch =
+ unsafeInterleavePrimIO (
+  getChan ch                                  `thenPrimIO` \ ~(Right x) ->
+  unsafeInterleavePrimIO (getChanContents ch)  `thenPrimIO` \ ~(Right xs) ->
+  returnPrimIO  (Right (x:xs)))
+
+putList2Chan :: Chan a -> [a] -> IO ()
+putList2Chan ch ls = sequence (map (putChan ch) ls)
 
 \end{code}
 
 \end{code}
index dee15c0..848aeae 100644 (file)
@@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
index dee15c0..848aeae 100644 (file)
@@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
index dee15c0..848aeae 100644 (file)
@@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
index dee15c0..848aeae 100644 (file)
@@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
index 29976cc..04dc12f 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
-import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan)
+import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
@@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
index f59c81c..5d9a337 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
-import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan)
+import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
@@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
index 9a815f8..a02ed58 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
-import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan)
+import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
@@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
index 29976cc..04dc12f 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
-import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan)
+import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
@@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
index 29976cc..04dc12f 100644 (file)
@@ -1,6 +1,6 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface Concurrent where
-import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan)
+import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
 import ChannelVar(CVar(..), getCVar, newCVar, putCVar)
 import Merge(mergeIO, nmergeIO)
 import Parallel(par, seq)
@@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
+putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-}
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
 unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld)
        {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-}
 getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld)
index de65c79..31c86b3 100644 (file)
@@ -26,7 +26,7 @@ instance Ord Bool
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 24f5d1d..33c353c 100644 (file)
@@ -61,11 +61,10 @@ instance Enum Bool where
 
 ----------------------------------------------------------------------
 instance Text Bool where
 
 ----------------------------------------------------------------------
 instance Text Bool where
-    readsPrec p
-      = readParen (p > 9)
-            (\ b -> [ (False, c) | ("False", c) <- lex b ]
-                ++ [ (True,  c) | ("True",  c) <- lex b ])
+    readsPrec p r
+      = readParen False (\ b -> [ (False, c) | ("False", c) <- lex b ]) r
+     ++ readParen False (\ b -> [ (True,  c) | ("True",  c) <- lex b ]) r
 
 
-    showsPrec d p r = (if p then "True" else "False") ++ r
+    showsPrec d p = showString (if p then "True" else "False")
 
 -- ToDo: Binary
 
 -- ToDo: Binary
index de65c79..31c86b3 100644 (file)
@@ -26,7 +26,7 @@ instance Ord Bool
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index de65c79..31c86b3 100644 (file)
@@ -26,7 +26,7 @@ instance Ord Bool
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index de65c79..31c86b3 100644 (file)
@@ -26,7 +26,7 @@ instance Ord Bool
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index de65c79..31c86b3 100644 (file)
@@ -26,7 +26,7 @@ instance Ord Bool
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
         _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 2879d6a..83344d7 100644 (file)
@@ -17,7 +17,6 @@ plusInt       (I# x) (I# y) = I# (plusInt# x y)
 minusInt(I# x) (I# y) = I# (minusInt# x y)
 timesInt(I# x) (I# y) = I# (timesInt# x y)
 quotInt        (I# x) (I# y) = I# (quotInt# x y)
 minusInt(I# x) (I# y) = I# (minusInt# x y)
 timesInt(I# x) (I# y) = I# (timesInt# x y)
 quotInt        (I# x) (I# y) = I# (quotInt# x y)
-divInt (I# x) (I# y) = I# (divInt# x y)
 remInt (I# x) (I# y) = I# (remInt# x y)
 negateInt (I# x)      = I# (negateInt# x)
 gtInt  (I# x) (I# y) = gtInt# x y
 remInt (I# x) (I# y) = I# (remInt# x y)
 negateInt (I# x)      = I# (negateInt# x)
 gtInt  (I# x) (I# y) = gtInt# x y
index 30f6da3..1b981d2 100644 (file)
@@ -2,7 +2,7 @@ module PreludeBuiltin where
 
 import Prel            ( (&&) )
 import Cls
 
 import Prel            ( (&&) )
 import Cls
-import Core            ( _readList, _showList )
+import Core
 import IChar
 import IInt
 import List            ( (++) )
 import IChar
 import IInt
 import List            ( (++) )
index 6059ee8..9ef43b6 100644 (file)
@@ -665,9 +665,9 @@ concat                      =  foldr (++) []
 # ifndef USE_FOLDR_BUILD
 -- HBC version (stolen)
 concat []              = []
 # ifndef USE_FOLDR_BUILD
 -- HBC version (stolen)
 concat []              = []
-concat ([]:xss)                = concat xss                    -- for better stack behaiour!
-concat ([x]:xss)       = x : concat xss                -- this should help too ???
-concat (xs:xss)                = xs ++ concat xss
+concat ([]:xss)                = concat xss                    -- for better stack behaviour!
+--NO:bad strictness: concat ([x]:xss)  = x : concat xss -- this should help too ???
+concat ((y:ys):xss)     = y : (ys ++ concat xss)
 # else
 {-# INLINE concat #-}
 concat xs = _build (\ c n -> foldr (\ x y -> foldr c y x) n xs)
 # else
 {-# INLINE concat #-}
 concat xs = _build (\ c n -> foldr (\ x y -> foldr c y x) n xs)
index b55f392..db63ad2 100644 (file)
@@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
+_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
@@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
+unpackPS2# :: Addr# -> Int# -> [Char]
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-}
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
index e5891b1..7ed2312 100644 (file)
@@ -26,9 +26,10 @@ module PreludePS{-yes, a Prelude module!-} (
        _psToByteArray,
 
        _unpackPS,
        _psToByteArray,
 
        _unpackPS,
-       unpackPS#,
+       unpackPS#, unpackPS2#,
 --     toCString,
        _putPS,
 --     toCString,
        _putPS,
+       _getPS,
 
        _headPS,
        _tailPS,
 
        _headPS,
        _tailPS,
@@ -110,7 +111,8 @@ _psToByteArray       :: _PackedString -> _ByteArray Int
 --OLD: packToCString   :: [Char] -> _ByteArray Int -- hmmm... weird name
 
 _unpackPS      :: _PackedString -> [Char]
 --OLD: packToCString   :: [Char] -> _ByteArray Int -- hmmm... weird name
 
 _unpackPS      :: _PackedString -> [Char]
-unpackPS#      :: Addr#         -> [Char] -- calls injected by compiler
+unpackPS#      :: Addr#         -> [Char] -- calls injected by compiler
+unpackPS2#     :: Addr# -> Int# -> [Char] -- calls injected by compiler
 --???toCString :: _PackedString -> ByteArray#
 _putPS         :: _FILE -> _PackedString -> PrimIO () -- ToDo: more sensible type
 \end{code}
 --???toCString :: _PackedString -> ByteArray#
 _putPS         :: _FILE -> _PackedString -> PrimIO () -- ToDo: more sensible type
 \end{code}
@@ -274,6 +276,10 @@ unpackPS# addr -- calls injected by compiler
   where
     len = case (strlen# addr) of { I# x -> x }
 
   where
     len = case (strlen# addr) of { I# x -> x }
 
+unpackPS2# addr len -- calls injected by compiler
+  -- this one is for literal strings with NULs in them; rare.
+  = _unpackPS (_packCBytes (I# len) (A# addr))
+
 -- OK, but this code gets *hammered*:
 -- _unpackPS ps
 --   = [ _indexPS ps n | n <- [ 0::Int .. _lengthPS ps - 1 ] ]
 -- OK, but this code gets *hammered*:
 -- _unpackPS ps
 --   = [ _indexPS ps n | n <- [ 0::Int .. _lengthPS ps - 1 ] ]
@@ -320,6 +326,38 @@ _putPS file (_CPS addr len)
     returnPrimIO ()
 \end{code}
 
     returnPrimIO ()
 \end{code}
 
+The dual to @_putPS@, note that the size of the chunk specified
+is the upper bound of the size of the chunk returned.
+
+\begin{code}
+_getPS :: _FILE -> Int -> PrimIO _PackedString
+_getPS file len@(I# len#)
+ | len# <=# 0# = returnPrimIO _nilPS -- I'm being kind here.
+ | otherwise   =
+    -- Allocate an array for system call to store its bytes into.
+   new_ps_array len#      `thenPrimIO` \ ch_arr ->
+   freeze_ps_array ch_arr `thenPrimIO` \ (_ByteArray _ frozen#) ->
+   let
+    byte_array = _ByteArray (0, I# len#) frozen#
+   in
+   _ccall_ fread byte_array (1::Int) len file `thenPrimIO` \  (I# read#) ->
+   if read# ==# 0# then -- EOF or other error
+      error "_getPS: EOF reached or other error"
+   else
+     {-
+       The system call may not return the number of
+       bytes requested. Instead of failing with an error
+       if the number of bytes read is less than requested,
+       a packed string containing the bytes we did manage
+       to snarf is returned.
+     -}
+     let
+      has_null = byteArrayHasNUL# frozen# read#
+     in 
+     returnPrimIO (_PS frozen# read# has_null)
+
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsection{List-mimicking functions for @_PackedStrings@}
 %************************************************************************
 %*                                                                     *
 \subsection{List-mimicking functions for @_PackedStrings@}
index b55f392..db63ad2 100644 (file)
@@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
+_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
@@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
+unpackPS2# :: Addr# -> Int# -> [Char]
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-}
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
index b55f392..ef8880e 100644 (file)
@@ -82,6 +82,8 @@ _wordsPS :: _PackedString -> [_PackedString]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
+unpackPS2# :: Addr# -> Int# -> [Char]
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-}
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
index b55f392..db63ad2 100644 (file)
@@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
+_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
@@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
+unpackPS2# :: Addr# -> Int# -> [Char]
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-}
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
index b55f392..db63ad2 100644 (file)
@@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
+_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
@@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
+unpackPS2# :: Addr# -> Int# -> [Char]
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-}
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
index b55f392..db63ad2 100644 (file)
@@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
 _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a
        {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-}
+_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld)
+       {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
 _headPS :: _PackedString -> Char
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 _indexPS :: _PackedString -> Int -> Char
@@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString]
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
        {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 unpackPS# :: Addr# -> [Char]
        {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-}
+unpackPS2# :: Addr# -> Int# -> [Char]
+       {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-}
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
 instance Eq _PackedString
        {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_
         (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
index 0116c44..50ccfbd 100644 (file)
@@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 0116c44..50ccfbd 100644 (file)
@@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 0109c89..fcf715e 100644 (file)
@@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 0116c44..50ccfbd 100644 (file)
@@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 0116c44..50ccfbd 100644 (file)
@@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 9f36cd0..2ee5989 100644 (file)
@@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 9f36cd0..2ee5989 100644 (file)
@@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index b966a8d..888e7ac 100644 (file)
@@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 9f36cd0..2ee5989 100644 (file)
@@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 9f36cd0..2ee5989 100644 (file)
@@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b)
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
        {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Text Bool
        {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_
-        readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
+        readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_,
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
         showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
         readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
         showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
index 941da2f..8207a62 100644 (file)
@@ -160,6 +160,7 @@ _bufferMode (_ReadHandle _ m _) = m
 _bufferMode (_WriteHandle _ m _) = m
 _bufferMode (_AppendHandle _ m _) = m
 _bufferMode (_ReadWriteHandle _ m _) = m
 _bufferMode (_WriteHandle _ m _) = m
 _bufferMode (_AppendHandle _ m _) = m
 _bufferMode (_ReadWriteHandle _ m _) = m
+_bufferMode (_SocketHandle _ _) = (Just NoBuffering)
 
 _markHandle :: _Handle -> _Handle
 _markHandle h@(_ReadHandle fp m b)
 
 _markHandle :: _Handle -> _Handle
 _markHandle h@(_ReadHandle fp m b)
@@ -476,9 +477,11 @@ hSetBuffering handle mode =
                 _SemiClosedHandle _ _ ->
                    putMVar handle htype                    >>
                    failWith (IllegalOperation "handle is closed")
                 _SemiClosedHandle _ _ ->
                    putMVar handle htype                    >>
                    failWith (IllegalOperation "handle is closed")
+{-
                _SocketHandle _ _ ->
                    putMVar handle htype                    >>
                    failWith (IllegalOperation "buffering not supported for socket handles")
                _SocketHandle _ _ ->
                    putMVar handle htype                    >>
                    failWith (IllegalOperation "buffering not supported for socket handles")
+-}
                 other ->
                     _ccall_ setBuffering (_filePtr other) bsize
                                                            `thenPrimIO` \ rc -> 
                 other ->
                     _ccall_ setBuffering (_filePtr other) bsize
                                                            `thenPrimIO` \ rc -> 
@@ -511,6 +514,7 @@ hSetBuffering handle mode =
     hcon (_WriteHandle _ _ _) = _WriteHandle
     hcon (_AppendHandle _ _ _) = _AppendHandle
     hcon (_ReadWriteHandle _ _ _) = _ReadWriteHandle
     hcon (_WriteHandle _ _ _) = _WriteHandle
     hcon (_AppendHandle _ _ _) = _AppendHandle
     hcon (_ReadWriteHandle _ _ _) = _ReadWriteHandle
+    hcon (_SocketHandle _ _) = \ a _ v -> _SocketHandle a v
 
 \end{code}
 
 
 \end{code}
 
diff --git a/ghc/lib/unix-libs.lit b/ghc/lib/unix-libs.lit
new file mode 100644 (file)
index 0000000..e6257cf
--- /dev/null
@@ -0,0 +1,35 @@
+\begin{onlystandalone}
+\documentstyle[11pt,literate,a4wide,titlepage]{article}
+\begin{document}
+\title{Adding Unix Libraries to GHC}
+\author{Darren J Moffat}
+\date{July 1995}
+\maketitle
+\tableofcontents
+\end{onlystandalone}
+
+
+\begin{onlypartofdoc}
+\section[UnixLibs]{Unix Libraries}
+\downsection
+\end{onlypartofdoc}
+
+
+\input{ghc/Socket.lhs}
+\input{ghc/SocketPrim.lhs}
+\input{ghc/BSD.lhs}
+\input{ghc/Readline.lhs}
+%\input{DBM.lhs}
+%\input{WWW.lhs}
+
+
+\begin{onlypartofdoc}
+\upsection
+\end{onlypartofdoc}
+
+\begin{onlystandalone}
+\printindex
+\end{document}
+\end{onlystandalone}
+
+
diff --git a/ghc/misc/examples/nfib/nfib.c b/ghc/misc/examples/nfib/nfib.c
new file mode 100644 (file)
index 0000000..04e7d54
--- /dev/null
@@ -0,0 +1,16 @@
+#include <stdio.h>
+
+main ()
+{
+    int n;
+    
+    scanf("%d",&n);
+    n = nfib(n);
+    printf("nfibs=%d\n",n);
+    exit(0);
+}
+
+nfib (n)
+{
+    return(n <= 1 ? 1 : nfib(n-1) + nfib(n-2) + 1);
+}
diff --git a/ghc/misc/examples/nfib/nfib.pl b/ghc/misc/examples/nfib/nfib.pl
new file mode 100644 (file)
index 0000000..18cc926
--- /dev/null
@@ -0,0 +1,19 @@
+# WARNING!
+# Note: be careful about running this with an argument > (say) 18 !
+# running this script on '27' will chew up ~80 MB of virtual
+# ram. and its apetite grows per 1.61803 ** $n.
+#
+# Your system admin folk would probably be displeased if you trash
+# other people's work, or disable systems running this script!
+# 
+# Usage: perl nfib.prl <number>
+#
+$n = @ARGV[0];
+$f=&fib($n);
+print " $n! = $f\n";
+sub fib {
+    local ($n)=$_[0];
+    if ($n==0) {return (0);}
+    elsif($n==1) {return(1);}
+    return (&fib ($n-1) + &fib($n-2));
+}
index 64c7962..094f1a4 100644 (file)
@@ -4,11 +4,11 @@
 
 GHC_OPTS_norm=-O /*-fsemi-tagging*/ -darity-checks-C-only rts_or_lib(-optc-DGCap,)
 GHC_OPTS_p =-hisuf _p.hi  -O /*-fsemi-tagging*/ -prof -GPrelude rts_or_lib(-optc-DGCap,)
 
 GHC_OPTS_norm=-O /*-fsemi-tagging*/ -darity-checks-C-only rts_or_lib(-optc-DGCap,)
 GHC_OPTS_p =-hisuf _p.hi  -O /*-fsemi-tagging*/ -prof -GPrelude rts_or_lib(-optc-DGCap,)
-GHC_OPTS_t =-hisuf _t.hi  -O /*-fsemi-tagging*/ -ticky rts_or_lib(-optc-DGCap,)
+GHC_OPTS_t =-hisuf _t.hi  -O /*-fsemi-tagging*/ -ticky -optc-DDEBUG rts_or_lib(-optc-DGCap,)
 GHC_OPTS_u =-hisuf _u.hi  -O -unregisterised ???? /*-fsemi-tagging*/ -ticky rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mc=-hisuf _mc.hi -O -concurrent rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mr=-hisuf _mr.hi -O -concurrent -prof -GPrelude rts_or_lib(-optc-DGCap,)
 GHC_OPTS_u =-hisuf _u.hi  -O -unregisterised ???? /*-fsemi-tagging*/ -ticky rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mc=-hisuf _mc.hi -O -concurrent rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mr=-hisuf _mr.hi -O -concurrent -prof -GPrelude rts_or_lib(-optc-DGCap,)
-GHC_OPTS_mt=-hisuf _mt.hi -O -concurrent -ticky rts_or_lib(-optc-DGCap,)
+GHC_OPTS_mt=-hisuf _mt.hi -O -concurrent -ticky -optc-DDEBUG rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mp=-hisuf _mp.hi -O -parallel rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mg=-hisuf _mg.hi -O -gransim rts_or_lib(-optc-DGCap,)
 GHC_OPTS_2s=-hisuf _2s.hi -O -gc-2s rts_or_lib(-optc-DGC2s,)
 GHC_OPTS_mp=-hisuf _mp.hi -O -parallel rts_or_lib(-optc-DGCap,)
 GHC_OPTS_mg=-hisuf _mg.hi -O -gransim rts_or_lib(-optc-DGCap,)
 GHC_OPTS_2s=-hisuf _2s.hi -O -gc-2s rts_or_lib(-optc-DGC2s,)
@@ -30,3 +30,5 @@ GHC_OPTS_l =-hisuf _l.hi -user-setup-l rts_or_lib(-optc-DGCap,)
 GHC_OPTS_m =-hisuf _m.hi -user-setup-m rts_or_lib(-optc-DGCap,)
 GHC_OPTS_n =-hisuf _n.hi -user-setup-n rts_or_lib(-optc-DGCap,)
 GHC_OPTS_o =-hisuf _o.hi -user-setup-o rts_or_lib(-optc-DGCap,)
 GHC_OPTS_m =-hisuf _m.hi -user-setup-m rts_or_lib(-optc-DGCap,)
 GHC_OPTS_n =-hisuf _n.hi -user-setup-n rts_or_lib(-optc-DGCap,)
 GHC_OPTS_o =-hisuf _o.hi -user-setup-o rts_or_lib(-optc-DGCap,)
+GHC_OPTS_A =-hisuf _A.hi -user-setup-A rts_or_lib(-optc-DGCap,)
+GHC_OPTS_B =-hisuf _B.hi -user-setup-B rts_or_lib(-optc-DGCap,)
index 2279ad1..c44f36b 100644 (file)
@@ -6,7 +6,7 @@
 #endif
 /* ProjectVersion is something printable */
 #ifndef ProjectVersion
 #endif
 /* ProjectVersion is something printable */
 #ifndef ProjectVersion
-#define ProjectVersion  0.26
+#define ProjectVersion  0.27
 #endif
 /* A patchlevel change is something *very minor* */
 #ifndef ProjectPatchLevel
 #endif
 /* A patchlevel change is something *very minor* */
 #ifndef ProjectPatchLevel
@@ -14,7 +14,7 @@
 #endif
 /* GhcBuildeeVersion is something CPP-testable (ProjectVersion * 100) */
 #ifndef GhcBuildeeVersion
 #endif
 /* GhcBuildeeVersion is something CPP-testable (ProjectVersion * 100) */
 #ifndef GhcBuildeeVersion
-#define GhcBuildeeVersion  26
+#define GhcBuildeeVersion  27
 #endif
 # line 29 "only4-ghc.ljm"
 /* state of the source world */
 #endif
 # line 29 "only4-ghc.ljm"
 /* state of the source world */
index dcaf5ac..30e51e1 100644 (file)
 #endif
 /* ProjectVersion is something printable */
 #ifndef ProjectVersion
 #endif
 /* ProjectVersion is something printable */
 #ifndef ProjectVersion
-#define ProjectVersion  0.26
+#define ProjectVersion  0.27
 #endif
 /* A patchlevel change is something *very minor* */
 #ifndef ProjectPatchLevel
 #endif
 /* A patchlevel change is something *very minor* */
 #ifndef ProjectPatchLevel
-#define ProjectPatchLevel patchlevel 1
+#define ProjectPatchLevel patchlevel 0
 #endif
 /* GhcBuildeeVersion is something CPP-testable (ProjectVersion * 100) */
 #ifndef GhcBuildeeVersion
 #endif
 /* GhcBuildeeVersion is something CPP-testable (ProjectVersion * 100) */
 #ifndef GhcBuildeeVersion
-#define GhcBuildeeVersion  26
+#define GhcBuildeeVersion  27
 #endif
 \end{code}
 
 #endif
 \end{code}
 
index ac01096..dc855af 100644 (file)
@@ -366,6 +366,28 @@ GHC_BUILD_FLAG_o = -build-o-not-defined
 GHC_BUILD_OPTS_o = -build-o-not-defined-error
 #endif
 
 GHC_BUILD_OPTS_o = -build-o-not-defined-error
 #endif
 
+#define GhcBuild_A NO /*@GhcBuild_A@*/         /* "user way" A */
+#if GhcBuild_A == YES
+# define IfGhcBuild_A(x) x
+GHC_BUILD_FLAG_A = -build-A-not-defined /* >>>change here<<< if required */
+GHC_BUILD_OPTS_A = -build-A-not-defined-error
+#else
+# define IfGhcBuild_A(x) /**/
+GHC_BUILD_FLAG_A = -build-A-not-defined
+GHC_BUILD_OPTS_A = -build-A-not-defined-error
+#endif
+
+#define GhcBuild_B NO /*@GhcBuild_B@*/         /* "user way" B */
+#if GhcBuild_B == YES
+# define IfGhcBuild_B(x) x
+GHC_BUILD_FLAG_B = -build-B-not-defined /* >>>change here<<< if required */
+GHC_BUILD_OPTS_B = -build-B-not-defined-error
+#else
+# define IfGhcBuild_B(x) /**/
+GHC_BUILD_FLAG_B = -build-B-not-defined
+GHC_BUILD_OPTS_B = -build-B-not-defined-error
+#endif
+
 /* ======= END OF BUILD INFO ==================================== */
 
 
 /* ======= END OF BUILD INFO ==================================== */
 
 
index ea1edaf..84e3897 100644 (file)
@@ -48,14 +48,7 @@ strictly speaking), it will probably work -- it is pinned onto
 GHC_OPTS, just for fun.
 */
 
 GHC_OPTS, just for fun.
 */
 
-#if i386_TARGET_ARCH
-# define __plat_specific -mtoggle-sp-mangling
-#else
-# define __plat_specific /*none*/
-#endif
-
-GHC_OPTS = -O2-for-C -optc-DFORCE_GC \
-          __plat_specific $(EXTRA_HC_OPTS)
+GHC_OPTS = -O2-for-C $(EXTRA_HC_OPTS)
 
 /* per-build options: shared with libraries */
 #define rts_or_lib(r,l) r
 
 /* per-build options: shared with libraries */
 #define rts_or_lib(r,l) r
@@ -97,13 +90,13 @@ RTS_LC =                            \
        gum/Unpack.lc                   \
        main/GranSim.lc                 \
        main/Itimer.lc                  \
        gum/Unpack.lc                   \
        main/GranSim.lc                 \
        main/Itimer.lc                  \
-       main/RednCounts.lc              \
+       main/Ticky.lc                   \
        main/SMRep.lc                   \
        main/Select.lc                  \
        main/Signals.lc                 \
        main/StgOverflow.lc             \
        main/SMRep.lc                   \
        main/Select.lc                  \
        main/Signals.lc                 \
        main/StgOverflow.lc             \
-       main/StgTrace.lc                \
        main/Threads.lc                 \
        main/Threads.lc                 \
+       main/RtsFlags.lc                \
        main/main.lc                    \
        prims/PrimArith.lc              \
        prims/PrimMisc.lc               \
        main/main.lc                    \
        prims/PrimArith.lc              \
        prims/PrimMisc.lc               \
@@ -111,9 +104,7 @@ RTS_LC =                            \
        profiling/Hashing.lc            \
        profiling/HeapProfile.lc        \
        profiling/Indexing.lc           \
        profiling/Hashing.lc            \
        profiling/HeapProfile.lc        \
        profiling/Indexing.lc           \
-       profiling/LifeProfile.lc        \
        profiling/Timer.lc              \
        profiling/Timer.lc              \
-       storage/Force_GC.lc             \
        storage/SM1s.lc                 \
        storage/SM2s.lc                 \
        storage/SMap.lc                 \
        storage/SM1s.lc                 \
        storage/SM2s.lc                 \
        storage/SMap.lc                 \
@@ -190,8 +181,8 @@ CLIB_LC =                           \
        io/toLocalTime.lc               \
        io/toUTCTime.lc                 \
        io/writeFile.lc                 \
        io/toLocalTime.lc               \
        io/toUTCTime.lc                 \
        io/writeFile.lc                 \
-       prims/ByteOps.lc                \
-       storage/SMalloc.lc __readline_cfile
+       main/Mallocs.lc                 \
+       prims/ByteOps.lc __readline_cfile
 
 H_FILES = $(RTS_LH:.lh=.h)
 C_FILES = $(RTS_LC:.lc=.c) $(RTS_LHC:.lhc=.hc) $(CLIB_LC:.lc=.c)
 
 H_FILES = $(RTS_LH:.lh=.h)
 C_FILES = $(RTS_LC:.lc=.c) $(RTS_LHC:.lhc=.hc) $(CLIB_LC:.lc=.c)
@@ -240,6 +231,8 @@ RTS_OBJS_l    = $(RTS_LC:.lc=_l.o)  $(RTS_LHC:.lhc=_l.o)
 RTS_OBJS_m    = $(RTS_LC:.lc=_m.o)  $(RTS_LHC:.lhc=_m.o)
 RTS_OBJS_n    = $(RTS_LC:.lc=_n.o)  $(RTS_LHC:.lhc=_n.o)
 RTS_OBJS_o    = $(RTS_LC:.lc=_o.o)  $(RTS_LHC:.lhc=_o.o)
 RTS_OBJS_m    = $(RTS_LC:.lc=_m.o)  $(RTS_LHC:.lhc=_m.o)
 RTS_OBJS_n    = $(RTS_LC:.lc=_n.o)  $(RTS_LHC:.lhc=_n.o)
 RTS_OBJS_o    = $(RTS_LC:.lc=_o.o)  $(RTS_LHC:.lhc=_o.o)
+RTS_OBJS_A    = $(RTS_LC:.lc=_A.o)  $(RTS_LHC:.lhc=_A.o)
+RTS_OBJS_B    = $(RTS_LC:.lc=_B.o)  $(RTS_LHC:.lhc=_B.o)
 
 CLIB_OBJS     = $(CLIB_LC:.lc=.o)
 
 
 CLIB_OBJS     = $(CLIB_LC:.lc=.o)
 
@@ -303,10 +296,10 @@ CompileClibishly(io/toClockSec,)
 CompileClibishly(io/toLocalTime,)
 CompileClibishly(io/toUTCTime,)
 CompileClibishly(io/writeFile,)
 CompileClibishly(io/toLocalTime,)
 CompileClibishly(io/toUTCTime,)
 CompileClibishly(io/writeFile,)
+CompileClibishly(main/Mallocs,)
 CompileClibishly(main/TopClosure,)     /* NB */
 CompileClibishly(main/TopClosure13,)   /* ditto */
 CompileClibishly(prims/ByteOps,)
 CompileClibishly(main/TopClosure,)     /* NB */
 CompileClibishly(main/TopClosure13,)   /* ditto */
 CompileClibishly(prims/ByteOps,)
-CompileClibishly(storage/SMalloc,)
 #if GhcWithReadline == YES
 CompileClibishly(io/ghcReadline,)
 #endif
 #if GhcWithReadline == YES
 CompileClibishly(io/ghcReadline,)
 #endif
@@ -327,9 +320,9 @@ install :: main/TopClosure.o main/TopClosure13.o
 # endif
 
 AllTarget(gum/SysMan)
 # endif
 
 AllTarget(gum/SysMan)
-gum/SysMan : gum/SysMan_mp.o gum/LLComms_mp.o
+gum/SysMan : gum/SysMan_mp.o gum/LLComms_mp.o main/Mallocs.o hooks/OutOfVM.o
        $(RM) $@
        $(RM) $@
-       $(CC) gum/SysMan_mp.o gum/LLComms_mp.o -o $@ -L$$PVM_ROOT/lib/$$PVM_ARCH -lpvm3 -lgpvm3 __socket_libs
+       $(CC) -o $@ gum/SysMan_mp.o gum/LLComms_mp.o main/Mallocs.o hooks/OutOfVM.o -L$$PVM_ROOT/lib/$$PVM_ARCH -lpvm3 -lgpvm3 __socket_libs
 ExtraStuffToClean(gum/SysMan_mp.o gum/SysMan)
 # if DoInstallGHCSystem == YES
 install :: gum/SysMan
 ExtraStuffToClean(gum/SysMan_mp.o gum/SysMan)
 # if DoInstallGHCSystem == YES
 install :: gum/SysMan
@@ -409,6 +402,8 @@ IfGhcBuild_l(BigBuildTarget(_l,   $(RTS_OBJS_l)))
 IfGhcBuild_m(BigBuildTarget(_m,   $(RTS_OBJS_m)))
 IfGhcBuild_n(BigBuildTarget(_n,   $(RTS_OBJS_n)))
 IfGhcBuild_o(BigBuildTarget(_o,   $(RTS_OBJS_o)))
 IfGhcBuild_m(BigBuildTarget(_m,   $(RTS_OBJS_m)))
 IfGhcBuild_n(BigBuildTarget(_n,   $(RTS_OBJS_n)))
 IfGhcBuild_o(BigBuildTarget(_o,   $(RTS_OBJS_o)))
+IfGhcBuild_A(BigBuildTarget(_A,   $(RTS_OBJS_A)))
+IfGhcBuild_B(BigBuildTarget(_B,   $(RTS_OBJS_B)))
 
 
 /****************************************************************
 
 
 /****************************************************************
@@ -449,19 +444,21 @@ IfGhcBuild_k(DoRtsFile(file,isuf,_k,   flags $(GHC_OPTS_k)))      \
 IfGhcBuild_l(DoRtsFile(file,isuf,_l,   flags $(GHC_OPTS_l)))   \
 IfGhcBuild_m(DoRtsFile(file,isuf,_m,   flags $(GHC_OPTS_m)))   \
 IfGhcBuild_n(DoRtsFile(file,isuf,_n,   flags $(GHC_OPTS_n)))   \
 IfGhcBuild_l(DoRtsFile(file,isuf,_l,   flags $(GHC_OPTS_l)))   \
 IfGhcBuild_m(DoRtsFile(file,isuf,_m,   flags $(GHC_OPTS_m)))   \
 IfGhcBuild_n(DoRtsFile(file,isuf,_n,   flags $(GHC_OPTS_n)))   \
-IfGhcBuild_o(DoRtsFile(file,isuf,_o,   flags $(GHC_OPTS_o)))
+IfGhcBuild_o(DoRtsFile(file,isuf,_o,   flags $(GHC_OPTS_o)))   \
+IfGhcBuild_A(DoRtsFile(file,isuf,_A,   flags $(GHC_OPTS_A)))   \
+IfGhcBuild_B(DoRtsFile(file,isuf,_B,   flags $(GHC_OPTS_B)))
 
 /* here we go: */
 
 CompileRTSishly(c-as-asm/CallWrap_C,.c,)
 CompileRTSishly(c-as-asm/FreeMallocPtr,.c,)
 CompileRTSishly(c-as-asm/HpOverflow,.c,)
 
 /* here we go: */
 
 CompileRTSishly(c-as-asm/CallWrap_C,.c,)
 CompileRTSishly(c-as-asm/FreeMallocPtr,.c,)
 CompileRTSishly(c-as-asm/HpOverflow,.c,)
-CompileRTSishly(c-as-asm/PerformIO,.hc,-mtoggle-sp-mangling/*toggle it back*/)
+CompileRTSishly(c-as-asm/PerformIO,.hc,-optcO-DIN_GHC_RTS=1)
 CompileRTSishly(c-as-asm/StablePtr,.c,)
 CompileRTSishly(c-as-asm/StablePtrOps,.c,)
 CompileRTSishly(c-as-asm/StgDebug,.c,)
 CompileRTSishly(c-as-asm/StgMiniInt,.c,)
 CompileRTSishly(c-as-asm/StablePtr,.c,)
 CompileRTSishly(c-as-asm/StablePtrOps,.c,)
 CompileRTSishly(c-as-asm/StgDebug,.c,)
 CompileRTSishly(c-as-asm/StgMiniInt,.c,)
-CompileRTSishly(gum/FetchMe,.hc,-mtoggle-sp-mangling/*toggle it back*/)
+CompileRTSishly(gum/FetchMe,.hc,-optcO-DIN_GHC_RTS=1)
 CompileRTSishly(gum/GlobAddr,.c,)
 CompileRTSishly(gum/HLComms,.c,)
 CompileRTSishly(gum/Hash,.c,)
 CompileRTSishly(gum/GlobAddr,.c,)
 CompileRTSishly(gum/HLComms,.c,)
 CompileRTSishly(gum/Hash,.c,)
@@ -474,26 +471,24 @@ CompileRTSishly(gum/SysMan,.c,) /* NB: not in library */
 CompileRTSishly(gum/Unpack,.c,)
 CompileRTSishly(main/GranSim,.c,)
 CompileRTSishly(main/Itimer,.c,)
 CompileRTSishly(gum/Unpack,.c,)
 CompileRTSishly(main/GranSim,.c,)
 CompileRTSishly(main/Itimer,.c,)
-CompileRTSishly(main/RednCounts,.c,)
+CompileRTSishly(main/Ticky,.c,)
 CompileRTSishly(main/SMRep,.c,)
 CompileRTSishly(main/Select,.c,)
 CompileRTSishly(main/Signals,.c,)
 CompileRTSishly(main/StgOverflow,.c,)
 CompileRTSishly(main/SMRep,.c,)
 CompileRTSishly(main/Select,.c,)
 CompileRTSishly(main/Signals,.c,)
 CompileRTSishly(main/StgOverflow,.c,)
-CompileRTSishly(main/StgStartup,.hc,-mtoggle-sp-mangling/*toggle it back*/)
-CompileRTSishly(main/StgThreads,.hc,-mtoggle-sp-mangling/*toggle it back*/)
-CompileRTSishly(main/StgTrace,.c,)
-CompileRTSishly(main/StgUpdate,.hc,-mtoggle-sp-mangling/*toggle it back*/)
+CompileRTSishly(main/StgStartup,.hc,-optcO-DIN_GHC_RTS=1)
+CompileRTSishly(main/StgThreads,.hc,-optcO-DIN_GHC_RTS=1)
+CompileRTSishly(main/StgUpdate,.hc,-optcO-DIN_GHC_RTS=1)
 CompileRTSishly(main/Threads,.c,)
 CompileRTSishly(main/Threads,.c,)
+CompileRTSishly(main/RtsFlags,.c,)
 CompileRTSishly(main/main,.c,)
 CompileRTSishly(profiling/CostCentre,.c,)
 CompileRTSishly(profiling/Hashing,.c,)
 CompileRTSishly(profiling/HeapProfile,.c,)
 CompileRTSishly(profiling/Indexing,.c,)
 CompileRTSishly(main/main,.c,)
 CompileRTSishly(profiling/CostCentre,.c,)
 CompileRTSishly(profiling/Hashing,.c,)
 CompileRTSishly(profiling/HeapProfile,.c,)
 CompileRTSishly(profiling/Indexing,.c,)
-CompileRTSishly(profiling/LifeProfile,.c,)
 CompileRTSishly(profiling/Timer,.c,)
 CompileRTSishly(prims/PrimArith,.c,)
 CompileRTSishly(prims/PrimMisc,.c,)
 CompileRTSishly(profiling/Timer,.c,)
 CompileRTSishly(prims/PrimArith,.c,)
 CompileRTSishly(prims/PrimMisc,.c,)
-CompileRTSishly(storage/Force_GC,.c,)
 CompileRTSishly(storage/SM1s,.c,)
 CompileRTSishly(storage/SM2s,.c,)
 CompileRTSishly(storage/SMap,.c,)
 CompileRTSishly(storage/SM1s,.c,)
 CompileRTSishly(storage/SM2s,.c,)
 CompileRTSishly(storage/SMap,.c,)
@@ -505,7 +500,7 @@ CompileRTSishly(storage/SMevac,.c,)
 CompileRTSishly(storage/SMextn,.c,)
 CompileRTSishly(storage/SMgen,.c,)
 CompileRTSishly(storage/SMinit,.c,)
 CompileRTSishly(storage/SMextn,.c,)
 CompileRTSishly(storage/SMgen,.c,)
 CompileRTSishly(storage/SMinit,.c,)
-CompileRTSishly(storage/SMmark,.hc,-optc-DMARK_REG_MAP)
+CompileRTSishly(storage/SMmark,.hc,-optcO-DIN_GHC_RTS=1 -optc-DMARK_REG_MAP)
 CompileRTSishly(storage/SMmarking,.c,)
 CompileRTSishly(storage/SMscan,.c,)
 CompileRTSishly(storage/SMscav,.c,)
 CompileRTSishly(storage/SMmarking,.c,)
 CompileRTSishly(storage/SMscan,.c,)
 CompileRTSishly(storage/SMscav,.c,)
index 259c485..66591d1 100644 (file)
@@ -52,7 +52,6 @@ callWrapper(STG_NO_ARGS)
     CALLER_SAVE_Hp
     CALLER_SAVE_HpLim
     CALLER_SAVE_Liveness
     CALLER_SAVE_Hp
     CALLER_SAVE_HpLim
     CALLER_SAVE_Liveness
-    CALLER_SAVE_Activity
     CALLER_SAVE_Ret
 
     MAGIC_CALL
     CALLER_SAVE_Ret
 
     MAGIC_CALL
@@ -82,7 +81,6 @@ callWrapper(STG_NO_ARGS)
     CALLER_RESTORE_Hp
     CALLER_RESTORE_HpLim
     CALLER_RESTORE_Liveness
     CALLER_RESTORE_Hp
     CALLER_RESTORE_HpLim
     CALLER_RESTORE_Liveness
-    CALLER_RESTORE_Activity
     CALLER_RESTORE_Ret
     
     /* These next two are restore-only */
     CALLER_RESTORE_Ret
     
     /* These next two are restore-only */
@@ -108,7 +106,6 @@ callWrapper_safe(STG_NO_ARGS)
     CALLER_SAVE_Hp
     CALLER_SAVE_HpLim
     CALLER_SAVE_Liveness
     CALLER_SAVE_Hp
     CALLER_SAVE_HpLim
     CALLER_SAVE_Liveness
-    CALLER_SAVE_Activity
     CALLER_SAVE_Ret
 
     MAGIC_CALL
     CALLER_SAVE_Ret
 
     MAGIC_CALL
@@ -123,7 +120,6 @@ callWrapper_safe(STG_NO_ARGS)
     CALLER_RESTORE_Hp
     CALLER_RESTORE_HpLim
     CALLER_RESTORE_Liveness
     CALLER_RESTORE_Hp
     CALLER_RESTORE_HpLim
     CALLER_RESTORE_Liveness
-    CALLER_RESTORE_Activity
     CALLER_RESTORE_Ret
     
     /* These next two are restore-only */
     CALLER_RESTORE_Ret
     
     /* These next two are restore-only */
@@ -160,22 +156,37 @@ ADR */
 
 EXTFUN(EnterNodeCode);
 
 
 EXTFUN(EnterNodeCode);
 
+void *__temp_esp, *__temp_eax;
+
 void PerformGC_wrapper PROTO((W_))         WRAPPER_NAME(PerformGC);
 void PerformGC_wrapper(args)
 W_ args;
 {
 void PerformGC_wrapper PROTO((W_))         WRAPPER_NAME(PerformGC);
 void PerformGC_wrapper(args)
 W_ args;
 {
-    WRAPPER_SETUP(PerformGC)
+#if i386_TARGET_ARCH
+    void *ret_addr;
+
+    WRAPPER_SETUP(PerformGC,ret_addr,args)
+#else
+    WRAPPER_SETUP(PerformGC, ignore_me, ignore_me)
+#endif
     PerformGC(args);
     WRAPPER_RETURN(0)
 }
 
 # ifdef CONCURRENT
 
     PerformGC(args);
     WRAPPER_RETURN(0)
 }
 
 # ifdef CONCURRENT
 
+void __DISCARD__ (STG_NO_ARGS) { /*nothing*/ }
+
 void StackOverflow_wrapper PROTO((W_,W_))   WRAPPER_NAME(StackOverflow);
 void StackOverflow_wrapper(args1,args2)
 W_ args1, args2;
 {
 void StackOverflow_wrapper PROTO((W_,W_))   WRAPPER_NAME(StackOverflow);
 void StackOverflow_wrapper(args1,args2)
 W_ args1, args2;
 {
-    WRAPPER_SETUP(StackOverflow)
+#if i386_TARGET_ARCH
+    void *ret_addr, *ignore_me;
+    WRAPPER_SETUP(StackOverflow,ret_addr,ignore_me)
+#else
+    WRAPPER_SETUP(StackOverflow, ignore_me, ignore_me)
+#endif
     if(StackOverflow(args1,args2)) {
        WRAPPER_RETURN(1)
     }
     if(StackOverflow(args1,args2)) {
        WRAPPER_RETURN(1)
     }
@@ -186,7 +197,12 @@ void Yield_wrapper PROTO((W_))                 WRAPPER_NAME(Yield);
 void Yield_wrapper(args)
 W_ args;
 {
 void Yield_wrapper(args)
 W_ args;
 {
-    WRAPPER_SETUP(Yield)
+#if i386_TARGET_ARCH
+    void *ret_addr, *ignore_me;
+    WRAPPER_SETUP(Yield, ret_addr, ignore_me)
+#else
+    WRAPPER_SETUP(Yield, ignore_me, ignore_me)
+#endif
     Yield(args);
     WRAPPER_RETURN(0)
 }
     Yield(args);
     WRAPPER_RETURN(0)
 }
@@ -200,7 +216,12 @@ void PerformReschedule_wrapper(liveness, always_reenter_node)
   W_ liveness;
   W_  always_reenter_node;
 {
   W_ liveness;
   W_  always_reenter_node;
 {
-    WRAPPER_SETUP(PerformReschedule)
+#if i386_TARGET_ARCH
+    void *ret_addr, *ignore_me;
+    WRAPPER_SETUP(PerformReschedule, ret_addr, ignore_me)
+#else
+    WRAPPER_SETUP(PerformReschedule, ignore_me, ignore_me)
+#endif
     PerformReschedule(liveness, always_reenter_node);
     WRAPPER_RETURN(0)
 }
     PerformReschedule(liveness, always_reenter_node);
     WRAPPER_RETURN(0)
 }
index 93235ca..a9d559f 100644 (file)
@@ -37,17 +37,11 @@ static void BlackHoleUpdateStack(STG_NO_ARGS);
 #endif /* CONCURRENT */
 
 extern smInfo StorageMgrInfo;
 #endif /* CONCURRENT */
 
 extern smInfo StorageMgrInfo;
-extern void PrintRednCountInfo(STG_NO_ARGS);
-extern I_   showRednCountStats;
-extern I_   SM_word_heap_size;
-extern I_   squeeze_upd_frames;
+extern void PrintTickyInfo(STG_NO_ARGS);
 
 #if defined(GRAN_CHECK) && defined(GRAN)
 extern W_ debug;
 #endif
 
 #if defined(GRAN_CHECK) && defined(GRAN)
 extern W_ debug;
 #endif
-#ifdef GRAN
-extern FILE *main_statsfile;         /* Might be of general interest  HWL */
-#endif       
 
 /* the real work is done by this function --- see wrappers at end */
 
 
 /* the real work is done by this function --- see wrappers at end */
 
@@ -61,12 +55,12 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
     I_ num_ptr_roots = 0; /* we bump this counter as we
                                 store roots; de-bump it
                                 as we re-store them. */
     I_ num_ptr_roots = 0; /* we bump this counter as we
                                 store roots; de-bump it
                                 as we re-store them. */
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     CostCentre Save_CCC;
 #endif
 
     /* stop the profiling timer --------------------- */
     CostCentre Save_CCC;
 #endif
 
     /* stop the profiling timer --------------------- */
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 /*    STOP_TIME_PROFILER; */
 #endif
 
 /*    STOP_TIME_PROFILER; */
 #endif
 
@@ -74,6 +68,11 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
 
     SAVE_Liveness = liveness;
 
 
     SAVE_Liveness = liveness;
 
+    /*
+    fprintf(stderr,"RealGC:liveness=0x%lx,reqsize=0x%lx,reenter=%lx,do_full=%d,context_switch=%ld\n",
+       liveness, reqsize,always_reenter_node,do_full_collection,context_switch);
+    */
+
     /* 
        Even on a uniprocessor, we may have to reenter node after a 
        context switch.  Though it can't turn into a FetchMe, its shape
     /* 
        Even on a uniprocessor, we may have to reenter node after a 
        context switch.  Though it can't turn into a FetchMe, its shape
@@ -86,7 +85,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
            return;
        }
        /* Set up to re-enter Node, so as to be sure it's really there. */
            return;
        }
        /* Set up to re-enter Node, so as to be sure it's really there. */
-       assert(liveness & LIVENESS_R1);
+       ASSERT(liveness & LIVENESS_R1);
        TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
        TSO_PC2(CurrentTSO) = EnterNodeCode;
     }
        TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
        TSO_PC2(CurrentTSO) = EnterNodeCode;
     }
@@ -94,7 +93,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
     SAVE_Hp -= reqsize;
 
     if (context_switch && !do_full_collection
     SAVE_Hp -= reqsize;
 
     if (context_switch && !do_full_collection
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
        && !interval_expired
 # endif
       ) {
        && !interval_expired
 # endif
       ) {
@@ -102,7 +101,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
        TSO_ARG1(CurrentTSO) = reqsize;
        TSO_PC1(CurrentTSO) = CheckHeapCode;
 # ifdef PAR
        TSO_ARG1(CurrentTSO) = reqsize;
        TSO_PC1(CurrentTSO) = CheckHeapCode;
 # ifdef PAR
-       if (do_gr_profile) {
+       if (RTSflags.ParFlags.granSimStats) {
            TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO);
        }
 # endif
            TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO);
        }
 # endif
@@ -114,17 +113,19 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
     }
 
     /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
     }
 
     /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
     Save_CCC = CCC;
 # endif
     Save_CCC = CCC;
 # endif
+# if defined(PAR)
     CCC = (CostCentre)STATIC_CC_REF(CC_GC);
     CCC->scc_count++;
     CCC = (CostCentre)STATIC_CC_REF(CC_GC);
     CCC->scc_count++;
+# endif
 
     ReallyPerformThreadGC(reqsize, do_full_collection);
 
 #else  /* !CONCURRENT */
 
 
     ReallyPerformThreadGC(reqsize, do_full_collection);
 
 #else  /* !CONCURRENT */
 
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
     /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
     Save_CCC = CCC;
     CCC = (CostCentre)STATIC_CC_REF(CC_GC);
     /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
     Save_CCC = CCC;
     CCC = (CostCentre)STATIC_CC_REF(CC_GC);
@@ -152,8 +153,10 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
      * Before we garbage collect we may have to squeeze update frames and/or
      * black hole the update stack 
     */
      * Before we garbage collect we may have to squeeze update frames and/or
      * black hole the update stack 
     */
-    if (squeeze_upd_frames) {
-       /* Squeeze and/or black hole update frames */
+    if (! RTSflags.GcFlags.squeezeUpdFrames) {
+       BlackHoleUpdateStack();         
+
+    } else { /* Squeeze and/or black hole update frames */
        I_ displacement;
 
        displacement = SqueezeUpdateFrames(stackInfo.botB + BREL(1), MAIN_SpB, MAIN_SuB);
        I_ displacement;
 
        displacement = SqueezeUpdateFrames(stackInfo.botB + BREL(1), MAIN_SpB, MAIN_SuB);
@@ -162,13 +165,9 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
        MAIN_SpB += BREL(displacement);
        /* fprintf(stderr, "B size %d, squeezed out %d\n", MAIN_SpB - stackInfo.botB,
                 displacement); */
        MAIN_SpB += BREL(displacement);
        /* fprintf(stderr, "B size %d, squeezed out %d\n", MAIN_SpB - stackInfo.botB,
                 displacement); */
-    }  /* note the conditional else clause below */
-# if defined(SM_DO_BH_UPDATE)
-    else
-       BlackHoleUpdateStack();         
-# endif        /* SM_DO_BH_UPDATE */
+    }
 
 
-    assert(num_ptr_roots <= SM_MAXROOTS);
+    ASSERT(num_ptr_roots <= SM_MAXROOTS);
     StorageMgrInfo.rootno = num_ptr_roots;
 
     SAVE_Hp -= reqsize;
     StorageMgrInfo.rootno = num_ptr_roots;
 
     SAVE_Hp -= reqsize;
@@ -189,7 +188,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
       GC_result = collectHeap(reqsize, &StorageMgrInfo, do_full_collection);
 
       if ( GC_result == GC_HARD_LIMIT_EXCEEDED ) {
       GC_result = collectHeap(reqsize, &StorageMgrInfo, do_full_collection);
 
       if ( GC_result == GC_HARD_LIMIT_EXCEEDED ) {
-       OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/
+       OutOfHeapHook(reqsize * sizeof(W_)); /*msg*/
        shutdownHaskell();
        EXIT(EXIT_FAILURE);
 
        shutdownHaskell();
        EXIT(EXIT_FAILURE);
 
@@ -206,10 +205,8 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
       } else { /* This should not happen */
        fprintf(stderr, "Panic: garbage collector returned %d please report it as a bug to glasgow-haskell-bugs@dcs.gla.ac.uk\n", GC_result );
 
       } else { /* This should not happen */
        fprintf(stderr, "Panic: garbage collector returned %d please report it as a bug to glasgow-haskell-bugs@dcs.gla.ac.uk\n", GC_result );
 
-# if defined(DO_REDN_COUNTING)
-       if (showRednCountStats) {
-          PrintRednCountInfo();
-       }
+# if defined(TICKY_TICKY)
+       if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
 # endif
        abort();
       }
 # endif
        abort();
       }
@@ -241,13 +238,13 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
     __DEROOT_PTR_REG(IS_LIVE_R2(liveness),2);
     __DEROOT_PTR_REG(IS_LIVE_R1(liveness),1);
 
     __DEROOT_PTR_REG(IS_LIVE_R2(liveness),2);
     __DEROOT_PTR_REG(IS_LIVE_R1(liveness),1);
 
-    assert(num_ptr_roots == 0); /* we have put it all back */
+    ASSERT(num_ptr_roots == 0); /* we have put it all back */
 
     unblockUserSignals();
 
 #endif /* !CONCURRENT */
 
 
     unblockUserSignals();
 
 #endif /* !CONCURRENT */
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     CCC = Save_CCC;
 
     RESTART_TIME_PROFILER;
     CCC = Save_CCC;
 
     RESTART_TIME_PROFILER;
@@ -309,7 +306,7 @@ PerformReschedule(liveness, always_reenter_node)
        }
 
       /* Set up to re-enter Node, so as to be sure it's really there. */
        }
 
       /* Set up to re-enter Node, so as to be sure it's really there. */
-      assert(liveness & LIVENESS_R1);
+      ASSERT(liveness & LIVENESS_R1);
       TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
       TSO_PC2(CurrentTSO) = (void *) EnterNodeCode;
     }
       TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
       TSO_PC2(CurrentTSO) = (void *) EnterNodeCode;
     }
@@ -382,7 +379,7 @@ PruneSparks(STG_NO_ARGS)
             (SPARK_NODE(spark) == Nil_closure) ) {
 #  if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
             (SPARK_NODE(spark) == Nil_closure) ) {
 #  if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
-               fprintf(main_statsfile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Nil_closure\n", spark);
+               fprintf(RTSflags.GcFlags.statsFile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Nil_closure\n", spark);
 #  endif
            if (do_qp_prof)
                QP_Event0(threadId++, SPARK_NODE(spark));
 #  endif
            if (do_qp_prof)
                QP_Event0(threadId++, SPARK_NODE(spark));
@@ -418,7 +415,7 @@ PruneSparks(STG_NO_ARGS)
        SPARK_NEXT(prev) = NULL;
     PendingSparksTl[proc][pool] = prev;
     if (prunedSparks>0) 
        SPARK_NEXT(prev) = NULL;
     PendingSparksTl[proc][pool] = prev;
     if (prunedSparks>0) 
-      fprintf(main_statsfile,"Pruning and disposing %lu excess sparks (> %lu) on proc %ld in PruneSparks\n",
+      fprintf(RTSflags.GcFlags.statsFile,"Pruning and disposing %lu excess sparks (> %lu) on proc %ld in PruneSparks\n",
              prunedSparks,(W_) MAX_SPARKS,proc);
    }  /* forall pool ... */
   }   /* forall proc ... */
              prunedSparks,(W_) MAX_SPARKS,proc);
    }  /* forall pool ... */
   }   /* forall proc ... */
@@ -477,7 +474,19 @@ rtsBool do_full_collection;
                                    as we re-store them. */
     P_ stack, tso, next;
 
                                    as we re-store them. */
     P_ stack, tso, next;
 
-    /* Discard the saved stack and TSO space */
+    /* Discard the saved stack and TSO space.
+       What's going on here:  TSOs and StkOs are on the mutables
+       list (mutable things in the old generation). Here, we change
+       them to immutable, so that the scavenger (which chks all
+       mutable objects) can detect their immutability and remove
+       them from the list.  Setting to MUTUPLE_VHS as the size is
+       essentially saying "No pointers in here" (i.e., empty).
+
+       Without this change of status, these
+       objects might not really die, probably with some horrible
+       disastrous consequence that we don't want to think about.
+       Will & Phil 95/10
+    */
 
     for(stack = AvailableStack; stack != Nil_closure; stack = next) {
        next = STKO_LINK(stack);
 
     for(stack = AvailableStack; stack != Nil_closure; stack = next) {
        next = STKO_LINK(stack);
@@ -509,7 +518,7 @@ rtsBool do_full_collection;
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
-               fprintf(main_statsfile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n",
+               fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n",
                        num_ptr_roots,proc,RunnableThreadsHd[proc]);
 #  endif
 
                        num_ptr_roots,proc,RunnableThreadsHd[proc]);
 #  endif
 
@@ -517,7 +526,7 @@ rtsBool do_full_collection;
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
-               fprintf(main_statsfile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n",
+               fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n",
                        num_ptr_roots,proc,RunnableThreadsTl[proc]);
 #  endif       
     StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc];
                        num_ptr_roots,proc,RunnableThreadsTl[proc]);
 #  endif       
     StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc];
@@ -537,7 +546,7 @@ rtsBool do_full_collection;
 
 # if defined(GRAN_CHECK) && defined(GRAN)
     if ( debug & 0x40 ) 
 
 # if defined(GRAN_CHECK) && defined(GRAN)
     if ( debug & 0x40 ) 
-      fprintf(main_statsfile,"Saving CurrentTSO %d -- 0x%lx\n",
+      fprintf(RTSflags.GcFlags.statsFile,"Saving CurrentTSO %d -- 0x%lx\n",
              num_ptr_roots,CurrentTSO);
 # endif
 
              num_ptr_roots,CurrentTSO);
 # endif
 
@@ -553,12 +562,10 @@ rtsBool do_full_collection;
     
     if (collectHeap(reqsize, &StorageMgrInfo, do_full_collection) != GC_SUCCESS) { 
 
     
     if (collectHeap(reqsize, &StorageMgrInfo, do_full_collection) != GC_SUCCESS) { 
 
-       OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/
+       OutOfHeapHook(reqsize * sizeof(W_)); /*msg*/
 
 
-# if defined(DO_REDN_COUNTING)
-       if (showRednCountStats) {
-           PrintRednCountInfo();
-       }
+# if defined(TICKY_TICKY)
+       if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
 # endif
        EXIT(EXIT_FAILURE);
     }
 # endif
        EXIT(EXIT_FAILURE);
     }
@@ -570,7 +577,7 @@ rtsBool do_full_collection;
 
 # if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
 
 # if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
-           fprintf(main_statsfile,"Restoring CurrentTSO %d -- new: 0x%lx\n",
+           fprintf(RTSflags.GcFlags.statsFile,"Restoring CurrentTSO %d -- new: 0x%lx\n",
                    num_ptr_roots-1,StorageMgrInfo.roots[num_ptr_roots-1]);
 # endif
 
                    num_ptr_roots-1,StorageMgrInfo.roots[num_ptr_roots-1]);
 # endif
 
@@ -599,7 +606,7 @@ rtsBool do_full_collection;
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
-           fprintf(main_statsfile,"Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n",
+           fprintf(RTSflags.GcFlags.statsFile,"Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n",
                    num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
 #  endif
 
                    num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
 #  endif
 
@@ -607,7 +614,7 @@ rtsBool do_full_collection;
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
 
 #  if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
-           fprintf(main_statsfile,"Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n",
+           fprintf(RTSflags.GcFlags.statsFile,"Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n",
                    num_ptr_roots,proc,StorageMgrInfo.roots[num_ptr_roots]);
 #  endif
 
                    num_ptr_roots,proc,StorageMgrInfo.roots[num_ptr_roots]);
 #  endif
 
@@ -639,7 +646,7 @@ This routine rattles down the B stack, black-holing any
 pending updates to avoid space leaks from them.
 
 \begin{code}
 pending updates to avoid space leaks from them.
 
 \begin{code}
-#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
+#if !defined(CONCURRENT)
 
 static
 void
 
 static
 void
@@ -647,7 +654,7 @@ BlackHoleUpdateStack(STG_NO_ARGS)
 {
     P_ PtrToUpdateFrame;
 
 {
     P_ PtrToUpdateFrame;
 
-    if (noBlackHoles)
+    if (! RTSflags.GcFlags.lazyBlackHoling)
        return;
 
     PtrToUpdateFrame = MAIN_SuB;
        return;
 
     PtrToUpdateFrame = MAIN_SuB;
@@ -663,17 +670,14 @@ BlackHoleUpdateStack(STG_NO_ARGS)
        PtrToUpdateFrame = GRAB_SuB(PtrToUpdateFrame);
     }
 }
        PtrToUpdateFrame = GRAB_SuB(PtrToUpdateFrame);
     }
 }
-#endif /* CONCURRENT && SM_DO_BH_UPDATE */
+#endif /* CONCURRENT */
 \end{code}
 
 
 \begin{code}
 #if defined(CONCURRENT) && !defined(GRAN)
 void
 \end{code}
 
 
 \begin{code}
 #if defined(CONCURRENT) && !defined(GRAN)
 void
-PerformReschedule(liveness, always_reenter_node)
-  W_ liveness;
-  W_  always_reenter_node;
-
+PerformReschedule(W_ liveness, W_ always_reenter_node)
 { }
 #endif
 \end{code}
 { }
 #endif
 \end{code}
index 1952d0c..b9d050f 100644 (file)
@@ -77,12 +77,7 @@ STGFUN(startPerformIO)
        used to load the STG registers.
     */
 
        used to load the STG registers.
     */
 
-#if defined (DO_SPAT_PROFILING)
-    SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns */
-#endif
-
-    /* Load up the real registers from the *_SAVE locns.
-    */
+    /* Load up the real registers from the *_SAVE locns. */
     RestoreAllStgRegs();       /* inline! */
 
     /* ------- STG registers are now valid! -------------------------*/
     RestoreAllStgRegs();       /* inline! */
 
     /* ------- STG registers are now valid! -------------------------*/
@@ -148,10 +143,6 @@ STGFUN(startEnterInt)
 {
     FUNBEGIN;
 
 {
     FUNBEGIN;
 
-#if defined (DO_SPAT_PROFILING)
-    SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */
-#endif
-
     /* Load up the real registers from the *_SAVE locns. */
 #if defined(__STG_GCC_REGS__)
     RestoreAllStgRegs();       /* inline! */
     /* Load up the real registers from the *_SAVE locns. */
 #if defined(__STG_GCC_REGS__)
     RestoreAllStgRegs();       /* inline! */
@@ -211,10 +202,6 @@ STGFUN(startEnterFloat)
 {
     FUNBEGIN;
 
 {
     FUNBEGIN;
 
-#if defined (DO_SPAT_PROFILING)
-    SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */
-#endif
-
     /* Load up the real registers from the *_SAVE locns. */
 #if defined(__STG_GCC_REGS__)
     RestoreAllStgRegs();       /* inline! */
     /* Load up the real registers from the *_SAVE locns. */
 #if defined(__STG_GCC_REGS__)
     RestoreAllStgRegs();       /* inline! */
index 4730355..dec93aa 100644 (file)
@@ -20,29 +20,17 @@ is even more dated.)
 
 extern StgPtr unstable_Closure;
 
 
 extern StgPtr unstable_Closure;
 
-#ifndef __STG_TAILJUMPS__
-extern int doSanityChks;
-extern void checkAStack(STG_NO_ARGS);
-#endif
-
 void
 enterStablePtr(stableIndex, startCode)
   StgStablePtr stableIndex;
   StgFunPtr startCode;
 {
 void
 enterStablePtr(stableIndex, startCode)
   StgStablePtr stableIndex;
   StgFunPtr startCode;
 {
-  unstable_Closure = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
+    unstable_Closure
+      = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
 
 /* ToDo: Set arity to right value - if necessary */
 
 
 /* ToDo: Set arity to right value - if necessary */
 
-#if defined(__STG_TAILJUMPS__)
-  miniInterpret(startCode);
-#else
-  if (doSanityChks)
-    miniInterpret_debug(startCode, checkAStack);
-  else
     miniInterpret(startCode);
     miniInterpret(startCode);
-#endif /* not tail-jumping */
-
 }
 \end{code}
 
 }
 \end{code}
 
index 77b24d0..3e5b2bc 100644 (file)
@@ -63,10 +63,12 @@ Older code (less fancy ==> more reliable)
   DEBUG_UPDATES(frames)                Print "frames" update frames
   DEBUG_REGS()                 Print register values
   DEBUG_MP()                    Print the MallocPtr Lists
   DEBUG_UPDATES(frames)                Print "frames" update frames
   DEBUG_REGS()                 Print register values
   DEBUG_MP()                    Print the MallocPtr Lists
+  DEBUG_TSO(tso)               (CONCURRENT) Print a Thread State Object
 
 
-\begin{code}
-#if defined(RUNTIME_DEBUGGING)
+Not yet implemented:
+  DEBUG_STKO(stko)             (CONCURRENT) Print a STacK Object
 
 
+\begin{code}
 #include "rtsdefs.h"
 \end{code}
 
 #include "rtsdefs.h"
 \end{code}
 
@@ -76,8 +78,8 @@ NB: this assumes a.out files - won't work on Alphas.
 ToDo: At least add some #ifdefs
 
 \begin{code}
 ToDo: At least add some #ifdefs
 
 \begin{code}
-#include <a.out.h>
-#include <stab.h>
+/* #include <a.out.h> */
+/* #include <stab.h> */
 /* #include <nlist.h> */
 
 #include <stdio.h>
 /* #include <nlist.h> */
 
 #include <stdio.h>
@@ -99,26 +101,26 @@ static int max_table_size;
 static int table_size;
 static struct entry* table;
 
 static int table_size;
 static struct entry* table;
 
-static
-void reset_table( int size )
+static void
+reset_table( int size )
 {
   max_table_size = size;
   table_size = 0;
 {
   max_table_size = size;
   table_size = 0;
-  table = (struct entry *) malloc( size * sizeof( struct entry ) );
+  table = (struct entry *) stgMallocBytes(size * sizeof(struct entry), "reset_table");
 }
 
 }
 
-static
-void prepare_table()
+static void
+prepare_table()
 {
   /* Could sort it... */
 }
 
 {
   /* Could sort it... */
 }
 
-static
-void insert( unsigned value, int index, char *name )
+static void
+insert( unsigned value, int index, char *name )
 {
   if ( table_size >= max_table_size ) {
     fprintf( stderr, "Symbol table overflow\n" );
 {
   if ( table_size >= max_table_size ) {
     fprintf( stderr, "Symbol table overflow\n" );
-    exit( 1 );
+    EXIT( 1 );
   }
   table[table_size].value = value;
   table[table_size].index = index;
   }
   table[table_size].value = value;
   table[table_size].index = index;
@@ -126,8 +128,8 @@ void insert( unsigned value, int index, char *name )
   table_size = table_size + 1;
 }
 
   table_size = table_size + 1;
 }
 
-static
-int lookup( unsigned value, int *result )
+static int
+lookup( unsigned value, int *result )
 {
   int i;
   for( i = 0; i < table_size && table[i].value != value; ++i ) {
 {
   int i;
   for( i = 0; i < table_size && table[i].value != value; ++i ) {
@@ -140,7 +142,8 @@ int lookup( unsigned value, int *result )
   }
 }
 
   }
 }
 
-static int lookup_name( char *name, unsigned *result )
+static int
+lookup_name( char *name, unsigned *result )
 {
   int i;
   for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
 {
   int i;
   for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
@@ -339,11 +342,13 @@ static void printName( P_ addr )
   }
 }
   
   }
 }
   
+#if 0          /* OMIT load-symbol stuff cos it doesn't work on Alphas */
+
 /* Fairly ad-hoc piece of code that seems to filter out a lot of
    rubbish like the obj-splitting symbols */
 
 /* Fairly ad-hoc piece of code that seems to filter out a lot of
    rubbish like the obj-splitting symbols */
 
-static
-int isReal( unsigned char type, char *name )
+static int
+isReal( unsigned char type, char *name )
 {
   int external = type & N_EXT;
   int tp = type & N_TYPE;
 {
   int external = type & N_EXT;
   int tp = type & N_TYPE;
@@ -355,7 +360,8 @@ int isReal( unsigned char type, char *name )
   }
 }
 
   }
 }
 
-void DEBUG_LoadSymbols( char *name )
+void
+DEBUG_LoadSymbols( char *name )
 {
   FILE *binary;
 
 {
   FILE *binary;
 
@@ -381,11 +387,11 @@ void DEBUG_LoadSymbols( char *name )
 
   if (fread( &header,  sizeof( struct exec ), 1, binary ) != 1) { 
     fprintf( stderr, "Can't read symbol table header.\n" );
 
   if (fread( &header,  sizeof( struct exec ), 1, binary ) != 1) { 
     fprintf( stderr, "Can't read symbol table header.\n" );
-    exit( 1 );
+    EXIT( 1 );
   }
   if ( N_BADMAG( header ) ) {
     fprintf( stderr, "Bad magic number in symbol table header.\n" );
   }
   if ( N_BADMAG( header ) ) {
     fprintf( stderr, "Bad magic number in symbol table header.\n" );
-    exit( 1 );
+    EXIT( 1 );
   }
 
 
   }
 
 
@@ -395,41 +401,30 @@ void DEBUG_LoadSymbols( char *name )
   num_syms = sym_size / sizeof( struct nlist );
   fseek( binary, sym_offset, FROM_START );
 
   num_syms = sym_size / sizeof( struct nlist );
   fseek( binary, sym_offset, FROM_START );
 
-  symbol_table = (struct nlist *) malloc( sym_size );
-  if (symbol_table == NULL) {
-    fprintf( stderr, "Can't allocate symbol table of size %d\n", sym_size );
-    exit( 1 );
-  }
-
+  symbol_table = (struct nlist *) stgMallocBytes(sym_size, "symbol table (DEBUG_LoadSymbols)");
   printf("Reading %d symbols\n", num_syms);
 
   if (fread( symbol_table, sym_size, 1, binary ) != 1) {
     fprintf( stderr, "Can't read symbol table\n");
   printf("Reading %d symbols\n", num_syms);
 
   if (fread( symbol_table, sym_size, 1, binary ) != 1) {
     fprintf( stderr, "Can't read symbol table\n");
-    exit( 1 );
+    EXIT( 1 );
   }
 
   }
 
-
-
   str_offset = N_STROFF( header );
   fseek( binary, str_offset, FROM_START );
 
   if (fread( &str_size, 4, 1, binary ) != 1) {
     fprintf( stderr, "Can't read string table size\n");
   str_offset = N_STROFF( header );
   fseek( binary, str_offset, FROM_START );
 
   if (fread( &str_size, 4, 1, binary ) != 1) {
     fprintf( stderr, "Can't read string table size\n");
-    exit( 1 );
+    EXIT( 1 );
   }
 
   /* apparently the size of the string table includes the 4 bytes that
    * store the size...
    */
   }
 
   /* apparently the size of the string table includes the 4 bytes that
    * store the size...
    */
-  string_table = (char *) malloc( str_size );
-  if (string_table == NULL) {
-    fprintf( stderr, "Can't allocate string table of size %d\n", str_size );
-    exit( 1 );
-  }
+  string_table = (char *) stgMallocBytes(str_size, "string table (DEBUG_LoadSymbols)");
 
   if (fread( string_table+4, str_size-4, 1, binary ) != 1) {
     fprintf( stderr, "Can't read string table\n");
 
   if (fread( string_table+4, str_size-4, 1, binary ) != 1) {
     fprintf( stderr, "Can't read string table\n");
-    exit( 1 );
+    EXIT( 1 );
   }
 
   num_real_syms = 0;
   }
 
   num_real_syms = 0;
@@ -478,6 +473,7 @@ void DEBUG_LoadSymbols( char *name )
 
   prepare_table();
 }
 
   prepare_table();
 }
+#endif /* 0 */
 \end{code}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \end{code}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -510,8 +506,7 @@ static int DEBUG_details = 2;
 
 \begin{code}
 /* Determine the size and number of pointers for this kind of closure */
 
 \begin{code}
 /* Determine the size and number of pointers for this kind of closure */
-static
-void 
+static void 
 getClosureShape( P_ node, int *vhs, int *size, int *ptrs, char **type )
 {
   /* The result is used for printing out closure contents.  If the
 getClosureShape( P_ node, int *vhs, int *size, int *ptrs, char **type )
 {
   /* The result is used for printing out closure contents.  If the
@@ -718,28 +713,26 @@ getClosureShape( P_ node, int *vhs, int *size, int *ptrs, char **type )
     }
 }  
 
     }
 }  
 
-static
-void 
+static void 
 printWord( W_ word )
 {
   printf("0x%08lx", word);
 }
 
 printWord( W_ word )
 {
   printf("0x%08lx", word);
 }
 
-static
-void
+static void
 printAddress( P_ address )
 {
 printAddress( P_ address )
 {
-#ifdef PAR
+# ifdef CONCURRENT
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
   P_  SuB  = STKO_SuB(SAVE_StkO);
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
   P_  SuB  = STKO_SuB(SAVE_StkO);
-#else
+# else
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
   P_  SpB  = SAVE_SpB;
   P_  SuB  = SAVE_SuB;
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
   P_  SpB  = SAVE_SpB;
   P_  SuB  = SAVE_SuB;
-#endif
+# endif
   P_  Hp   = SAVE_Hp;
 
   PP_ botA = stackInfo.botA;
   P_  Hp   = SAVE_Hp;
 
   PP_ botA = stackInfo.botA;
@@ -753,9 +746,13 @@ printAddress( P_ address )
   /* The @-1@s in stack comparisions are because we sometimes use the
      address of just below the stack... */
 
   /* The @-1@s in stack comparisions are because we sometimes use the
      address of just below the stack... */
 
+#if 0
   if (lookupForName( address, &name )) {
     printZcoded( name );
   if (lookupForName( address, &name )) {
     printZcoded( name );
-  } else {
+  }
+  else
+#endif
+  {
     if (DEBUG_details > 1) {
       printWord( (W_) address );
       printf(" : ");
     if (DEBUG_details > 1) {
       printWord( (W_) address );
       printf(" : ");
@@ -773,8 +770,7 @@ printAddress( P_ address )
   }
 }
 
   }
 }
 
-static
-void
+static void
 printIndentation( int indentation )
 {
   int i;
 printIndentation( int indentation )
 {
   int i;
@@ -782,15 +778,14 @@ printIndentation( int indentation )
 }
 
 /* The weight parameter is used to (eventually) break cycles */
 }
 
 /* The weight parameter is used to (eventually) break cycles */
-static 
-void 
+static void 
 printStandardShapeClosure( 
       int indentation, 
       int weight, 
       P_ closure, int vhs, int size, int noPtrs
 )
 {
 printStandardShapeClosure( 
       int indentation, 
       int weight, 
       P_ closure, int vhs, int size, int noPtrs
 )
 {
-#ifdef PAR
+#ifdef CONCURRENT
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
@@ -1013,7 +1008,8 @@ minimum(int a, int b)
   }
 }
 
   }
 }
 
-void DEBUG_PrintA( int depth, int weight )
+void
+DEBUG_PrintA( int depth, int weight )
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
@@ -1034,7 +1030,8 @@ void DEBUG_PrintA( int depth, int weight )
   }
 }
 
   }
 }
 
-void DEBUG_PrintB( int depth, int weight )
+void
+DEBUG_PrintB( int depth, int weight )
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
@@ -1111,10 +1108,10 @@ ToDo:
 
 \begin{code}
 /* How many real stacks are there on SpA and SpB? */
 
 \begin{code}
 /* How many real stacks are there on SpA and SpB? */
-static
-int numStacks( )
+static int
+numStacks( )
 {
 {
-#ifdef PAR
+#ifdef CONCURRENT
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
@@ -1136,8 +1133,8 @@ int numStacks( )
   return depth;
 }
 
   return depth;
 }
 
-static
-void printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size )
+static void
+printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size )
 {
   int i;
 
 {
   int i;
 
@@ -1153,8 +1150,8 @@ void printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size
   }
 }
 
   }
 }
 
-static
-void printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size )
+static void
+printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size )
 {
   int i;
 
 {
   int i;
 
@@ -1170,8 +1167,8 @@ void printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size
   }
 }
 
   }
 }
 
-static
-void printEnvironment( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
+static void
+printEnvironment( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
 {
   int sizeA = SUBTRACT_A_STK(SpA, SuA);
   int sizeB = SUBTRACT_B_STK(SpB, SuB);
 {
   int sizeA = SUBTRACT_A_STK(SpA, SuA);
   int sizeB = SUBTRACT_B_STK(SpB, SuB);
@@ -1215,8 +1212,8 @@ ToDo:
 \begin{code}
 static int maxDepth = 5;
 
 \begin{code}
 static int maxDepth = 5;
 
-static
-int printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
+static int
+printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
 {
   int indentation;
 
 {
   int indentation;
 
@@ -1255,8 +1252,8 @@ int printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
 
 /* ToDo: pay more attention to format of vector tables in SMupdate.lh */
 
 
 /* ToDo: pay more attention to format of vector tables in SMupdate.lh */
 
-static
-int isVTBLEntry( P_ entry )
+static int
+isVTBLEntry( P_ entry )
 {
   char *raw;
 
 {
   char *raw;
 
@@ -1273,8 +1270,8 @@ int isVTBLEntry( P_ entry )
   }
 }
 
   }
 }
 
-static
-void printVectorTable( int indentation, PP_ vtbl )
+static void
+printVectorTable( int indentation, PP_ vtbl )
 {
   if (isVTBLEntry( (P_) vtbl )) { /* Direct return */
     printName( (P_) vtbl );
 {
   if (isVTBLEntry( (P_) vtbl )) { /* Direct return */
     printName( (P_) vtbl );
@@ -1290,8 +1287,8 @@ void printVectorTable( int indentation, PP_ vtbl )
   }
 }
 
   }
 }
 
-static
-void printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
+static void
+printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
 {
   if (depth < maxDepth && SUBTRACT_B_STK(SuB, stackInfo.botB) >= 0) {
     PP_ nextSpA, nextSuA;
 {
   if (depth < maxDepth && SUBTRACT_B_STK(SuB, stackInfo.botB) >= 0) {
     PP_ nextSpA, nextSuA;
@@ -1340,10 +1337,10 @@ void printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ Su
   }
 }
 
   }
 }
 
-
-void DEBUG_Where( int depth, int weight )
+void
+DEBUG_Where( int depth, int weight )
 {
 {
-#ifdef PAR
+#ifdef CONCURRENT
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
@@ -1380,11 +1377,9 @@ void DEBUG_Where( int depth, int weight )
 
 
 \begin{code}
 
 
 \begin{code}
-#if defined(RUNTIME_DEBUGGING)
-
 void
 DEBUG_INFO_TABLE(node)
 void
 DEBUG_INFO_TABLE(node)
-P_ node;
+  P_ node;
 {
   int vhs, size, ptrs; /* not used */
   char *ip_type;
 {
   int vhs, size, ptrs; /* not used */
   char *ip_type;
@@ -1404,9 +1399,9 @@ P_ node;
   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 #endif /* PAR */
 
   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 #endif /* PAR */
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
   fprintf(stderr,"Cost Centre:       0x%lx\n",INFO_CAT(info_ptr));
   fprintf(stderr,"Cost Centre:       0x%lx\n",INFO_CAT(info_ptr));
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 
 #if defined(_INFO_COPYING)
   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
 
 #if defined(_INFO_COPYING)
   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
@@ -1428,7 +1423,7 @@ P_ node;
 void
 DEBUG_REGS()
 {
 void
 DEBUG_REGS()
 {
-#ifdef PAR
+#ifdef CONCURRENT
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
   PP_ SpA  = STKO_SpA(SAVE_StkO);
   PP_ SuA  = STKO_SuA(SAVE_StkO);
   P_  SpB  = STKO_SpB(SAVE_StkO);
@@ -1481,6 +1476,8 @@ DEBUG_REGS()
   fprintf(stderr,"Dble:  %8g, %8g\n",DblReg1,DblReg2);
 }
 
   fprintf(stderr,"Dble:  %8g, %8g\n",DblReg1,DblReg2);
 }
 
+#ifndef CONCURRENT
+
 void
 DEBUG_MP()
 {
 void
 DEBUG_MP()
 {
@@ -1500,7 +1497,7 @@ DEBUG_MP()
 */
   }
 
 */
   }
 
-#if defined(GCap) || defined(GCgn)
+# if defined(GCap) || defined(GCgn)
   fprintf(stderr,"\nOldMallocPtr List\n\n");
 
   for(mp = StorageMgrInfo.OldMallocPtrList; 
   fprintf(stderr,"\nOldMallocPtr List\n\n");
 
   for(mp = StorageMgrInfo.OldMallocPtrList; 
@@ -1512,12 +1509,11 @@ DEBUG_MP()
    DEBUG_PRINT_NODE(mp);
 */
   }
    DEBUG_PRINT_NODE(mp);
 */
   }
-#endif /* GCap || GCgn */
+# endif /* GCap || GCgn */
 
   fprintf(stderr, "\n");
 }
 
 
   fprintf(stderr, "\n");
 }
 
-#ifndef PAR
 void
 DEBUG_SPT(int weight)
 { 
 void
 DEBUG_SPT(int weight)
 { 
@@ -1555,23 +1551,21 @@ DEBUG_SPT(int weight)
   fprintf(stderr, "\n\n");
 
 }
   fprintf(stderr, "\n\n");
 
 }
-#endif /* !PAR */       
-
+#endif /* !CONCURRENT */       
 
 /*
   These routines crawl over the A and B stacks, printing
   a maximum "lines" lines at the top of the stack.
 */
 
 
 /*
   These routines crawl over the A and B stacks, printing
   a maximum "lines" lines at the top of the stack.
 */
 
-
 #define        STACK_VALUES_PER_LINE   5
 
 #define        STACK_VALUES_PER_LINE   5
 
-#if !defined(PAR)
+#ifndef CONCURRENT
 /* (stack stuff is really different on parallel machines) */
 
 void
 DEBUG_ASTACK(lines)
 /* (stack stuff is really different on parallel machines) */
 
 void
 DEBUG_ASTACK(lines)
-I_ lines;
+  I_ lines;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
@@ -1599,10 +1593,9 @@ I_ lines;
   fprintf(stderr, "\n");
 }
 
   fprintf(stderr, "\n");
 }
 
-
 void
 DEBUG_BSTACK(lines)
 void
 DEBUG_BSTACK(lines)
-I_ lines;
+  I_ lines;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
@@ -1629,49 +1622,76 @@ I_ lines;
       }
   fprintf(stderr, "\n");
 }
       }
   fprintf(stderr, "\n");
 }
-#endif /* not parallel */
+#endif /* not concurrent */
 
 /*
   This should disentangle update frames from both stacks.
 */
 
 
 /*
   This should disentangle update frames from both stacks.
 */
 
-#if ! defined(PAR)
+#ifndef CONCURRENT
 void
 DEBUG_UPDATES(limit)
 void
 DEBUG_UPDATES(limit)
-I_ limit;
+  I_ limit;
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
   P_  SpB  = SAVE_SpB;
   P_  SuB  = SAVE_SuB;
 
 {
   PP_ SpA  = SAVE_SpA;
   PP_ SuA  = SAVE_SuA;
   P_  SpB  = SAVE_SpB;
   P_  SuB  = SAVE_SuB;
 
-  P_ updatee, retreg;
-  PP_ sua;
-  P_ sub;
-  PP_ spa = SuA;
-  P_ spb = SuB;
-  I_ count = 0;
+  P_  updatee, retreg;
+  PP_ sua, spa;
+  P_  sub, spb;
+  I_  count = 0;
 
   fprintf(stderr,"Update Frame Stack Dump:\n\n");
   
 
   fprintf(stderr,"Update Frame Stack Dump:\n\n");
   
-  for(spb = SuB;
+  for(spa = SuA, spb = SuB;
       SUBTRACT_B_STK(spb, stackInfo.botB) > 0 && count++ < limit;
       SUBTRACT_B_STK(spb, stackInfo.botB) > 0 && count++ < limit;
-      /* re-init given explicitly */)
-    {
+      spa = GRAB_SuA(spb), spb = GRAB_SuB(spb) ) {
+
       updatee = GRAB_UPDATEE(spb);        /* Thing to be updated  */
       retreg  = (P_) GRAB_RET(spb);       /* Return vector below */
 
       updatee = GRAB_UPDATEE(spb);        /* Thing to be updated  */
       retreg  = (P_) GRAB_RET(spb);       /* Return vector below */
 
-      fprintf(stderr,"SuA: 0x%08lx, SuB: 0x%08lx, Updatee 0x%08lx, RetReg 0x%x\n",
+      fprintf(stderr,"SuA: 0x%08lx, SuB: 0x%08lx, Updatee 0x%08lx (Info 0x%08lx), RetReg 0x%x\n",
                     (W_) spa, (W_) spb,
                     (W_) spa, (W_) spb,
-                    (W_) updatee, (W_) retreg);
+                    (W_) updatee, (W_) INFO_PTR(updatee), (W_) retreg);
+  }
+}
+
+#endif /* not concurrent */
+\end{code}
 
 
-      spa = GRAB_SuA(spb);                 /* Next SuA, SuB */
-      spb = GRAB_SuB(spb);
+\begin{code}
+#ifdef CONCURRENT
+
+void
+DEBUG_TSO(P_ tso)
+{
+    STGRegisterTable *r = TSO_INTERNAL_PTR(tso);
+    W_ liveness = r->rLiveness;
+    I_ i;
+
+    fprintf(stderr,"TSO:\ntso=%lx, regs=%lx, liveness=%lx\nlink=%lx,name=%lx,id=%lx,type=%lx,pc1=%lx,arg1=%lx,switch=%lx\n"
+           , tso
+           , r
+           , liveness
+           , TSO_LINK(tso)
+           , TSO_NAME(tso)
+           , TSO_ID(tso)
+           , TSO_TYPE(tso)
+           , TSO_PC1(tso)
+           , TSO_ARG1(tso)
+           , TSO_SWITCH(tso)
+           );
+
+    for (i = 0; liveness != 0; liveness >>= 1, i++) {
+       if (liveness & 1) {
+           fprintf(stderr, "live reg %d (%lx)\n",i, r->rR[i].p);
+       } else {
+           fprintf(stderr, "reg %d (%lx) not live\n", i, r->rR[i].p);
+       }
     }
 }
     }
 }
-#endif /* not parallel */
-
-#endif /* RUNTIME_DEBUGGING */
 
 
-#endif /* PAR || RUNTIME_DEBUGGING */
+#endif /* concurrent */
 \end{code}
 \end{code}
index 2739ad7..eaa811f 100644 (file)
@@ -43,12 +43,6 @@ less code.
 \begin{code}
 #if defined(__STG_TAILJUMPS__) && defined(__GNUC__)
 
 \begin{code}
 #if defined(__STG_TAILJUMPS__) && defined(__GNUC__)
 
-#if i386_TARGET_ARCH || i486_TARGET_ARCH
-/* All together now: "Hack me gently, hack me dead ..." */
-P_ SP_stack[8]; /* two/three? is all that is really needed, I think (WDP) */
-I_ SP_stack_ptr = -1;
-#endif
-
 void
 miniInterpret(start_cont)
     StgFunPtr start_cont;
 void
 miniInterpret(start_cont)
     StgFunPtr start_cont;
@@ -154,91 +148,6 @@ void miniInterpretEnd(STG_NO_ARGS)
     /* ToDo: save real register in something somewhere */
     longjmp(jmp_environment, 1);
 }
     /* ToDo: save real register in something somewhere */
     longjmp(jmp_environment, 1);
 }
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsubsection[StgMiniInt-portable-debugging]{Debugging mini-interpreter for ``portable~C''}
-%*                                                                     *
-%************************************************************************
-
-See comments about @jmp_environment@ in section above.
-
-The debugging mini-interpreter, which is invoked if suitable RTS flags
-are given, offers two extra ``features:''
-\begin{description}
-
-\item[Circular buffer of last @NUM_SAVED_CONTINUATIONS@ continuations:]
-These are in @savedCont@, with @savedContCtr@ pointing to where the
-last one was slotted in.
-
-Reference is frequently made to this buffer when \tr{gdb}-ing broken C
-out of the compiler!
-
-\item[Hygiene-checking:]
-
-This version of the mini-interpreter can be given a hygiene-checking
-function which will be invoked each time 'round the loop.  Again,
-given suitable RTS flags, we pass along a routine that walks over the
-stack checking for Bad Stuff.  An example might be: pointers from the
-A stack into the wrong semi-space of the heap (indicating a
-garbage-collection bug)...
-\end{description}
-
-\begin{code}
-extern I_ doSanityChks; /* ToDo: move tidily */
-
-#define          NUM_SAVED_CONTINUATIONS 32    /* For debug */
-I_       totalContCtr;
-I_       savedContCtr;
-StgFunPtr savedCont[NUM_SAVED_CONTINUATIONS];
-
-void miniInterpret_debug(start_cont, hygiene)
-    StgFunPtr start_cont;
-    void (*hygiene)();
-{
-    StgFunPtr continuation = (StgFunPtr) start_cont;
-    StgFunPtr next_continuation;
-    jmp_buf save_buf;
-    bcopy((char *) jmp_environment, (char *) save_buf, sizeof(jmp_buf));       
-        /* Save jmp_environment for previous call to miniInterpret */
-    
-    if (setjmp(jmp_environment) == 0) {
-
-       totalContCtr = 0;
-       savedContCtr = 0;
-       savedCont[0] = start_cont;
-
-       while ( 1 ) {
-           next_continuation = (StgFunPtr) (continuation)();
-
-           totalContCtr += 1;
-           savedContCtr = (savedContCtr + 1) % NUM_SAVED_CONTINUATIONS;
-           savedCont[savedContCtr] = next_continuation;
-
-           continuation = next_continuation;
-
-           /* hygiene chk can't be at start of loop, because it's the
-              first continuation-thingy that loads up the registers.
-           */
-           if (doSanityChks && hygiene) {
-               (hygiene)();
-           }
-       }
-    }
-    /* Restore jmp_environment for previous call */
-    bcopy((char *) save_buf, (char *) jmp_environment, sizeof(jmp_buf));
-
-    /* ToDo: restore real registers ... (see longjmp) */
-    return;
-    /*
-       Note that on returning (after miniInterpretEnd is called)
-       the values variables declared as real machine registers
-       will be undefined.
-    */
-}
-
-/* debugging version uses same "miniInterpretEnd" as the regular one */
 
 #endif /* ! __STG_TAILJUMPS__ */
 \end{code}
 
 #endif /* ! __STG_TAILJUMPS__ */
 \end{code}
index 984751d..05b9dc8 100644 (file)
@@ -55,7 +55,7 @@ STGFUN(FetchMe_entry)
        QP_Event1("GR", CurrentTSO);
     }
 
        QP_Event1("GR", CurrentTSO);
     }
 
-    if(do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
@@ -124,7 +124,7 @@ STGFUN(FMBQ_entry)
        QP_Event1("GR", CurrentTSO);
     }
 
        QP_Event1("GR", CurrentTSO);
     }
 
-    if(do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
index af690e3..9ab5360 100644 (file)
@@ -29,15 +29,13 @@ allocGALA(STG_NO_ARGS)
 
     if ((gl = freeGALAList) != NULL) {
        freeGALAList = gl->next;
 
     if ((gl = freeGALAList) != NULL) {
        freeGALAList = gl->next;
-    } else if ((gl = (GALA *) malloc(GCHUNK * sizeof(GALA))) != NULL) {
+    } else {
+       gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA");
+
        freeGALAList = gl + 1;
        for (p = freeGALAList; p < gl + GCHUNK - 1; p++)
            p->next = p + 1;
        p->next = NULL;
        freeGALAList = gl + 1;
        for (p = freeGALAList; p < gl + GCHUNK - 1; p++)
            p->next = p + 1;
        p->next = NULL;
-    } else {
-       fflush(stdout);
-       fprintf(stderr, "VM exhausted\n");
-       EXIT(EXIT_FAILURE);
     }
     return gl;
 }
     }
     return gl;
 }
@@ -55,8 +53,7 @@ HashTable *taskIDtoPEtable = NULL;
 static int nextPE = 0;
 
 W_
 static int nextPE = 0;
 
 W_
-taskIDtoPE(gtid)
-GLOBAL_TASK_ID gtid;
+taskIDtoPE(GLOBAL_TASK_ID gtid)
 {
     return (W_) lookupHashTable(taskIDtoPEtable, gtid);
 }
 {
     return (W_) lookupHashTable(taskIDtoPEtable, gtid);
 }
@@ -92,7 +89,7 @@ P_ addr;
     GALA *gala;
 
     /* We never look for GA's on indirections */
     GALA *gala;
 
     /* We never look for GA's on indirections */
-    ASSERT(INFO_PTR(addr) != (W_) Ind_info);
+    ASSERT(INFO_PTR(addr) != (W_) Ind_info_TO_USE);
     if ((gala = lookupHashTable(LAtoGALAtable, (W_) addr)) == NULL)
        return NULL;
     else
     if ((gala = lookupHashTable(LAtoGALAtable, (W_) addr)) == NULL)
        return NULL;
     else
@@ -119,7 +116,7 @@ P_
 GALAlookup(ga)
 globalAddr *ga;
 {
 GALAlookup(ga)
 globalAddr *ga;
 {
-    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
     GALA *gala;
     P_ la;
 
     GALA *gala;
     P_ la;
 
@@ -128,11 +125,12 @@ globalAddr *ga;
     else {
        la = gala->la; 
        /* 
     else {
        la = gala->la; 
        /* 
-         * Bypass any indirections when returning a local closure to the caller.
-         * Note that we do not short-circuit the entry in the GALA tables right
-         * now, because we would have to do a hash table delete and insert in
-         * the LAtoGALAtable to keep that table up-to-date for preferred GALA pairs.
-         * That's probably a bit expensive.
+        * Bypass any indirections when returning a local closure to
+        * the caller.  Note that we do not short-circuit the entry in
+        * the GALA tables right now, because we would have to do a
+        * hash table delete and insert in the LAtoGALAtable to keep
+        * that table up-to-date for preferred GALA pairs.  That's
+        * probably a bit expensive.
          */
         while (IS_INDIRECTION(INFO_PTR(la)))
            la = (P_) IND_CLOSURE_PTR(la);
          */
         while (IS_INDIRECTION(INFO_PTR(la)))
            la = (P_) IND_CLOSURE_PTR(la);
@@ -165,8 +163,7 @@ Allocate an indirection slot for the closure currently at address @addr@.
 \begin{code}
 
 static GALA *
 \begin{code}
 
 static GALA *
-allocIndirection(addr)
-P_ addr;
+allocIndirection(P_ addr)
 {
     GALA *gala;
 
 {
     GALA *gala;
 
@@ -199,7 +196,7 @@ rtsBool preferred;
 {
     GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
     GALA *newGALA = allocIndirection(addr);
 {
     GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
     GALA *newGALA = allocIndirection(addr);
-    W_ pga = PACK_GA(thisPE, newGALA->ga.loc.gc.slot);
+    W_ pga = PackGA(thisPE, newGALA->ga.loc.gc.slot);
 
     ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
 
 
     ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
 
@@ -241,7 +238,7 @@ rtsBool preferred;
 {
     GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
     GALA *newGALA = allocGALA();
 {
     GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
     GALA *newGALA = allocGALA();
-    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
 
     ASSERT(ga->loc.gc.gtid != mytid);
     ASSERT(ga->weight > 0);
 
     ASSERT(ga->loc.gc.gtid != mytid);
     ASSERT(ga->weight > 0);
@@ -303,7 +300,7 @@ globalAddr *
 addWeight(ga)
 globalAddr *ga;
 {
 addWeight(ga)
 globalAddr *ga;
 {
-    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
     GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
 
 #ifdef DEBUG_WEIGHT
     GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
 
 #ifdef DEBUG_WEIGHT
@@ -357,6 +354,36 @@ RebuildLAGAtable(STG_NO_ARGS)
            insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
     }
 }
            insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
     }
 }
+\end{code}
+
+\begin{code}
+W_
+PackGA (pe, slot)
+  W_ pe;
+  int slot;
+{
+    int pe_shift = (BITS_IN(W_)*3)/4;
+    int pe_bits  = BITS_IN(W_) - pe_shift;
+
+    if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */
+       fflush(stdout);
+       fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n",slot,pe_bits);
+       EXIT(EXIT_FAILURE);
+    }
+
+    return((((W_)(pe)) << pe_shift) | ((W_)(slot)));
+       
+    /* the idea is to use 3/4 of the bits (e.g., 24) for indirection-
+       table "slot", and 1/4 for the pe# (e.g., 8).
+       
+       We check for too many bits in "slot", and double-check (at
+       compile-time?) that we have enough bits for "pe".  We *don't*
+       check for too many bits in "pe", because SysMan enforces a
+       MAX_PEs limit at the very very beginning.
+
+       Phil & Will 95/08
+    */
+}
 
 #endif /* PAR -- whole file */
 \end{code}
 
 #endif /* PAR -- whole file */
 \end{code}
index 8c561dd..450fa0b 100644 (file)
 sends it.  
 
 \begin{code}
 sends it.  
 
 \begin{code}
+static W_ *gumPackBuffer;
+
+void 
+InitMoreBuffers(STG_NO_ARGS)
+{
+    gumPackBuffer
+      = (W_ *) stgMallocWords(RTSflags.ParFlags.packBufferSize, "initMoreBuffers");
+}
+
 void
 sendFetch(rga, lga, load)
 globalAddr *rga, *lga;
 void
 sendFetch(rga, lga, load)
 globalAddr *rga, *lga;
@@ -52,9 +61,7 @@ int load;
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-unpackFetch(lga, rga, load)
-globalAddr *lga, *rga;
-int *load;
+unpackFetch(globalAddr *lga, globalAddr *rga, int *load)
 {
     long buf[6];
 
 {
     long buf[6];
 
@@ -105,9 +112,7 @@ P_ data;
 
 \begin{code}
 static void
 
 \begin{code}
 static void
-blockFetch(bf, bh)
-P_ bf;
-P_ bh;
+blockFetch(P_ bf, P_ bh)
 {
     switch (INFO_TYPE(INFO_PTR(bh))) {
     case INFO_BH_TYPE:
 {
     switch (INFO_TYPE(INFO_PTR(bh))) {
     case INFO_BH_TYPE:
@@ -117,8 +122,8 @@ P_ bh;
 
 #ifdef GC_MUT_REQUIRED
        /*
 
 #ifdef GC_MUT_REQUIRED
        /*
-        * If we modify a black hole in the old generation, we have to make sure it
-        * goes on the mutables list
+        * If we modify a black hole in the old generation, we have to
+        * make sure it goes on the mutables list
         */
 
        if (bh <= StorageMgrInfo.OldLim) {
         */
 
        if (bh <= StorageMgrInfo.OldLim) {
@@ -171,10 +176,10 @@ processFetches()
        next = BF_LINK(bf);
 
        /*
        next = BF_LINK(bf);
 
        /*
-        * Find the target at the end of the indirection chain, and process it in
-        * much the same fashion as the original target of the fetch.  Though we
-        * hope to find graph here, we could find a black hole (of any flavor) or
-        * even a FetchMe.
+        * Find the target at the end of the indirection chain, and
+        * process it in much the same fashion as the original target
+        * of the fetch.  Though we hope to find graph here, we could
+        * find a black hole (of any flavor) or even a FetchMe.
         */
        closure = BF_NODE(bf);
        while (IS_INDIRECTION(INFO_PTR(closure)))
         */
        closure = BF_NODE(bf);
        while (IS_INDIRECTION(INFO_PTR(closure)))
@@ -223,10 +228,7 @@ processFetches()
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-unpackResume(lga, nelem, data)
-globalAddr *lga;
-int *nelem;
-StgWord *data;
+unpackResume(globalAddr *lga, int *nelem, W_ *data)
 {
     long buf[3];
 
 {
     long buf[3];
 
@@ -250,12 +252,13 @@ GLOBAL_TASK_ID task;
 int ngas;
 globalAddr *gagamap;
 {
 int ngas;
 globalAddr *gagamap;
 {
-    long buffer[PACK_BUFFER_SIZE - PACK_HDR_SIZE];
+    static long *buffer;
     long *p;
     int i;
     long *p;
     int i;
-
     CostCentre Save_CCC = CCC;
 
     CostCentre Save_CCC = CCC;
 
+    buffer = (long *) gumPackBuffer;
+
     CCC = (CostCentre)STATIC_CC_REF(CC_MSG);
     CCC->scc_count++;
 
     CCC = (CostCentre)STATIC_CC_REF(CC_MSG);
     CCC->scc_count++;
 
@@ -286,9 +289,7 @@ Global addresses
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-unpackAck(ngas, gagamap)
-int *ngas;
-globalAddr *gagamap;
+unpackAck(int *ngas, globalAddr *gagamap)
 {
     long GAarraysize;
     long buf[6];
 {
     long GAarraysize;
     long buf[6];
@@ -345,9 +346,7 @@ fish. The history + hunger are not currently used.
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-unpackFish(origPE, age, history, hunger)
-GLOBAL_TASK_ID *origPE;
-int *age, *history, *hunger;
+unpackFish(GLOBAL_TASK_ID *origPE, int *age, int *history, int *hunger)
 {
     long buf[4];
 
 {
     long buf[4];
 
@@ -391,9 +390,7 @@ a data block.
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-unpackFree(nelem, data)
-int *nelem;
-W_ *data;
+unpackFree(int *nelem, W_ *data)
 {
     long buf[1];
 
 {
     long buf[1];
 
@@ -440,9 +437,7 @@ block (data).
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-unpackSchedule(nelem, data)
-int *nelem;
-W_ *data;
+unpackSchedule(int *nelem, W_ *data)
 {
     long buf[1];
 
 {
     long buf[1];
 
@@ -469,7 +464,6 @@ processFish(STG_NO_ARGS)
 
     unpackFish(&origPE, &age, &history, &hunger);
 
 
     unpackFish(&origPE, &age, &history, &hunger);
 
-    /* Ignore our own fish if we're busy; otherwise send it out after a delay */
     if (origPE == mytid) {
         fishing = rtsFalse;
     } else {
     if (origPE == mytid) {
         fishing = rtsFalse;
     } else {
@@ -584,10 +578,11 @@ static void
 processFree(STG_NO_ARGS)
 {
     int nelem;
 processFree(STG_NO_ARGS)
 {
     int nelem;
-    W_ freeBuffer[PACK_BUFFER_SIZE];
+    static W_ *freeBuffer;
     int i;
     globalAddr ga;
 
     int i;
     globalAddr ga;
 
+    freeBuffer = gumPackBuffer;
     unpackFree(&nelem, freeBuffer);
 #ifdef FREE_DEBUG
     fprintf(stderr, "Rcvd Free (%d GAs)\n", nelem / 2);
     unpackFree(&nelem, freeBuffer);
 #ifdef FREE_DEBUG
     fprintf(stderr, "Rcvd Free (%d GAs)\n", nelem / 2);
@@ -614,16 +609,17 @@ which contains any newly allocated GAs.
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-processResume(sender)
-GLOBAL_TASK_ID sender;
+processResume(GLOBAL_TASK_ID sender)
 {
     int nelem;
 {
     int nelem;
-    W_ packBuffer[PACK_BUFFER_SIZE], nGAs;
+    W_ nGAs;
+    static W_ *packBuffer;
     P_ newGraph;
     P_ old;
     globalAddr lga;
     globalAddr *gagamap;
 
     P_ newGraph;
     P_ old;
     globalAddr lga;
     globalAddr *gagamap;
 
+    packBuffer = gumPackBuffer;
     unpackResume(&lga, &nelem, packBuffer);
 
 #ifdef RESUME_DEBUG
     unpackResume(&lga, &nelem, packBuffer);
 
 #ifdef RESUME_DEBUG
@@ -634,8 +630,8 @@ GLOBAL_TASK_ID sender;
 
     /* 
      * We always unpack the incoming graph, even if we've received the
 
     /* 
      * We always unpack the incoming graph, even if we've received the
-     * requested node in some other data packet (and already awakened the
-     * blocking queue).
+     * requested node in some other data packet (and already awakened
+     * the blocking queue).
      */
     if (SAVE_Hp + packBuffer[0] >= SAVE_HpLim) {
        ReallyPerformThreadGC(packBuffer[0], rtsFalse);
      */
     if (SAVE_Hp + packBuffer[0] >= SAVE_HpLim) {
        ReallyPerformThreadGC(packBuffer[0], rtsFalse);
@@ -649,7 +645,7 @@ GLOBAL_TASK_ID sender;
 
     old = GALAlookup(&lga);
 
 
     old = GALAlookup(&lga);
 
-    if (do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
        P_ tso = NULL;
 
        if (INFO_TYPE(INFO_PTR(old)) == INFO_FMBQ_TYPE) {
        P_ tso = NULL;
 
        if (INFO_TYPE(INFO_PTR(old)) == INFO_FMBQ_TYPE) {
@@ -665,8 +661,8 @@ GLOBAL_TASK_ID sender;
     ASSERT(newGraph != NULL);
 
     /* 
     ASSERT(newGraph != NULL);
 
     /* 
-     * Sometimes, unpacking will common up the resumee with the incoming graph,
-     * but if it hasn't, we'd better do so now.
+     * Sometimes, unpacking will common up the resumee with the
+     * incoming graph, but if it hasn't, we'd better do so now.
      */
    
     if (INFO_TYPE(INFO_PTR(old)) == INFO_FMBQ_TYPE)
      */
    
     if (INFO_TYPE(INFO_PTR(old)) == INFO_FMBQ_TYPE)
@@ -687,16 +683,17 @@ which contains any newly allocated GAs.
 
 \begin{code}
 static void
 
 \begin{code}
 static void
-processSchedule(sender)
-GLOBAL_TASK_ID sender;
+processSchedule(GLOBAL_TASK_ID sender)
 {
     int nelem;
     int space_required;
     rtsBool success;
 {
     int nelem;
     int space_required;
     rtsBool success;
-    W_ packBuffer[PACK_BUFFER_SIZE], nGAs;
+    static W_ *packBuffer;
+    W_ nGAs;
     P_ newGraph;
     globalAddr *gagamap;
 
     P_ newGraph;
     globalAddr *gagamap;
 
+    packBuffer = gumPackBuffer;                /* HWL */
     unpackSchedule(&nelem, packBuffer);
 
 #ifdef SCHEDULE_DEBUG
     unpackSchedule(&nelem, packBuffer);
 
 #ifdef SCHEDULE_DEBUG
@@ -705,9 +702,9 @@ GLOBAL_TASK_ID sender;
 #endif
 
     /*
 #endif
 
     /*
-     * For now, the graph is a closure to be sparked as an advisory spark, but in
-     * future it may be a complete spark with required/advisory status, priority
-     * etc.
+     * For now, the graph is a closure to be sparked as an advisory
+     * spark, but in future it may be a complete spark with
+     * required/advisory status, priority etc.
      */
 
     space_required = packBuffer[0];
      */
 
     space_required = packBuffer[0];
@@ -752,8 +749,9 @@ processAck(STG_NO_ARGS)
 #endif
 
     /*
 #endif
 
     /*
-     * For each (oldGA, newGA) pair, set the GA of the corresponding thunk to the
-     * newGA, convert the thunk to a FetchMe, and return the weight from the oldGA.
+     * For each (oldGA, newGA) pair, set the GA of the corresponding
+     * thunk to the newGA, convert the thunk to a FetchMe, and return
+     * the weight from the oldGA.
      */
     for (gaga = gagamap; gaga < gagamap + nGAs * 2; gaga += 2) {
        P_ old = GALAlookup(gaga);
      */
     for (gaga = gagamap; gaga < gagamap + nGAs * 2; gaga += 2) {
        P_ old = GALAlookup(gaga);
@@ -766,14 +764,15 @@ processAck(STG_NO_ARGS)
            convertToFetchMe(old, ga);
        } else {
            /* 
            convertToFetchMe(old, ga);
        } else {
            /* 
-             * Oops...we've got this one already; update the RBH to point to
-             * the object we already know about, whatever it happens to be.
+             * Oops...we've got this one already; update the RBH to
+             * point to the object we already know about, whatever it
+             * happens to be.
              */
            CommonUp(old, new);
 
            /* 
              */
            CommonUp(old, new);
 
            /* 
-             * Increase the weight of the object by the amount just received 
-             * in the second part of the ACK pair.
+             * Increase the weight of the object by the amount just
+             * received in the second part of the ACK pair.
              */
            (void) addWeight(gaga + 1);
        }
              */
            (void) addWeight(gaga + 1);
        }
@@ -805,7 +804,7 @@ processMessages(STG_NO_ARGS)
     CCC = (CostCentre)STATIC_CC_REF(CC_MSG);
     
     do {
     CCC = (CostCentre)STATIC_CC_REF(CC_MSG);
     
     do {
-        if (cc_profiling) {
+        if (RTSflags.CcFlags.doCostCentres) {
            CCC = (CostCentre)STATIC_CC_REF(CC_IDLE);
            CCC->scc_count++;
 
            CCC = (CostCentre)STATIC_CC_REF(CC_IDLE);
            CCC->scc_count++;
 
@@ -956,9 +955,10 @@ PACKET packet;
        }
        break;
 
        }
        break;
 
-      /* Anything we're not prepared to deal with.  Note that ALL opcodes are discarded
-        during termination -- this helps prevent bizarre race conditions.
-      */
+      /* Anything we're not prepared to deal with.  Note that ALL
+       * opcodes are discarded during termination -- this helps
+       * prevent bizarre race conditions.
+       */
       default:
        if (!GlobalStopPending) 
          {
       default:
        if (!GlobalStopPending) 
          {
@@ -1087,19 +1087,14 @@ prepareFreeMsgBuffers(STG_NO_ARGS)
     /* Allocate the freeMsg buffers just once and then hang onto them. */
 
     if (freeMsgIndex == NULL) {
     /* Allocate the freeMsg buffers just once and then hang onto them. */
 
     if (freeMsgIndex == NULL) {
-       freeMsgIndex = (int *) malloc(nPEs * sizeof(int));
-       freeMsgBuffer = (PP_) malloc(nPEs * sizeof(long *));
-       if (freeMsgIndex == NULL || freeMsgBuffer == NULL) {
-           fflush(stdout);
-           fprintf(stderr, "VM exhausted\n");
-           EXIT(EXIT_FAILURE);
-       }
+
+       freeMsgIndex = (int *) stgMallocBytes(nPEs * sizeof(int), "prepareFreeMsgBuffers (Index)");
+       freeMsgBuffer = (PP_)  stgMallocBytes(nPEs * sizeof(long *), "prepareFreeMsgBuffers (Buffer)");
+
        for(i = 0; i < nPEs; i++) {
        for(i = 0; i < nPEs; i++) {
-           if(i != thisPE &&
-             (freeMsgBuffer[i] = (P_) malloc(PACK_BUFFER_SIZE * sizeof(W_))) == NULL) {
-               fflush(stdout);
-               fprintf(stderr, "VM exhausted\n");
-               EXIT(EXIT_FAILURE);
+           if (i != thisPE) {
+             freeMsgBuffer[i] = (P_) stgMallocWords(RTSflags.ParFlags.packBufferSize,
+                                       "prepareFreeMsgBuffers (Buffer #i)");
            }
        }
     }
            }
        }
     }
@@ -1118,7 +1113,7 @@ globalAddr *ga;
 
     ASSERT(GALAlookup(ga) == NULL);
 
 
     ASSERT(GALAlookup(ga) == NULL);
 
-    if ((i = freeMsgIndex[pe]) + 2 >= PACK_BUFFER_SIZE) {
+    if ((i = freeMsgIndex[pe]) + 2 >= RTSflags.ParFlags.packBufferSize) {
 #ifdef FREE_DEBUG
        fprintf(stderr, "Filled a free message buffer\n");      
 #endif
 #ifdef FREE_DEBUG
        fprintf(stderr, "Filled a free message buffer\n");      
 #endif
index d4319e1..71c53db 100644 (file)
@@ -56,9 +56,7 @@ next bucket to be split, re-hash using the larger table.
 \begin{code}
 
 static int
 \begin{code}
 
 static int
-hash(table, key)
-HashTable *table;
-StgWord key;
+hash(HashTable *table, W_ key)
 {
     int bucket;
 
 {
     int bucket;
 
@@ -82,15 +80,9 @@ Allocate a new segment of the dynamically growing hash table.
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-allocSegment(table, segment)
-HashTable *table;
-int segment;
+allocSegment(HashTable *table, int segment)
 {
 {
-    if ((table->dir[segment] = (HashList **) malloc(HSEGSIZE * sizeof(HashList *))) == NULL) {
-       fflush(stdout);
-       fprintf(stderr, "VM exhausted\n");
-       EXIT(EXIT_FAILURE);
-    }
+    table->dir[segment] = (HashList **) stgMallocBytes(HSEGSIZE * sizeof(HashList *), "allocSegment");
 }
 
 \end{code}
 }
 
 \end{code}
@@ -102,8 +94,7 @@ by @table->split@ is affected by the expansion.
 \begin{code}
 
 static void
 \begin{code}
 
 static void
-expand(table)
-HashTable *table;
+expand(HashTable *table)
 {
     int oldsegment;
     int oldindex;
 {
     int oldsegment;
     int oldindex;
@@ -201,22 +192,19 @@ allocHashList(STG_NO_ARGS)
 
     if ((hl = freeList) != NULL) {
        freeList = hl->next;
 
     if ((hl = freeList) != NULL) {
        freeList = hl->next;
-    } else if ((hl = (HashList *) malloc(HCHUNK * sizeof(HashList))) != NULL) {
+    } else {
+       hl = (HashList *) stgMallocBytes(HCHUNK * sizeof(HashList), "allocHashList");
+
        freeList = hl + 1;
        for (p = freeList; p < hl + HCHUNK - 1; p++)
            p->next = p + 1;
        p->next = NULL;
        freeList = hl + 1;
        for (p = freeList; p < hl + HCHUNK - 1; p++)
            p->next = p + 1;
        p->next = NULL;
-    } else {
-       fflush(stdout);
-       fprintf(stderr, "VM exhausted\n");
-       EXIT(EXIT_FAILURE);
     }
     return hl;
 }
 
 static void
     }
     return hl;
 }
 
 static void
-freeHashList(hl)
-HashList *hl;
+freeHashList(HashList *hl)
 {
     hl->next = freeList;
     freeList = hl;
 {
     hl->next = freeList;
     freeList = hl;
@@ -347,14 +335,13 @@ allocHashTable(STG_NO_ARGS)
     HashTable *table;
     HashList **hb;
 
     HashTable *table;
     HashList **hb;
 
-    if ((table = (HashTable *) malloc(sizeof(HashTable))) == NULL) {
-       fflush(stdout);
-       fprintf(stderr, "VM exhausted\n");
-       EXIT(EXIT_FAILURE);
-    }
+    table = (HashTable *) stgMallocBytes(sizeof(HashTable),"allocHashTable");
+
     allocSegment(table, 0);
     allocSegment(table, 0);
+
     for (hb = table->dir[0]; hb < table->dir[0] + HSEGSIZE; hb++)
        *hb = NULL;
     for (hb = table->dir[0]; hb < table->dir[0] + HSEGSIZE; hb++)
        *hb = NULL;
+
     table->split = 0;
     table->max = HSEGSIZE;
     table->mask1 = HSEGSIZE - 1;
     table->split = 0;
     table->max = HSEGSIZE;
     table->mask1 = HSEGSIZE - 1;
index 8839bde..d88f50d 100644 (file)
@@ -67,13 +67,13 @@ unsigned op;
        return ("Unknown PE Opcode");
 }
 
        return ("Unknown PE Opcode");
 }
 
-void NullException(STG_NO_ARGS)
+void
+NullException(STG_NO_ARGS)
 {
   fprintf(stderr,"Null_Exception: called");
 }
 {
   fprintf(stderr,"Null_Exception: called");
 }
-void (*ExceptionHandler)() = NullException;
-
 
 
+void (*ExceptionHandler)() = NullException;
 \end{code}
 
 @trace_SendOp@ handles the tracing of messages at the OS level.  If
 \end{code}
 
 @trace_SendOp@ handles the tracing of messages at the OS level.  If
@@ -87,10 +87,7 @@ last message sent was for a PE or an IMU.
 rtsBool PETrace = rtsFalse, IMUTrace = rtsFalse, SystemTrace = rtsFalse, ReplyTrace = rtsFalse;
 
 static void
 rtsBool PETrace = rtsFalse, IMUTrace = rtsFalse, SystemTrace = rtsFalse, ReplyTrace = rtsFalse;
 
 static void
-trace_SendOp(op, dest, data1, data2)
-OPCODE op;
-GLOBAL_TASK_ID dest;
-unsigned data1, data2;
+trace_SendOp(OPCODE op, GLOBAL_TASK_ID dest, unsigned int data1, unsigned int data2)
 {
     char *OpName;
 
 {
     char *OpName;
 
@@ -164,28 +161,14 @@ For example,
 \end{verbatim}
 
 \begin{code}
 \end{verbatim}
 
 \begin{code}
-
-#ifdef __STDC__
 void
 SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
 void
 SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
-#else
-void
-SendOpV(op, task, n, va_alist)
-OPCODE op;
-GLOBAL_TASK_ID task;
-int n;
-va_dcl
-#endif
 {
     va_list ap;
     int i;
     StgWord arg;
 
 {
     va_list ap;
     int i;
     StgWord arg;
 
-#ifdef __STDC__
     va_start(ap, n);
     va_start(ap, n);
-#else
-    va_start(ap);
-#endif
 
     trace_SendOp(op, task, 0, 0);
 
 
     trace_SendOp(op, task, 0, 0);
 
@@ -216,29 +199,14 @@ Important: The variable arguments must all be StgWords.
 
 \begin{code}
 
 
 \begin{code}
 
-#ifdef __STDC__
 void
 SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem, StgWord *datablock, int narg, ...)
 void
 SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem, StgWord *datablock, int narg, ...)
-#else
-void
-SendOpNV(op, task, nelem, datablock, narg, va_alist)
-OPCODE op;
-GLOBAL_TASK_ID task;
-int nelem;
-StgWord *datablock;
-int narg;
-va_dcl
-#endif
 {
     va_list ap;
     int i;
     StgWord arg;
 
 {
     va_list ap;
     int i;
     StgWord arg;
 
-#ifdef __STDC__
     va_start(ap, narg);
     va_start(ap, narg);
-#else
-    va_start(ap);
-#endif
 
     trace_SendOp(op, task, 0, 0);
 /*  fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
 
     trace_SendOp(op, task, 0, 0);
 /*  fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
@@ -368,28 +336,15 @@ synchronises with the other PEs. Finally it receives from Control the
 array of Global Task Ids.
 
 \begin{code}
 array of Global Task Ids.
 
 \begin{code}
-
-static char *
-xmalloc(n)
-unsigned n;
-{
-    char *p = malloc(n);
-
-    if (p == NULL) {
-       fprintf(stderr, "Memory allocation of %u bytes failed\n", n);
-       EXIT(EXIT_FAILURE);
-    }
-    return p;
-}
-
 GLOBAL_TASK_ID *
 PEStartUp(nPEs)
 unsigned nPEs;
 {
     int i;
     PACKET addr;
 GLOBAL_TASK_ID *
 PEStartUp(nPEs)
 unsigned nPEs;
 {
     int i;
     PACKET addr;
-    long *buffer = (long *) xmalloc(sizeof(long) * nPEs);
-    GLOBAL_TASK_ID *PEs = (GLOBAL_TASK_ID *) xmalloc(sizeof(GLOBAL_TASK_ID) * nPEs);
+    long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)");
+    GLOBAL_TASK_ID *PEs
+      = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)");
 
     mytid = _my_gtid;          /* Initialise PVM and get task id into global
                                 * variable */
 
     mytid = _my_gtid;          /* Initialise PVM and get task id into global
                                 * variable */
index f6f1dfc..4290c8a 100644 (file)
@@ -22,7 +22,8 @@ system (GUM).
 Static data and code declarations.
 
 \begin{code}
 Static data and code declarations.
 
 \begin{code}
-static W_      PackBuffer[PACK_BUFFER_SIZE+PACK_HDR_SIZE];
+static W_ *PackBuffer = NULL; /* size: can be set via option */
+
 static W_      packlocn, clqsize, clqpos;
 static W_      unpackedsize;
 static W_      reservedPAsize;                   /*Space reserved for primitive arrays*/
 static W_      packlocn, clqsize, clqpos;
 static W_      unpackedsize;
 static W_      reservedPAsize;                   /*Space reserved for primitive arrays*/
@@ -66,6 +67,8 @@ W_ *packbuffersize;
 {
     /* Ensure enough heap for all possible RBH_Save closures */
 
 {
     /* Ensure enough heap for all possible RBH_Save closures */
 
+    ASSERT(RTSflags.ParFlags.packBufferSize > 0);
+
     if (SAVE_Hp + PACK_HEAP_REQUIRED > SAVE_HpLim)
        return NULL;
 
     if (SAVE_Hp + PACK_HEAP_REQUIRED > SAVE_HpLim)
        return NULL;
 
@@ -80,7 +83,7 @@ W_ *packbuffersize;
     PackBuffer[0] = unpackedsize;
 
     /* Set the size parameter */
     PackBuffer[0] = unpackedsize;
 
     /* Set the size parameter */
-    ASSERT(packlocn <= PACK_BUFFER_SIZE);
+    ASSERT(packlocn <= RTSflags.ParFlags.packBufferSize);
     *packbuffersize = packlocn;
 
     DonePacking();
     *packbuffersize = packlocn;
 
     DonePacking();
@@ -146,8 +149,8 @@ P_ closure;
     W_ size, ptrs, nonptrs, vhs;
     int i, clpacklocn;
 
     W_ size, ptrs, nonptrs, vhs;
     int i, clpacklocn;
 
-    while ((P_) INFO_PTR(closure) == Ind_info) {       /* Don't pack indirection
-                                                        * closures */
+    while (IS_INDIRECTION(INFO_PTR(closure))) {
+       /* Don't pack indirection closures */
 #ifdef PACK_DEBUG
        fprintf(stderr, "Shorted an indirection at %x", closure);
 #endif
 #ifdef PACK_DEBUG
        fprintf(stderr, "Shorted an indirection at %x", closure);
 #endif
@@ -161,9 +164,10 @@ P_ closure;
        P_ info;
 
        /*
        P_ info;
 
        /*
-        * PLCs reside on all of the PEs already. Just pack the address as a GA (a
-        * bit of a kludge, since an address may not fit in *any* of the individual
-        * GA fields). Const, charlike and small intlike closures are converted into
+        * PLCs reside on all of the PEs already. Just pack the
+        * address as a GA (a bit of a kludge, since an address may
+        * not fit in *any* of the individual GA fields). Const,
+        * charlike and small intlike closures are converted into
         * PLCs.
         */
        switch (INFO_TYPE(INFO_PTR(closure))) {
         * PLCs.
         */
        switch (INFO_TYPE(INFO_PTR(closure))) {
@@ -320,10 +324,10 @@ data into the pack buffer and increments the pack location.
 \begin{code}
 static void
 Pack(data)
 \begin{code}
 static void
 Pack(data)
-W_ data;
+  W_ data;
 {
 {
-  ASSERT(packlocn < PACK_BUFFER_SIZE);
-  PackBuffer[packlocn++] = data;
+    ASSERT(packlocn < RTSflags.ParFlags.packBufferSize);
+    PackBuffer[packlocn++] = data;
 }
 \end{code}
 
 }
 \end{code}
 
@@ -400,9 +404,24 @@ static HashTable *offsettable;
 @InitPacking@ initialises the packing buffer etc.
 
 \begin{code}
 @InitPacking@ initialises the packing buffer etc.
 
 \begin{code}
+void
+InitPackBuffer(STG_NO_ARGS)
+{
+  if (PackBuffer == NULL) { /* not yet allocated */
+
+      PackBuffer = (W_ *) stgMallocWords(RTSflags.ParFlags.packBufferSize+PACK_HDR_SIZE,
+                                        "InitPackBuffer");
+
+      InitPendingGABuffer(RTSflags.ParFlags.packBufferSize);
+      AllocClosureQueue(RTSflags.ParFlags.packBufferSize);
+  }
+}
+
 static void
 InitPacking(STG_NO_ARGS)
 {
 static void
 InitPacking(STG_NO_ARGS)
 {
+  /* InitPackBuffer();    now done in ParInit  HWL_ */
+
   packlocn = PACK_HDR_SIZE;
   unpackedsize = 0;
   reservedPAsize = 0;
   packlocn = PACK_HDR_SIZE;
   unpackedsize = 0;
   reservedPAsize = 0;
@@ -445,8 +464,7 @@ packed.
 
 \begin{code}
 static int
 
 \begin{code}
 static int
-OffsetFor(closure)
-P_ closure;
+OffsetFor(P_ closure)
 {
     return (int) (W_) lookupHashTable(offsettable, (W_) closure);
 }
 {
     return (int) (W_) lookupHashTable(offsettable, (W_) closure);
 }
@@ -480,7 +498,7 @@ W_ size, ptrs;
 {
     if (RoomInBuffer &&
       (packlocn + reservedPAsize + size +
 {
     if (RoomInBuffer &&
       (packlocn + reservedPAsize + size +
-       ((clqsize - clqpos) + ptrs) * PACK_FETCHME_SIZE >= PACK_BUFFER_SIZE)) {
+       ((clqsize - clqpos) + ptrs) * PACK_FETCHME_SIZE >= RTSflags.ParFlags.packBufferSize)) {
 #ifdef PACK_DEBUG
        fprintf(stderr, "Buffer full\n");
 #endif
 #ifdef PACK_DEBUG
        fprintf(stderr, "Buffer full\n");
 #endif
@@ -500,16 +518,29 @@ These routines manage the closure queue.
 
 \begin{code}
 static W_ clqpos, clqsize;
 
 \begin{code}
 static W_ clqpos, clqsize;
-static P_ ClosureQueue[PACK_BUFFER_SIZE];
+
+static P_ *ClosureQueue = NULL;   /* HWL: init in main */
 \end{code}
 
 @InitClosureQueue@ initialises the closure queue.
 
 \begin{code}
 void
 \end{code}
 
 @InitClosureQueue@ initialises the closure queue.
 
 \begin{code}
 void
+AllocClosureQueue(size)
+  W_ size;
+{
+  ASSERT(ClosureQueue == NULL);
+  ClosureQueue = (P_ *) stgMallocWords(size, "AllocClosureQueue");
+}
+
+void
 InitClosureQueue(STG_NO_ARGS)
 {
   clqpos = clqsize = 0;
 InitClosureQueue(STG_NO_ARGS)
 {
   clqpos = clqsize = 0;
+
+  if ( ClosureQueue == NULL ) {
+     AllocClosureQueue(RTSflags.ParFlags.packBufferSize);
+  }
 }
 \end{code}
 
 }
 \end{code}
 
@@ -531,7 +562,7 @@ void
 QueueClosure(closure)
 P_ closure;
 {
 QueueClosure(closure)
 P_ closure;
 {
-  if(clqsize < PACK_BUFFER_SIZE)
+  if(clqsize < RTSflags.ParFlags.packBufferSize)
     ClosureQueue[clqsize++] = closure;
   else
     {
     ClosureQueue[clqsize++] = closure;
   else
     {
index d1e29c0..780c676 100644 (file)
@@ -49,13 +49,11 @@ Flag handling.
 
 \begin{code}
 rtsBool TraceSparks =    rtsFalse;             /* Enable the spark trace mode                  */
 
 \begin{code}
 rtsBool TraceSparks =    rtsFalse;             /* Enable the spark trace mode                  */
-rtsBool OutputDisabled = rtsFalse;             /* Disable output for performance purposes      */
 rtsBool SparkLocally =   rtsFalse;             /* Use local threads if possible                */
 rtsBool DelaySparks =    rtsFalse;             /* Use delayed sparking                         */
 rtsBool LocalSparkStrategy =   rtsFalse;       /* Either delayed threads or local threads      */
 rtsBool GlobalSparkStrategy =   rtsFalse;      /* Export all threads                           */
 
 rtsBool SparkLocally =   rtsFalse;             /* Use local threads if possible                */
 rtsBool DelaySparks =    rtsFalse;             /* Use delayed sparking                         */
 rtsBool LocalSparkStrategy =   rtsFalse;       /* Either delayed threads or local threads      */
 rtsBool GlobalSparkStrategy =   rtsFalse;      /* Export all threads                           */
 
-rtsBool ParallelStats =         rtsFalse;              /* Gather parallel statistics                   */
 rtsBool DeferGlobalUpdates =    rtsFalse;      /* Defer updating of global nodes               */
 rtsBool fishing = rtsFalse;                     /* We have no fish out in the stream            */
 \end{code}
 rtsBool DeferGlobalUpdates =    rtsFalse;      /* Defer updating of global nodes               */
 rtsBool fishing = rtsFalse;                     /* We have no fish out in the stream            */
 \end{code}
@@ -71,10 +69,9 @@ StgPtr program_closure;
        return;
 
     /* Show that we've started */
        return;
 
     /* Show that we've started */
-    if (IAmMainThread && !OutputDisabled)
+    if (IAmMainThread && ! RTSflags.ParFlags.outputDisabled)
        fprintf(stderr, "Starting main program...\n");
 
        fprintf(stderr, "Starting main program...\n");
 
-
     /* Record the start time for statistics purposes. */
     main_start_time = usertime();
     /* fprintf(stderr, "Start time is %u\n", main_start_time); */
     /* Record the start time for statistics purposes. */
     main_start_time = usertime();
     /* fprintf(stderr, "Start time is %u\n", main_start_time); */
@@ -108,7 +105,7 @@ I_ n;
     else
       WaitForPEOp(PP_FINISH, SysManTask);
     PEShutDown();
     else
       WaitForPEOp(PP_FINISH, SysManTask);
     PEShutDown();
-    fprintf(stderr,"Processor %lx shutting down, %ld Threads run\n", mytid, threadId);
+    fprintf(stderr,"PE %lx shutting down, %ld Threads run, %ld Sparks Ignored\n", (W_) mytid, threadId, sparksIgnored);
 
     /* And actually terminate -- always with code 0 */
     longjmp(exit_parallel_system, 1);
 
     /* And actually terminate -- always with code 0 */
     longjmp(exit_parallel_system, 1);
@@ -122,17 +119,18 @@ time_t time PROTO((time_t *));
 void
 initParallelSystem(STG_NO_ARGS)
 {
 void
 initParallelSystem(STG_NO_ARGS)
 {
-
-  /* Don't buffer standard channels... */
-  setbuf(stdout,NULL);
-  setbuf(stderr,NULL);
-
-  srand48(time(NULL) * getpid());      /*Initialise Random-number generator seed*/
-
-  OkToGC = rtsFalse;           /* Must not GC till we have set up the environment */
-                               /* because C is hanging onto heap pointers */
-                               /* maybe bogus for the new RTS? -- KH */
-                               /* And for the GUM system? PWT */
+    /* Don't buffer standard channels... */
+    setbuf(stdout,NULL);
+    setbuf(stderr,NULL);
+
+    srand48(time(NULL) * getpid());    /*Initialise Random-number generator seed*/
+
+    OkToGC = rtsFalse; /* Must not GC till we have set up the environment */
+                       /* because C is hanging onto heap pointers */
+                       /* maybe bogus for the new RTS? -- KH */
+                       /* And for the GUM system? PWT */
+    InitPackBuffer();
+    InitMoreBuffers();
 }
 \end{code}
 
 }
 \end{code}
 
index 5661671..956dd50 100644 (file)
@@ -13,7 +13,7 @@
 #include "rtsdefs.h"
 \end{code}
 
 #include "rtsdefs.h"
 \end{code}
 
-Turn a closure into a revertable black hole.  After the conversion,
+Turn a closure into a revertible black hole.  After the conversion,
 the first two words of the closure will be a link to the mutables
 list (if appropriate for the garbage collector), and a pointer
 to the blocking queue.  The blocking queue is terminated by a 2-word
 the first two words of the closure will be a link to the mutables
 list (if appropriate for the garbage collector), and a pointer
 to the blocking queue.  The blocking queue is terminated by a 2-word
index 830f19d..e18aaad 100644 (file)
@@ -52,9 +52,7 @@ HandleException(STG_NO_ARGS)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-main(argc, argv)
-int argc;
-char **argv;
+main(int argc, char **argv)
 {
     int rbufid;
     int opcode, nbytes;
 {
     int rbufid;
     int opcode, nbytes;
@@ -113,7 +111,22 @@ char **argv;
 #endif
 
        }
 #endif
 
        }
-       /* Join the PE  sysman groups in order to allow barrier synchronisation */
+       /*
+          SysMan joins PECTLGROUP, so that it can wait (at the
+          barrier sysnchronisation a few instructions later) for the
+          other PE-tasks to start.
+          
+          Other comments on PVM groupery:
+          
+          The manager group (MGRGROUP) is vestigial at the moment. It
+          may eventually include a statistics manager, garbage
+          collector manager.
+
+          I suspect that you're [Kei Davis] right: Sysman shouldn't
+          be in PEGROUP, it's a hangover from GRIP.
+          
+          (Phil Trinder, 95/10)
+       */
        checkerr(pvm_joingroup(PECTLGROUP));
 #if 0
        fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
        checkerr(pvm_joingroup(PECTLGROUP));
 #if 0
        fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
@@ -232,6 +245,7 @@ char **argv;
            }
        }
     }
            }
        }
     }
+    return(0);
 }
 \end{code}
 
 }
 \end{code}
 
index 96a7d62..52b4cad 100644 (file)
@@ -23,7 +23,15 @@ EXTDATA_RO(FetchMe_info);
 Local Definitions.
 
 \begin{code}
 Local Definitions.
 
 \begin{code}
-static globalAddr PendingGABuffer[(PACK_BUFFER_SIZE-PACK_HDR_SIZE)*2];
+static globalAddr *PendingGABuffer;  /* HWL; init in main; */
+
+void
+InitPendingGABuffer(size)
+W_ size; 
+{
+  PendingGABuffer
+    = (globalAddr *) stgMallocBytes((size-PACK_HDR_SIZE)*2*sizeof(globalAddr), "InitPendingGABuffer");
+}
 \end{code}
 
 @CommonUp@ commons up two closures which we have discovered to be
 \end{code}
 
 @CommonUp@ commons up two closures which we have discovered to be
@@ -31,9 +39,7 @@ variants of the same object.  One is made an indirection to the other.
 
 \begin{code}
 void
 
 \begin{code}
 void
-CommonUp(src, dst)
-P_ src;
-P_ dst;
+CommonUp(P_ src, P_ dst)
 {
     P_ bqe;
 
 {
     P_ bqe;
 
@@ -95,8 +101,11 @@ W_ *nGAs;
     W_ pptr = 0, pptrs = 0, pvhs;
 
     int i;
     W_ pptr = 0, pptrs = 0, pvhs;
 
     int i;
+    globalAddr *gaga;
+
+    InitPackBuffer(); /* in case it isn't already init'd */
 
 
-    globalAddr *gaga = PendingGABuffer;
+    gaga = PendingGABuffer;
 
     InitClosureQueue();
 
 
     InitClosureQueue();
 
@@ -169,7 +178,7 @@ W_ *nGAs;
            graph[FIXED_HS + i + vhs + ptrs] = *bufptr++;
                 
          /* Indirections are never packed */
            graph[FIXED_HS + i + vhs + ptrs] = *bufptr++;
                 
          /* Indirections are never packed */
-         ASSERT(INFO_PTR(graph) != (W_) Ind_info);
+         ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);
 
          /* Add to queue for processing */
          QueueClosure(graph);
 
          /* Add to queue for processing */
          QueueClosure(graph);
index 22d2b4a..a1c6110 100644 (file)
@@ -2,10 +2,11 @@
 #include "rtsdefs.h"
 
 void
 #include "rtsdefs.h"
 
 void
-OutOfHeapHook (request_size, heap_size)
+OutOfHeapHook (request_size)
   W_ request_size; /* in bytes */
   W_ request_size; /* in bytes */
-  W_ heap_size;    /* in bytes */
 {
 {
+    W_ heap_size = RTSflags.GcFlags.heapSize * sizeof(W_); /* i.e., in bytes */
+
     fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n",
        request_size,
        heap_size);
     fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n",
        request_size,
        heap_size);
index 9a33cec..6034532 100644 (file)
@@ -2,9 +2,10 @@
 #include "rtsdefs.h"
 
 void
 #include "rtsdefs.h"
 
 void
-MallocFailHook (request_size)
+MallocFailHook (request_size, msg)
   I_ request_size;    /* in bytes */
   I_ request_size;    /* in bytes */
+  char *msg;
 {
 {
-    fprintf(stderr, "malloc: failed on request for %lu bytes\n", request_size);
+    fprintf(stderr, "malloc: failed on request for %lu bytes; message: %s\n", request_size, msg);
 }
 \end{code}
 }
 \end{code}
index 43059c1..acf0d2e 100644 (file)
@@ -1,8 +1,15 @@
 \begin{code}
 #include "rtsdefs.h"
 \begin{code}
 #include "rtsdefs.h"
-#include "storage/SMinternal.h" /* DEFAULT_* here */
 
 
-I_   SM_word_heap_size   = DEFAULT_HEAP_SIZE;
-StgFloat SM_pc_free_heap = DEFAULT_PC_FREE;
-I_   SM_word_stk_size    = DEFAULT_STACKS_SIZE;
+void
+defaultsHook (void)
+{ /* this is called *after* RTSflags has had
+     its defaults set, but *before* we start
+     processing the RTS command-line options.
+
+     This default version does *nothing*.
+     The user may provide a more interesting
+     one.
+  */
+}
 \end{code}
 \end{code}
index 2e26595..7ee20c1 100644 (file)
@@ -21,13 +21,15 @@ should continue to work properly.
 int dirtyEnv = 0;
 
 /* 
 int dirtyEnv = 0;
 
 /* 
- * For some reason, OSF turns off the prototype for this if we're _POSIX_SOURCE.
- * Seems to me that this ought to be an ANSI-ism rather than a POSIX-ism,
- * but no matter.
+ * For some reason, OSF turns off the prototype for this if we're
+ * _POSIX_SOURCE.  Seems to me that this ought to be an ANSI-ism
+ * rather than a POSIX-ism, but no matter.  (JSM(?))
  */
 
 char *
  */
 
 char *
-strdup(const char *src)
+strdup(char *src) /* should be "const char *" but then some
+                    bozo OS (e.g., AIX) will come along and disagree.
+                    The alt is to rename this routine (WDP 96/01) */
 {
     int len = strlen(src) + 1;
     char *dst;
 {
     int len = strlen(src) + 1;
     char *dst;
index 9c82307..0a5d1a5 100644 (file)
  * seconds to overflow 31 bits.
  */
 
  * seconds to overflow 31 bits.
  */
 
-StgAddr
-getCPUTime(STG_NO_ARGS)
+StgByteArray
+getCPUTime(cpuStruct)
+StgByteArray cpuStruct;
 {
 {
-    static StgInt cpu[4];
+    StgInt *cpu=(StgInt *)cpuStruct;
 
 #if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS
     struct rusage t;
 
 #if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS
     struct rusage t;
@@ -84,7 +85,7 @@ getCPUTime(STG_NO_ARGS)
     return NULL;
 # endif
 #endif
     return NULL;
 # endif
 #endif
-    return (StgAddr) cpu;
+    return (StgByteArray) cpuStruct;
 }
 
 \end{code}
 }
 
 \end{code}
index da54d7d..025aae9 100644 (file)
@@ -27,9 +27,7 @@
 /* For cleanup of partial answer on error */
 
 static void
 /* For cleanup of partial answer on error */
 
 static void
-freeEntries(entries, count)
-  char **entries;
-  int count;
+freeEntries(char **entries, int count)
 {
     int i;
 
 {
     int i;
 
index 1d2133b..ee8022b 100644 (file)
@@ -7,6 +7,8 @@
 
 \begin{code}
 #include "rtsdefs.h"
 
 \begin{code}
 #include "rtsdefs.h"
+
+#include "ghcReadline.h" /* to make sure the code here agrees...*/
 \end{code}
 
 Wrapper around the callback mechanism to allow Haskell side functions
 \end{code}
 
 Wrapper around the callback mechanism to allow Haskell side functions
@@ -18,8 +20,7 @@ function. Before exiting, the Haskell function will deposit its result
 in the global variable $rl_return$.
 
 \begin{code}
 in the global variable $rl_return$.
 
 \begin{code}
-
-int current_narg, rl_return, current_kc;
+I_ current_narg, rl_return, current_kc;
 
 char* rl_prompt_hack;
 
 
 char* rl_prompt_hack;
 
@@ -27,7 +28,8 @@ StgStablePtr haskellRlEntry;
 StgStablePtr cbackList;
 
 
 StgStablePtr cbackList;
 
 
-int genericRlCback (int narg,int kc)
+I_
+genericRlCback (I_ narg, I_ kc)
 {
   current_narg = narg;
   current_kc = kc;
 {
   current_narg = narg;
   current_kc = kc;
index 79f6689..124dabd 100644 (file)
 #endif
 
 StgAddr
 #endif
 
 StgAddr
-showTime(size, d)
+showTime(size, d, buf)
 StgInt size;
 StgByteArray d;
 StgInt size;
 StgByteArray d;
+StgByteArray buf;
 {
     time_t t;
     struct tm *tm;
 {
     time_t t;
     struct tm *tm;
-    static char buf[32];
 
     switch(size) {
        default:
 
     switch(size) {
        default:
-           return (StgAddr) "ClockTime.show{LibTime}: out of range";
+            return (StgAddr)strcpy(buf, "ClockTime.show{LibTime}: out of range");
        case 0:
            t = 0;
            break;
        case -1:
            t = - (time_t) ((StgInt *)d)[0];
            if (t > 0) 
        case 0:
            t = 0;
            break;
        case -1:
            t = - (time_t) ((StgInt *)d)[0];
            if (t > 0) 
-               return (StgAddr) "ClockTime.show{LibTime}: out of range";
+                return
+ (StgAddr)strcpy(buf, "ClockTime.show{LibTime}: out of range");
            break;
        case 1:
            t = (time_t) ((StgInt *)d)[0];
            if (t < 0) 
            break;
        case 1:
            t = (time_t) ((StgInt *)d)[0];
            if (t < 0) 
-               return (StgAddr) "ClockTime.show{LibTime}: out of range";
+               return (StgAddr) strcpy(buf, "ClockTime.show{LibTime}: out of range");
            break;
        }
     tm = localtime(&t);
            break;
        }
     tm = localtime(&t);
-    if (tm != NULL && strftime(buf, sizeof(buf), "%a %b %d %T %Z %Y", tm) > 0)
-           return (StgAddr) buf;
-    return (StgAddr) "ClockTime.show{LibTime}: internal error";
+    if (tm != NULL && strftime(buf, 32 /*Magic number*/, "%a %b %d %T %Z %Y", tm) > 0)
+       return (StgAddr)buf;
+    return (StgAddr)strcpy(buf, "ClockTime.show{LibTime}: internal error");
 }
 
 \end{code}
 }
 
 \end{code}
index d00da86..6ff4247 100644 (file)
@@ -10,7 +10,7 @@
 #include "timezone.h"
 
 StgAddr 
 #include "timezone.h"
 
 StgAddr 
-toClockSec(year, mon, mday, hour, min, sec, tz)
+toClockSec(year, mon, mday, hour, min, sec, tz, res)
 StgInt year;
 StgInt mon;
 StgInt mday;
 StgInt year;
 StgInt mon;
 StgInt mday;
@@ -18,9 +18,10 @@ StgInt hour;
 StgInt min;
 StgInt sec;
 StgInt tz;
 StgInt min;
 StgInt sec;
 StgInt tz;
+StgByteArray res;
 {
     struct tm tm;
 {
     struct tm tm;
-    static time_t t;
+    time_t t;
 
     tm.tm_year = year - 1900;
     tm.tm_mon = mon;
 
     tm.tm_year = year - 1900;
     tm.tm_mon = mon;
@@ -41,8 +42,9 @@ StgInt tz;
 #endif
     if (t == (time_t) -1)
        return NULL;
 #endif
     if (t == (time_t) -1)
        return NULL;
-    else
-       return &t;
+
+    *(time_t *)res = t;
+    return res;
 }
 
 \end{code}
 }
 
 \end{code}
index 50a5a10..b930ae1 100644 (file)
@@ -9,14 +9,14 @@
 #include "stgio.h"
 #include "timezone.h"
 
 #include "stgio.h"
 #include "timezone.h"
 
-StgAddr 
-toLocalTime(size, d)
+StgAddr
+toLocalTime(size, d, res)
 StgInt size;
 StgByteArray d;
 StgInt size;
 StgByteArray d;
+StgByteArray res;
 {
 {
+    struct tm *tm,*tmp=(struct tm *)res;
     time_t t;
     time_t t;
-    struct tm *tm;
-    static struct tm cache_tm;
 
     switch(size) {
        default:
 
     switch(size) {
        default:
@@ -40,8 +40,32 @@ StgByteArray d;
     if (tm == NULL)
        return NULL;
 
     if (tm == NULL)
        return NULL;
 
-    cache_tm = *tm;
-    return &cache_tm;
+    /*
+      localtime() may return a ptr to statically allocated storage,
+      so to make toLocalTime reentrant, we manually copy
+      the structure into the (struct tm *) passed in.
+    */
+    tmp->tm_sec    = tm->tm_sec;
+    tmp->tm_min    = tm->tm_min;
+    tmp->tm_hour   = tm->tm_hour;
+    tmp->tm_mday   = tm->tm_mday;
+    tmp->tm_mon    = tm->tm_mon;
+    tmp->tm_year   = tm->tm_year;
+    tmp->tm_wday   = tm->tm_wday;
+    tmp->tm_yday   = tm->tm_yday;
+    tmp->tm_isdst  = tm->tm_isdst;
+    /*
+      If you don't have tm_zone in (struct tm), but
+      you get at it via the shared tmzone[], you'll
+      lose. Same goes for the tm_gmtoff field.
+    
+    */
+#if HAVE_TM_ZONE
+    strcpy(tmp->tm_zone,tm->tm_zone);
+    tmp->tm_gmtoff = tm->tm_gmtoff;
+#endif
+
+    return (StgAddr)res;
 }
 
 \end{code}
 }
 
 \end{code}
index 1442993..e755559 100644 (file)
 #include "timezone.h"
 
 StgAddr 
 #include "timezone.h"
 
 StgAddr 
-toUTCTime(size, d)
+toUTCTime(size, d, res)
 StgInt size;
 StgByteArray d;
 StgInt size;
 StgByteArray d;
+StgByteArray res;
 {
     time_t t;
 {
     time_t t;
-    struct tm *tm;
-    static struct tm cache_tm;
+    struct tm *tm,*tmp=(struct tm *)res;
 
     switch(size) {
        default:
 
     switch(size) {
        default:
@@ -40,8 +40,32 @@ StgByteArray d;
     if (tm == NULL)
        return NULL;
 
     if (tm == NULL)
        return NULL;
 
-    cache_tm = *tm;
-    return &cache_tm;
+    /*
+      gmtime() may return a ptr to statically allocated storage,
+      so to make toUTCTime reentrant, we manually copy
+      the structure into the (struct tm *) passed in.
+    */
+    tmp->tm_sec    = tm->tm_sec;
+    tmp->tm_min    = tm->tm_min;
+    tmp->tm_hour   = tm->tm_hour;
+    tmp->tm_mday   = tm->tm_mday;
+    tmp->tm_mon    = tm->tm_mon;
+    tmp->tm_year   = tm->tm_year;
+    tmp->tm_wday   = tm->tm_wday;
+    tmp->tm_yday   = tm->tm_yday;
+    tmp->tm_isdst  = tm->tm_isdst;
+    /*
+      If you don't have tm_zone in (struct tm), but
+      you get at it via the shared tmzone[], you'll
+      lose. Same goes for the tm_gmtoff field.
+    
+    */
+#if HAVE_TM_ZONE
+    strcpy(tmp->tm_zone,tm->tm_zone);
+    tmp->tm_gmtoff = tm->tm_gmtoff;
+#endif
+
+    return (StgAddr)res;
 }
 
 \end{code}
 }
 
 \end{code}
index eb7d303..f4650c4 100644 (file)
@@ -120,7 +120,7 @@ newevent(proc,creator,time,evttype,tso,node,spark)
   P_ tso, node;
   sparkq spark;
 {
   P_ tso, node;
   sparkq spark;
 {
-  eventq newentry = (eventq) xmalloc(sizeof(struct event));
+  eventq newentry = (eventq) stgMallocBytes(sizeof(struct event), "newevent");
 
   EVENT_PROC(newentry) = proc;
   EVENT_CREATOR(newentry) = creator;
 
   EVENT_PROC(newentry) = proc;
   EVENT_CREATOR(newentry) = creator;
@@ -225,9 +225,9 @@ W_ id;
 
 void
 DumpGranEventAndNode(name, tso, node, proc)
 
 void
 DumpGranEventAndNode(name, tso, node, proc)
-enum gran_event_types name;
-P_ tso, node;
-PROC proc;
+  enum gran_event_types name;
+  P_ tso, node;
+  PROC proc;
 {
     PROC pe = CURRENT_PROC;
     W_ id;
 {
     PROC pe = CURRENT_PROC;
     W_ id;
@@ -243,7 +243,7 @@ PROC proc;
     if (name > GR_EVENT_MAX)
        name = GR_EVENT_MAX;
 
     if (name > GR_EVENT_MAX)
        name = GR_EVENT_MAX;
 
-    if (do_gr_binary) {
+    if (RTSflags.ParFlags.granSimStats_Binary) {
        grputw(name);
        grputw(pe);
        abort(); /* die please: a single word doesn't represent long long times */
        grputw(name);
        grputw(pe);
        abort(); /* die please: a single word doesn't represent long long times */
@@ -267,7 +267,7 @@ W_ id;
 
     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 
 
     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 
-    if (do_gr_binary) {
+    if (RTSflags.ParFlags.granSimStats_Binary) {
        grputw(name);
        grputw(pe);
        abort(); /* die please: a single word doesn't represent long long times */
        grputw(name);
        grputw(pe);
        abort(); /* die please: a single word doesn't represent long long times */
@@ -287,7 +287,7 @@ rtsBool mandatory_thread;
     char time_string[500]; /* ToDo: kill magic constant */
     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 
     char time_string[500]; /* ToDo: kill magic constant */
     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 
-    if (do_gr_binary) {
+    if (RTSflags.ParFlags.granSimStats_Binary) {
        grputw(GR_END);
        grputw(pe);
        abort(); /* die please: a single word doesn't represent long long times */
        grputw(GR_END);
        grputw(pe);
        abort(); /* die please: a single word doesn't represent long long times */
@@ -444,7 +444,7 @@ int prog_argc, rts_argc;
     I_ i;
 
     if (do_gr_sim) {
     I_ i;
 
     if (do_gr_sim) {
-       char *extension = do_gr_binary ? "gb" : "gr";
+       char *extension = RTSflags.ParFlags.granSimStats_Binary ? "gb" : "gr";
 
        sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0], extension);
 
 
        sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0], extension);
 
@@ -516,7 +516,7 @@ int prog_argc, rts_argc;
          gran_load_cost, gran_store_cost, gran_float_cost, gran_heapalloc_cost);
        fputs("\n\n++++++++++++++++++++\n\n", gr_file);
     }
          gran_load_cost, gran_store_cost, gran_float_cost, gran_heapalloc_cost);
        fputs("\n\n++++++++++++++++++++\n\n", gr_file);
     }
-    if (do_gr_binary)
+    if (RTSflags.ParFlags.granSimStats_Binary)
        grputw(sizeof(TIME));
 
     Idlers = max_proc;
        grputw(sizeof(TIME));
 
     Idlers = max_proc;
@@ -538,18 +538,16 @@ end_gr_simulation(STG_NO_ARGS)
 #ifdef PAR
 char gr_filename[STATS_FILENAME_MAXLEN];
 
 #ifdef PAR
 char gr_filename[STATS_FILENAME_MAXLEN];
 
-I_ do_gr_profile = 0;
 I_ do_sp_profile = 0;
 I_ do_sp_profile = 0;
-I_ do_gr_binary = 0;
 
 void
 init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv)
 
 void
 init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv)
-char *prog_argv[], *rts_argv[];
-int prog_argc, rts_argc;
+  char *prog_argv[], *rts_argv[];
+  int prog_argc, rts_argc;
 {
     int i;
 
 {
     int i;
 
-    char *extension = do_gr_binary ? "gb" : "gr";
+    char *extension = RTSflags.ParFlags.granSimStats_Binary ? "gb" : "gr";
 
     sprintf(gr_filename, GR_FILENAME_FMT_GUM, prog_argv[0], thisPE, extension);
 
 
     sprintf(gr_filename, GR_FILENAME_FMT_GUM, prog_argv[0], thisPE, extension);
 
@@ -584,7 +582,7 @@ int prog_argc, rts_argc;
        fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime);
     }
 
        fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime);
     }
 
-    if (do_gr_binary)
+    if (RTSflags.ParFlags.granSimStats_Binary)
         grputw(sizeof(TIME));
 }
 #endif /* PAR */
         grputw(sizeof(TIME));
 }
 #endif /* PAR */
index 87c1460..8847c7c 100644 (file)
@@ -18,7 +18,7 @@ to support.  So much for standards.
 
 \begin{code}
 
 
 \begin{code}
 
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
 
 # include "platform.h"
 
 
 # include "platform.h"
 
@@ -79,6 +79,6 @@ int ms;
 }
 # endif
 
 }
 # endif
 
-#endif /* USE_COST_CENTRES || CONCURRENT */
+#endif /* PROFILING || CONCURRENT */
 
 \end{code}
 
 \end{code}
diff --git a/ghc/runtime/main/Mallocs.lc b/ghc/runtime/main/Mallocs.lc
new file mode 100644 (file)
index 0000000..5a8ed4b
--- /dev/null
@@ -0,0 +1,40 @@
+%---------------------------------------------------------------*
+%
+\section{Wrappers around malloc}
+%
+%---------------------------------------------------------------*
+
+Routines that deal with memory allocation:
+
+A LONG-AGO WISH: All dynamic allocation must be done before the stacks
+and heap are allocated. This allows us to use the lower level sbrk
+routines if required.
+
+ANOTHER ONE: Should allow use of valloc to align on page boundary.
+
+\begin{code}
+#include "rtsdefs.h"
+
+char *
+stgMallocBytes(n, msg)
+  I_   n;
+  char *msg;
+{
+    char *space;
+
+    if ((space = (char *) malloc((size_t) n)) == NULL) {
+       fflush(stdout);
+       MallocFailHook((W_) n, msg); /*msg*/
+       EXIT(EXIT_FAILURE);
+    }
+    return space;
+}
+
+char *
+stgMallocWords(n, msg)
+  I_   n;
+  char *msg;
+{
+  return(stgMallocBytes(n * sizeof(W_), msg));
+}
+\end{code}
diff --git a/ghc/runtime/main/RednCounts.lc b/ghc/runtime/main/RednCounts.lc
deleted file mode 100644 (file)
index 142dc84..0000000
+++ /dev/null
@@ -1,682 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-1993
-%
-%************************************************************************
-%*                                                                     *
-\section[RednCounts.lc]{Stuff for ``ticky-ticky'' profiling}
-%*                                                                     *
-%************************************************************************
-
-Goes with \tr{imports/RednCounts.lh}; more documentation there.
-
-%************************************************************************
-%*                                                                     *
-\subsection[RednCounts-counters]{Declare all the counters}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-#define NULL_REG_MAP   /* Not threaded */
-
-#include "../storage/SMinternal.h" /* Bad boy, Will (ToDo) */
-
-#if defined(DO_REDN_COUNTING)
-
-extern FILE *tickyfile;
-
-I_ ALLOC_HEAP_ctr = 0;
-I_ ALLOC_HEAP_tot = 0;
-
-PP_ max_SpA; /* set in re_enterable_part_of_main */
-P_  max_SpB;
-
-/* not used at all
-I_ A_STK_REUSE_ctr = 0;
-I_ B_STK_REUSE_ctr = 0;
-*/
-I_ A_STK_STUB_ctr = 0;
-
-I_ ALLOC_FUN_ctr = 0;
-I_ ALLOC_FUN_adm = 0;
-I_ ALLOC_FUN_gds = 0;
-I_ ALLOC_FUN_slp = 0;
-I_ ALLOC_FUN_hst[5] = {0,0,0,0,0};
-I_ ALLOC_THK_ctr = 0;
-I_ ALLOC_THK_adm = 0;
-I_ ALLOC_THK_gds = 0;
-I_ ALLOC_THK_slp = 0;
-I_ ALLOC_THK_hst[5] = {0,0,0,0,0};
-I_ ALLOC_CON_ctr = 0;
-I_ ALLOC_CON_adm = 0;
-I_ ALLOC_CON_gds = 0;
-I_ ALLOC_CON_slp = 0;
-I_ ALLOC_CON_hst[5] = {0,0,0,0,0};
-I_ ALLOC_TUP_ctr = 0;
-I_ ALLOC_TUP_adm = 0;
-I_ ALLOC_TUP_gds = 0;
-I_ ALLOC_TUP_slp = 0;
-I_ ALLOC_TUP_hst[5] = {0,0,0,0,0};
-I_ ALLOC_BH_ctr = 0;
-I_ ALLOC_BH_adm = 0;
-I_ ALLOC_BH_gds = 0;
-I_ ALLOC_BH_slp = 0;
-I_ ALLOC_BH_hst[5] = {0,0,0,0,0};
-/*
-I_ ALLOC_PAP_ctr = 0;
-I_ ALLOC_PAP_adm = 0;
-I_ ALLOC_PAP_gds = 0;
-I_ ALLOC_PAP_slp = 0;
-I_ ALLOC_PAP_hst[5] = {0,0,0,0,0};
-*/
-I_ ALLOC_PRIM_ctr = 0;
-I_ ALLOC_PRIM_adm = 0;
-I_ ALLOC_PRIM_gds = 0;
-I_ ALLOC_PRIM_slp = 0;
-I_ ALLOC_PRIM_hst[5] = {0,0,0,0,0};
-/*
-I_ ALLOC_UPD_CON_ctr = 0;
-I_ ALLOC_UPD_CON_adm = 0;
-I_ ALLOC_UPD_CON_gds = 0;
-I_ ALLOC_UPD_CON_slp = 0;
-I_ ALLOC_UPD_CON_hst[5] = {0,0,0,0,0};
-*/
-I_ ALLOC_UPD_PAP_ctr = 0;
-I_ ALLOC_UPD_PAP_adm = 0;
-I_ ALLOC_UPD_PAP_gds = 0;
-I_ ALLOC_UPD_PAP_slp = 0;
-I_ ALLOC_UPD_PAP_hst[5] = {0,0,0,0,0};
-
-#ifdef CONCURRENT
-I_ ALLOC_STK_ctr = 0;
-I_ ALLOC_STK_adm = 0;
-I_ ALLOC_STK_gds = 0;
-I_ ALLOC_STK_slp = 0;
-I_ ALLOC_STK_hst[5] = {0,0,0,0,0};
-I_ ALLOC_TSO_ctr = 0;
-I_ ALLOC_TSO_adm = 0;
-I_ ALLOC_TSO_gds = 0;
-I_ ALLOC_TSO_slp = 0;
-I_ ALLOC_TSO_hst[5] = {0,0,0,0,0};
-
-#ifdef PAR
-I_ ALLOC_FMBQ_ctr = 0;
-I_ ALLOC_FMBQ_adm = 0;
-I_ ALLOC_FMBQ_gds = 0;
-I_ ALLOC_FMBQ_slp = 0;
-I_ ALLOC_FMBQ_hst[5] = {0,0,0,0,0};
-I_ ALLOC_FME_ctr = 0;
-I_ ALLOC_FME_adm = 0;
-I_ ALLOC_FME_gds = 0;
-I_ ALLOC_FME_slp = 0;
-I_ ALLOC_FME_hst[5] = {0,0,0,0,0};
-I_ ALLOC_BF_ctr = 0;
-I_ ALLOC_BF_adm = 0;
-I_ ALLOC_BF_gds = 0;
-I_ ALLOC_BF_slp = 0;
-I_ ALLOC_BF_hst[5] = {0,0,0,0,0};
-#endif
-#endif
-
-I_ ENT_VIA_NODE_ctr = 0;
-I_ ENT_CON_ctr = 0;
-I_ ENT_FUN_STD_ctr = 0;
-I_ ENT_FUN_DIRECT_ctr = 0;
-I_ ENT_IND_ctr = 0;
-I_ ENT_PAP_ctr = 0;
-I_ ENT_THK_ctr = 0;
-
-I_ RET_NEW_IN_HEAP_ctr = 0;
-I_ RET_NEW_IN_REGS_ctr = 0;
-I_ RET_OLD_IN_HEAP_ctr = 0;
-I_ RET_OLD_IN_REGS_ctr = 0;
-I_ RET_SEMI_BY_DEFAULT_ctr = 0;
-I_ RET_SEMI_IN_HEAP_ctr = 0;
-I_ RET_SEMI_IN_REGS_ctr = 0;
-I_ VEC_RETURN_ctr = 0;
-
-I_ ReturnInRegsNodeValid = 0; /* i.e., False */
-
-I_ UPDF_OMITTED_ctr = 0;
-I_ UPDF_STD_PUSHED_ctr = 0;
-I_ UPDF_CON_PUSHED_ctr = 0;
-I_ UPDF_HOLE_PUSHED_ctr = 0;
-
-I_ UPDF_RCC_PUSHED_ctr = 0;
-I_ UPDF_RCC_OMITTED_ctr = 0;
-
-I_ UPD_EXISTING_ctr = 0;
-I_ UPD_CON_W_NODE_ctr = 0;
-I_ UPD_CON_IN_PLACE_ctr = 0;
-I_ UPD_CON_IN_NEW_ctr = 0;
-I_ UPD_PAP_IN_PLACE_ctr = 0;
-I_ UPD_PAP_IN_NEW_ctr = 0;
-
-I_ UPD_ENTERED_ctr = 0;
-I_ UPD_ENTERED_AGAIN_ctr = 0;
-
-I_ UPD_NEW_IND_ctr = 0;
-I_ UPD_NEW_IN_PLACE_PTRS_ctr = 0;
-I_ UPD_NEW_IN_PLACE_NOPTRS_ctr = 0;
-I_ UPD_OLD_IND_ctr = 0;
-I_ UPD_OLD_IN_PLACE_PTRS_ctr = 0;
-I_ UPD_OLD_IN_PLACE_NOPTRS_ctr = 0;
-
-I_ UPD_IN_PLACE_COPY_ctr = 0;
-\end{code}
-
-\begin{code}
-#if 0
-/* testing only */
-void
-TICKY_PARANOIA(const char *file, I_ line)
-{
-  I_ tot_adm_wds = /* total number of admin words allocated */
-       ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm +
-       ALLOC_BH_adm  /*+ ALLOC_PAP_adm*/ /*+ ALLOC_UPD_CON_adm*/ + ALLOC_UPD_PAP_adm +
-       ALLOC_PRIM_adm;
-  I_ tot_gds_wds = /* total number of words of ``good stuff'' allocated */
-       ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds +
-       ALLOC_BH_gds  /*+ ALLOC_PAP_gds*/ /*+ ALLOC_UPD_CON_gds*/ + ALLOC_UPD_PAP_gds +
-       ALLOC_PRIM_gds;
-  I_ tot_slp_wds = /* total number of ``slop'' words allocated */
-       ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp +
-       ALLOC_BH_slp  /*+ ALLOC_PAP_slp*/ /*+ ALLOC_UPD_CON_slp*/ + ALLOC_UPD_PAP_slp +
-       ALLOC_PRIM_slp;
-  I_ tot_wds = /* total words */
-       tot_adm_wds + tot_gds_wds + tot_slp_wds;
-  if (ALLOC_HEAP_tot != tot_wds) {
-       fprintf(stderr, "Eek! %ld != %ld, %s, %d\n",ALLOC_HEAP_tot, tot_wds, file, line);
-  } else {
-       fprintf(stderr, "OK. %ld != %ld, %s, %d\n",ALLOC_HEAP_tot, tot_wds, file, line);
-  }
-}
-#endif /* 0 */
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection[RednCounts-print]{Print out all the counters}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-extern void printRegisteredCounterInfo (STG_NO_ARGS); /* fwd decl */
-
-#define INTAVG(a,b) ((b == 0) ? 0.0 : ((StgDouble) (a) / (StgDouble) (b)))
-#define PC(a)      (100.0 * a)
-
-#define AVG(thing) \
-       StgDouble CAT2(avg,thing)  = INTAVG(CAT2(tot,thing),CAT2(ctr,thing))
-
-void
-PrintRednCountInfo()
-{
-  I_ tot_allocs = /* total number of things allocated */
-       ALLOC_FUN_ctr + ALLOC_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr +
-#ifdef CONCURRENT
-       ALLOC_STK_ctr + ALLOC_TSO_ctr +
-#ifdef PAR
-       ALLOC_FMBQ_ctr + ALLOC_FME_ctr + ALLOC_BF_ctr +
-#endif
-#endif
-       ALLOC_BH_ctr  /*+ ALLOC_PAP_ctr*/ /*+ ALLOC_UPD_CON_ctr*/ + ALLOC_UPD_PAP_ctr +
-       ALLOC_PRIM_ctr;
-  I_ tot_adm_wds = /* total number of admin words allocated */
-       ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm +
-#ifdef CONCURRENT
-       ALLOC_STK_adm + ALLOC_TSO_adm +
-#ifdef PAR
-       ALLOC_FMBQ_adm + ALLOC_FME_adm + ALLOC_BF_adm +
-#endif
-#endif
-       ALLOC_BH_adm  /*+ ALLOC_PAP_adm*/ /*+ ALLOC_UPD_CON_adm*/ + ALLOC_UPD_PAP_adm +
-       ALLOC_PRIM_adm;
-  I_ tot_gds_wds = /* total number of words of ``good stuff'' allocated */
-       ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds +
-#ifdef CONCURRENT
-       ALLOC_STK_gds + ALLOC_TSO_gds +
-#ifdef PAR
-       ALLOC_FMBQ_gds + ALLOC_FME_gds + ALLOC_BF_gds +
-#endif
-#endif
-       ALLOC_BH_gds  /*+ ALLOC_PAP_gds*/ /*+ ALLOC_UPD_CON_gds*/ + ALLOC_UPD_PAP_gds +
-       ALLOC_PRIM_gds;
-  I_ tot_slp_wds = /* total number of ``slop'' words allocated */
-       ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp +
-#ifdef CONCURRENT
-       ALLOC_STK_slp + ALLOC_TSO_slp +
-#ifdef PAR
-       ALLOC_FMBQ_slp + ALLOC_FME_slp + ALLOC_BF_slp +
-#endif
-#endif
-       ALLOC_BH_slp  /*+ ALLOC_PAP_slp*/ /*+ ALLOC_UPD_CON_slp*/ + ALLOC_UPD_PAP_slp +
-       ALLOC_PRIM_slp;
-  I_ tot_wds = /* total words */
-       tot_adm_wds + tot_gds_wds + tot_slp_wds;
-
-  I_ tot_enters =
-       ENT_CON_ctr + ENT_FUN_DIRECT_ctr +
-       ENT_IND_ctr + ENT_PAP_ctr + ENT_THK_ctr;
-  I_ jump_direct_enters =
-       tot_enters - ENT_VIA_NODE_ctr;
-  I_ bypass_enters =
-       ENT_FUN_DIRECT_ctr -
-       (ENT_FUN_STD_ctr - UPD_PAP_IN_PLACE_ctr - UPD_PAP_IN_NEW_ctr);
-
-  I_ tot_returns_in_regs =
-       RET_NEW_IN_REGS_ctr + RET_OLD_IN_REGS_ctr + RET_SEMI_IN_REGS_ctr;
-  I_ tot_returns_in_heap =
-       RET_NEW_IN_HEAP_ctr + RET_OLD_IN_HEAP_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_BY_DEFAULT_ctr/*???*/;
-  I_ tot_returns_of_new =
-       RET_NEW_IN_REGS_ctr + RET_NEW_IN_HEAP_ctr;
-  I_ tot_returns_of_old = /* NB: NOT USED ???!  94/05 WDP */
-       RET_OLD_IN_REGS_ctr + RET_OLD_IN_HEAP_ctr +
-       RET_SEMI_BY_DEFAULT_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_IN_REGS_ctr /*???*/;
-
-  I_ tot_returns =
-       tot_returns_in_regs + tot_returns_in_heap;
-
-  I_ tot_upd_frames =
-       UPDF_STD_PUSHED_ctr + UPDF_CON_PUSHED_ctr;      /*DBH*/
-
-  I_ con_updates =
-       UPD_CON_W_NODE_ctr + UPD_CON_IN_PLACE_ctr + UPD_CON_IN_NEW_ctr;
-  I_ pap_updates =
-       UPD_PAP_IN_PLACE_ctr + UPD_PAP_IN_NEW_ctr;
-  I_ tot_updates =
-       UPD_EXISTING_ctr + con_updates + pap_updates;
-  I_ tot_in_place_updates =
-       UPD_CON_IN_PLACE_ctr + UPD_PAP_IN_PLACE_ctr;
-
-  I_ tot_new_updates = 
-        UPD_NEW_IN_PLACE_NOPTRS_ctr + UPD_NEW_IN_PLACE_PTRS_ctr + UPD_NEW_IND_ctr;
-  I_ tot_old_updates =
-        UPD_OLD_IN_PLACE_NOPTRS_ctr + UPD_OLD_IN_PLACE_PTRS_ctr + UPD_OLD_IND_ctr;
-  I_ tot_gengc_updates =
-        tot_new_updates + tot_old_updates;
-
-  fprintf(tickyfile,"\n\nALLOCATIONS: %ld (%ld words total: %ld admin, %ld goods, %ld slop)\n",
-       tot_allocs, tot_wds, tot_adm_wds, tot_gds_wds, tot_slp_wds);
-  fprintf(tickyfile,"\t\t\t\ttotal words:\t    2     3     4     5    6+\n");
-
-#define ALLOC_HISTO_MAGIC(categ) \
-       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[0], CAT3(ALLOC_,categ,_ctr)))), \
-       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[1], CAT3(ALLOC_,categ,_ctr)))), \
-       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[2], CAT3(ALLOC_,categ,_ctr)))), \
-       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[3], CAT3(ALLOC_,categ,_ctr)))), \
-       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[4], CAT3(ALLOC_,categ,_ctr))))
-
-  fprintf(tickyfile,"%7ld (%5.1f%%) function values",
-       ALLOC_FUN_ctr,
-       PC(INTAVG(ALLOC_FUN_ctr, tot_allocs)));
-  if (ALLOC_FUN_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FUN));
-
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) thunks",
-       ALLOC_THK_ctr,
-       PC(INTAVG(ALLOC_THK_ctr, tot_allocs)));
-  if (ALLOC_THK_ctr != 0)
-      fprintf(tickyfile,"\t\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(THK));
-
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) data values",
-       ALLOC_CON_ctr,
-       PC(INTAVG(ALLOC_CON_ctr, tot_allocs)));
-  if (ALLOC_CON_ctr != 0)
-      fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(CON));
-
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) big tuples",
-       ALLOC_TUP_ctr,
-       PC(INTAVG(ALLOC_TUP_ctr, tot_allocs)));
-  if (ALLOC_TUP_ctr != 0)
-      fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TUP));
-
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) black holes",
-       ALLOC_BH_ctr,
-       PC(INTAVG(ALLOC_BH_ctr, tot_allocs)));
-  if (ALLOC_BH_ctr != 0)
-      fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BH));
-
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) prim things",
-       ALLOC_PRIM_ctr,
-       PC(INTAVG(ALLOC_PRIM_ctr, tot_allocs)));
-  if (ALLOC_PRIM_ctr != 0)
-      fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PRIM));
-
-#if 0
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) partial applications",
-       ALLOC_PAP_ctr,
-       PC(INTAVG(ALLOC_PAP_ctr, tot_allocs)));
-  if (ALLOC_PAP_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PAP));
-#endif /* 0 */
-
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) partial applications",
-       ALLOC_UPD_PAP_ctr,
-       PC(INTAVG(ALLOC_UPD_PAP_ctr, tot_allocs)));
-  if (ALLOC_UPD_PAP_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(UPD_PAP));
-
-#if 0
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) data-value updates",
-       ALLOC_UPD_CON_ctr,
-       PC(INTAVG(ALLOC_UPD_CON_ctr, tot_allocs)));
-  if (ALLOC_UPD_CON_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(UPD_CON));
-#endif /* 0 */
-
-#ifdef CONCURRENT
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) stack objects",
-       ALLOC_STK_ctr,
-       PC(INTAVG(ALLOC_STK_ctr, tot_allocs)));
-  if (ALLOC_STK_ctr != 0)
-      fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(STK));
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects",
-       ALLOC_TSO_ctr,
-       PC(INTAVG(ALLOC_TSO_ctr, tot_allocs)));
-  if (ALLOC_TSO_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TSO));
-#ifdef PAR
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects",
-       ALLOC_FMBQ_ctr,
-       PC(INTAVG(ALLOC_FMBQ_ctr, tot_allocs)));
-  if (ALLOC_FMBQ_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FMBQ));
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects",
-       ALLOC_FME_ctr,
-       PC(INTAVG(ALLOC_FME_ctr, tot_allocs)));
-  if (ALLOC_FME_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FME));
-  fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects",
-       ALLOC_BF_ctr,
-       PC(INTAVG(ALLOC_BF_ctr, tot_allocs)));
-  if (ALLOC_BF_ctr != 0)
-      fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF));
-#endif
-#endif
-  fprintf(tickyfile,"\n");
-
-  fprintf(tickyfile,"\nTotal storage-manager allocations: %ld (%ld words)\n\t[%ld words lost to speculative heap-checks]\n", ALLOC_HEAP_ctr, ALLOC_HEAP_tot, ALLOC_HEAP_tot - tot_wds);
-
-  fprintf(tickyfile,"\nSTACK USAGE:\n"); /* NB: some bits are direction sensitive */
-  fprintf(tickyfile,"\tA stack slots stubbed: %ld\n", A_STK_STUB_ctr);
-/* not used at all
-  fprintf(tickyfile,"\tA stack slots re-used: %ld\n", A_STK_REUSE_ctr);
-  fprintf(tickyfile,"\tB stack slots re-used: %ld\n", B_STK_REUSE_ctr);
-*/
-#ifndef CONCURRENT
-  fprintf(tickyfile,"\tA stack max. depth: %ld words\n",
-               (I_) (stackInfo.botA - max_SpA));
-  fprintf(tickyfile,"\tB stack max. depth: %ld words\n",
-               (I_) (max_SpB - stackInfo.botB));       /* And cheating, too (ToDo) */
-#endif
-
-  fprintf(tickyfile,"\nENTERS: %ld  of which %ld (%.1f%%) direct to the entry code\n\t\t  [the rest indirected via Node's info ptr]\n",
-       tot_enters,
-       jump_direct_enters,
-       PC(INTAVG(jump_direct_enters,tot_enters)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) thunks\n",
-       ENT_THK_ctr,
-       PC(INTAVG(ENT_THK_ctr,tot_enters)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) data values\n",
-       ENT_CON_ctr,
-       PC(INTAVG(ENT_CON_ctr,tot_enters)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) function values\n\t\t  [of which %ld (%.1f%%) bypassed arg-satisfaction chk]\n",
-       ENT_FUN_DIRECT_ctr,
-       PC(INTAVG(ENT_FUN_DIRECT_ctr,tot_enters)),
-       bypass_enters,
-       PC(INTAVG(bypass_enters,ENT_FUN_DIRECT_ctr)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) partial applications\n",
-       ENT_PAP_ctr,
-       PC(INTAVG(ENT_PAP_ctr,tot_enters)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) indirections\n",
-       ENT_IND_ctr,
-       PC(INTAVG(ENT_IND_ctr,tot_enters)));
-
-  fprintf(tickyfile,"\nRETURNS: %ld\n", tot_returns);
-  fprintf(tickyfile,"%7ld (%5.1f%%) in registers [the rest in the heap]\n",
-       tot_returns_in_regs,
-       PC(INTAVG(tot_returns_in_regs,tot_returns)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) from entering a new constructor\n\t\t  [the rest from entering an existing constructor]\n",
-       tot_returns_of_new,
-       PC(INTAVG(tot_returns_of_new,tot_returns)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) vectored [the rest unvectored]\n",
-       VEC_RETURN_ctr,
-       PC(INTAVG(VEC_RETURN_ctr,tot_returns)));
-
-  fprintf(tickyfile,"\nUPDATE FRAMES: %ld (%ld omitted from thunks)\n",
-       tot_upd_frames,
-       UPDF_OMITTED_ctr);
-  fprintf(tickyfile,"%7ld (%5.1f%%) standard frames\n",
-       UPDF_STD_PUSHED_ctr,
-       PC(INTAVG(UPDF_STD_PUSHED_ctr,tot_upd_frames)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) constructor frames\n",
-       UPDF_CON_PUSHED_ctr,
-       PC(INTAVG(UPDF_CON_PUSHED_ctr,tot_upd_frames)));
-  fprintf(tickyfile,"\t\t  [of which %ld (%.1f%%) were for black-holes]\n",
-       UPDF_HOLE_PUSHED_ctr,
-       PC(INTAVG(UPDF_HOLE_PUSHED_ctr,UPDF_CON_PUSHED_ctr)));  /*DBH*/
-
-  if (UPDF_RCC_PUSHED_ctr != 0)
-     fprintf(tickyfile,"%7ld restore cost centre frames (%ld omitted)\n",
-       UPDF_RCC_PUSHED_ctr,
-       UPDF_RCC_OMITTED_ctr);
-
-  fprintf(tickyfile,"\nUPDATES: %ld\n", tot_updates);
-  fprintf(tickyfile,"%7ld (%5.1f%%) data values\n\t\t  [%ld in place, %ld allocated new space, %ld with Node]\n",
-       con_updates,
-       PC(INTAVG(con_updates,tot_updates)),
-       UPD_CON_IN_PLACE_ctr, UPD_CON_IN_NEW_ctr, UPD_CON_W_NODE_ctr);
-  fprintf(tickyfile,"%7ld (%5.1f%%) partial applications\n\t\t  [%ld in place, %ld allocated new space]\n",
-       pap_updates,
-       PC(INTAVG(pap_updates,tot_updates)),
-       UPD_PAP_IN_PLACE_ctr, UPD_PAP_IN_NEW_ctr);
-  fprintf(tickyfile,"%7ld (%5.1f%%) updates to existing heap objects\n",
-       UPD_EXISTING_ctr,
-       PC(INTAVG(UPD_EXISTING_ctr,tot_updates)));
-  fprintf(tickyfile,"%7ld (%5.1f%%) in-place updates copied\n",
-       UPD_IN_PLACE_COPY_ctr,
-       PC(INTAVG(UPD_IN_PLACE_COPY_ctr,tot_in_place_updates)));
-  if (UPD_ENTERED_ctr != 0) {
-      fprintf(tickyfile,"%7ld (%5.1f%%) subsequently entered\n",
-             UPD_ENTERED_ctr,
-             PC(INTAVG(UPD_ENTERED_ctr,tot_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) subsequently entered more than once\n",
-             UPD_ENTERED_AGAIN_ctr,
-             PC(INTAVG(UPD_ENTERED_AGAIN_ctr,tot_updates)));
-  }
-
-  if (tot_gengc_updates != 0) {
-      fprintf(tickyfile,"\nNEW GEN UPDATES: %ld (%5.1f%%)\n",
-             tot_new_updates,
-             PC(INTAVG(tot_new_updates,tot_gengc_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) indirections\n",
-             UPD_NEW_IND_ctr,
-             PC(INTAVG(UPD_NEW_IND_ctr,tot_gengc_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) inplace with ptrs\n",
-             UPD_NEW_IN_PLACE_PTRS_ctr,
-             PC(INTAVG(UPD_NEW_IN_PLACE_PTRS_ctr,tot_gengc_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) inplace without ptrs\n",
-             UPD_NEW_IN_PLACE_NOPTRS_ctr,
-             PC(INTAVG(UPD_NEW_IN_PLACE_NOPTRS_ctr,tot_gengc_updates)));
-      fprintf(tickyfile,"\nOLD GEN UPDATES: %ld (%5.1f%%)\n",
-             tot_old_updates,
-             PC(INTAVG(tot_old_updates,tot_gengc_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) indirections\n",
-             UPD_OLD_IND_ctr,
-             PC(INTAVG(UPD_OLD_IND_ctr,tot_gengc_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) inplace with ptrs\n",
-             UPD_OLD_IN_PLACE_PTRS_ctr,
-             PC(INTAVG(UPD_OLD_IN_PLACE_PTRS_ctr,tot_gengc_updates)));
-      fprintf(tickyfile,"%7ld (%5.1f%%) inplace without ptrs\n",
-             UPD_OLD_IN_PLACE_NOPTRS_ctr,
-             PC(INTAVG(UPD_OLD_IN_PLACE_NOPTRS_ctr,tot_gengc_updates)));
-  }
-
-  printRegisteredCounterInfo();
-
-  fprintf(tickyfile,"\n**************************************************\n");
-  fprintf(tickyfile,"%6ld  ALLOC_HEAP_ctr\n",  ALLOC_HEAP_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_HEAP_tot\n",  ALLOC_HEAP_tot);
-
-#ifndef CONCURRENT
-  fprintf(tickyfile,"%6ld  HWM_SpA\n",         (I_) (stackInfo.botA - max_SpA));
-  fprintf(tickyfile,"%6ld  HWM_SpB\n",         (I_) (max_SpB - stackInfo.botB));
-#endif
-
-  fprintf(tickyfile,"%6ld  ALLOC_FUN_ctr\n",   ALLOC_FUN_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_FUN_adm\n",   ALLOC_FUN_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_FUN_gds\n",   ALLOC_FUN_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_FUN_slp\n",   ALLOC_FUN_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_THK_ctr\n",   ALLOC_THK_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_THK_adm\n",   ALLOC_THK_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_THK_gds\n",   ALLOC_THK_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_THK_slp\n",   ALLOC_THK_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_CON_ctr\n",   ALLOC_CON_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_CON_adm\n",   ALLOC_CON_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_CON_gds\n",   ALLOC_CON_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_CON_slp\n",   ALLOC_CON_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_TUP_ctr\n",   ALLOC_TUP_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_TUP_adm\n",   ALLOC_TUP_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_TUP_gds\n",   ALLOC_TUP_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_TUP_slp\n",   ALLOC_TUP_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_BH_ctr\n",            ALLOC_BH_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_BH_adm\n",            ALLOC_BH_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_BH_gds\n",            ALLOC_BH_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_BH_slp\n",            ALLOC_BH_slp);
-/*
-  fprintf(tickyfile,"%6ld  ALLOC_PAP_ctr\n",   ALLOC_PAP_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_PAP_adm\n",   ALLOC_PAP_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_PAP_gds\n",   ALLOC_PAP_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_PAP_slp\n",   ALLOC_PAP_slp);
-*/
-  fprintf(tickyfile,"%6ld  ALLOC_PRIM_ctr\n",  ALLOC_PRIM_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_PRIM_adm\n",  ALLOC_PRIM_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_PRIM_gds\n",  ALLOC_PRIM_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_PRIM_slp\n",  ALLOC_PRIM_slp);
-/*
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_CON_ctr\n",       ALLOC_UPD_CON_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_CON_adm\n",       ALLOC_UPD_CON_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_CON_gds\n",       ALLOC_UPD_CON_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_CON_slp\n",       ALLOC_UPD_CON_slp);
-*/
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_PAP_ctr\n",       ALLOC_UPD_PAP_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_PAP_adm\n",       ALLOC_UPD_PAP_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_PAP_gds\n",       ALLOC_UPD_PAP_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_UPD_PAP_slp\n",       ALLOC_UPD_PAP_slp);
-
-#ifdef CONCURRENT
-  fprintf(tickyfile,"%6ld  ALLOC_STK_ctr\n",   ALLOC_STK_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_STK_adm\n",   ALLOC_STK_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_STK_gds\n",   ALLOC_STK_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_STK_slp\n",   ALLOC_STK_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_TSO_ctr\n",   ALLOC_TSO_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_TSO_adm\n",   ALLOC_TSO_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_TSO_gds\n",   ALLOC_TSO_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_TSO_slp\n",   ALLOC_TSO_slp);
-#ifdef PAR
-  fprintf(tickyfile,"%6ld  ALLOC_FMBQ_ctr\n",  ALLOC_FMBQ_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_FMBQ_adm\n",  ALLOC_FMBQ_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_FMBQ_gds\n",  ALLOC_FMBQ_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_FMBQ_slp\n",  ALLOC_FMBQ_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_FME_ctr\n",   ALLOC_FME_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_FME_adm\n",   ALLOC_FME_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_FME_gds\n",   ALLOC_FME_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_FME_slp\n",   ALLOC_FME_slp);
-  fprintf(tickyfile,"%6ld  ALLOC_BF_ctr\n",    ALLOC_BF_ctr);
-  fprintf(tickyfile,"%6ld  ALLOC_BF_adm\n",    ALLOC_BF_adm);
-  fprintf(tickyfile,"%6ld  ALLOC_BF_gds\n",    ALLOC_BF_gds);
-  fprintf(tickyfile,"%6ld  ALLOC_BF_slp\n",    ALLOC_BF_slp);
-#endif
-#endif
-
-  fprintf(tickyfile,"%6ld  ENT_VIA_NODE_ctr\n",        ENT_VIA_NODE_ctr);
-  fprintf(tickyfile,"%6ld  ENT_CON_ctr\n",             ENT_CON_ctr);
-  fprintf(tickyfile,"%6ld  ENT_FUN_STD_ctr\n", ENT_FUN_STD_ctr);
-  fprintf(tickyfile,"%6ld  ENT_FUN_DIRECT_ctr\n",      ENT_FUN_DIRECT_ctr);
-  fprintf(tickyfile,"%6ld  ENT_IND_ctr\n",             ENT_IND_ctr);
-  fprintf(tickyfile,"%6ld  ENT_PAP_ctr\n",             ENT_PAP_ctr);
-  fprintf(tickyfile,"%6ld  ENT_THK_ctr\n",             ENT_THK_ctr);
-
-  fprintf(tickyfile,"%6ld  RET_NEW_IN_HEAP_ctr\n",     RET_NEW_IN_HEAP_ctr);
-  fprintf(tickyfile,"%6ld  RET_NEW_IN_REGS_ctr\n",     RET_NEW_IN_REGS_ctr);
-  fprintf(tickyfile,"%6ld  RET_OLD_IN_HEAP_ctr\n",     RET_OLD_IN_HEAP_ctr);
-  fprintf(tickyfile,"%6ld  RET_OLD_IN_REGS_ctr\n",     RET_OLD_IN_REGS_ctr);
-  fprintf(tickyfile,"%6ld  RET_SEMI_BY_DEFAULT_ctr\n", RET_SEMI_BY_DEFAULT_ctr);
-  fprintf(tickyfile,"%6ld  RET_SEMI_IN_HEAP_ctr\n",    RET_SEMI_IN_HEAP_ctr);
-  fprintf(tickyfile,"%6ld  RET_SEMI_IN_REGS_ctr\n",    RET_SEMI_IN_REGS_ctr);
-  fprintf(tickyfile,"%6ld  VEC_RETURN_ctr\n",  VEC_RETURN_ctr);
-
-  fprintf(tickyfile,"%6ld  UPDF_OMITTED_ctr\n",        UPDF_OMITTED_ctr);
-  fprintf(tickyfile,"%6ld  UPDF_STD_PUSHED_ctr\n",     UPDF_STD_PUSHED_ctr);
-  fprintf(tickyfile,"%6ld  UPDF_CON_PUSHED_ctr\n",     UPDF_CON_PUSHED_ctr);
-  fprintf(tickyfile,"%6ld  UPDF_HOLE_PUSHED_ctr\n",    UPDF_HOLE_PUSHED_ctr);
-
-  fprintf(tickyfile,"%6ld  UPDF_RCC_PUSHED_ctr\n",     UPDF_RCC_PUSHED_ctr);
-  fprintf(tickyfile,"%6ld  UPDF_RCC_OMITTED_ctr\n",    UPDF_RCC_OMITTED_ctr);
-
-  fprintf(tickyfile,"%6ld  UPD_EXISTING_ctr\n",                UPD_EXISTING_ctr);
-  fprintf(tickyfile,"%6ld  UPD_CON_W_NODE_ctr\n",      UPD_CON_W_NODE_ctr);
-  fprintf(tickyfile,"%6ld  UPD_CON_IN_PLACE_ctr\n",    UPD_CON_IN_PLACE_ctr);
-  fprintf(tickyfile,"%6ld  UPD_CON_IN_NEW_ctr\n",      UPD_CON_IN_NEW_ctr);
-  fprintf(tickyfile,"%6ld  UPD_PAP_IN_PLACE_ctr\n",    UPD_PAP_IN_PLACE_ctr);
-  fprintf(tickyfile,"%6ld  UPD_PAP_IN_NEW_ctr\n",      UPD_PAP_IN_NEW_ctr);
-  fprintf(tickyfile,"%6ld  UPD_ENTERED_ctr\n", UPD_ENTERED_ctr);
-  fprintf(tickyfile,"%6ld  UPD_ENTERED_AGAIN_ctr\n",UPD_ENTERED_AGAIN_ctr);
-
-  fprintf(tickyfile,"%6ld  UPD_NEW_IND_ctr\n",         UPD_NEW_IND_ctr);
-  fprintf(tickyfile,"%6ld  UPD_NEW_IN_PLACE_PTRS_ctr\n",       UPD_NEW_IN_PLACE_PTRS_ctr);
-  fprintf(tickyfile,"%6ld  UPD_NEW_IN_PLACE_NOPTRS_ctr\n",     UPD_NEW_IN_PLACE_NOPTRS_ctr);
-  fprintf(tickyfile,"%6ld  UPD_OLD_IND_ctr\n",         UPD_OLD_IND_ctr);
-  fprintf(tickyfile,"%6ld  UPD_OLD_IN_PLACE_PTRS_ctr\n",       UPD_OLD_IN_PLACE_PTRS_ctr);
-  fprintf(tickyfile,"%6ld  UPD_OLD_IN_PLACE_NOPTRS_ctr\n",     UPD_OLD_IN_PLACE_NOPTRS_ctr);
-}
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection[RednCounts-ent-counters]{Handle named entry counters}
-%*                                                                     *
-%************************************************************************
-
-Data structure used in ``registering'' one of these counters.
-\begin{code}
-struct ent_counter *ListOfEntryCtrs = NULL; /* root of list of them */
-\end{code}
-
-To print out all the registered-counter info:
-\begin{code}
-void
-printRegisteredCounterInfo ( STG_NO_ARGS )
-{
-    struct ent_counter *p;
-
-    if ( ListOfEntryCtrs != NULL ) {
-       fprintf(tickyfile,"\n**************************************************\n");
-    }
-
-    for (p = ListOfEntryCtrs; p != NULL; p = p->link) {
-       /* common stuff first; then the wrapper info if avail */
-       fprintf(tickyfile, "%-40s%u\t%u\t%u\t%-16s%ld",
-               p->f_str,
-               p->arity,
-               p->Astk_args,
-               p->Bstk_args,
-               p->f_arg_kinds,
-               p->ctr);
-
-       if ( p->wrap_str == NULL ) {
-           fprintf(tickyfile, "\n");
-
-       } else {
-           fprintf(tickyfile, "\t%s\t%s\n",
-               p->wrap_str,
-               p->wrap_arg_kinds);
-       }
-    }
-}
-\end{code}
-
-That's all, folks.
-\begin{code}
-#endif /* DO_REDN_COUNTING */
-\end{code}
diff --git a/ghc/runtime/main/RtsFlags.lc b/ghc/runtime/main/RtsFlags.lc
new file mode 100644 (file)
index 0000000..1fb72e8
--- /dev/null
@@ -0,0 +1,1226 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1995
+%
+\section{Runtime-system runtime flags}
+
+Everything to do with RTS runtime flags, including RTS parameters
+that can be set by them, either directly or indirectly.
+
+@rtsFlags.lh@ defines the data structure that holds all of them.
+
+\begin{code}
+#include "rtsdefs.h"
+
+struct RTS_FLAGS RTSflags; /* actually declare the data structure */
+struct ALL_FLAGS AllFlags;
+
+/* some fwd decls */
+static I_     decode(const char *);
+static void   bad_option(const char *);
+static FILE * open_stats_file (I_ arg,
+               int argc, char *argv[], int rts_argc, char *rts_argv[],
+               const char *FILENAME_FMT);
+
+/* extern decls */
+long strtol  PROTO((const char *, char **, int));
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Initial default values for @RTSFlags@}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+void
+initRtsFlagsDefaults (STG_NO_ARGS)
+{
+    RTSflags.GcFlags.statsFile         = NULL;
+    RTSflags.GcFlags.giveStats         = NO_GC_STATS;
+
+    RTSflags.GcFlags.stksSize          = 0x10002;  /* 2^16 = 16Kwords = 64Kbytes */
+    RTSflags.GcFlags.heapSize          = 0x100002; /* 2^20 =  1Mwords =  4Mbytes  */
+    RTSflags.GcFlags.allocAreaSize     = 0x4002;   /* 2^14 = 16Kwords = 64Kbytes;
+                                                      plus 2 cache-friendly words */
+    RTSflags.GcFlags.allocAreaSizeGiven        = rtsFalse;
+    RTSflags.GcFlags.specifiedOldGenSize= 0;   /* means: use all heap available */
+    RTSflags.GcFlags.pcFreeHeap                = 3;    /* 3% */
+    /* minAllocAreaSize is derived; set in initSM,
+       after we know pcFreeHeap and heapSize */
+
+    RTSflags.GcFlags.force2s           = rtsFalse;
+    RTSflags.GcFlags.forceGC           = rtsFalse;
+    RTSflags.GcFlags.forcingInterval   = 5000000; /* 5MB (or words?) */
+    RTSflags.GcFlags.ringBell          = rtsFalse;
+    RTSflags.GcFlags.trace             = 0; /* not turned on */
+
+    RTSflags.GcFlags.lazyBlackHoling   = rtsTrue;
+    RTSflags.GcFlags.doSelectorsAtGC   = rtsTrue;
+    RTSflags.GcFlags.squeezeUpdFrames  = rtsTrue;
+
+#if defined(PROFILING) || defined(PAR)
+    RTSflags.CcFlags.doCostCentres     = 0;
+    RTSflags.CcFlags.sortBy            = SORTCC_TIME;
+
+    /* "ctxtSwitchTicks", "profilerTicks", & "msecsPerTick" are
+       derived info, so they are set after ctxtSwitchTime has been
+       determined.
+    */
+#endif /* PROFILING or PAR */
+
+#ifdef PROFILING
+    RTSflags.ProfFlags.doHeapProfile   = rtsFalse;
+#endif /* PROFILING */
+
+#ifdef CONCURRENT
+    RTSflags.ConcFlags.ctxtSwitchTime  = CS_MIN_MILLISECS;  /* In milliseconds */
+    RTSflags.ConcFlags.maxThreads      = 32;
+    RTSflags.ConcFlags.stkChunkSize    = 1024;
+    RTSflags.ConcFlags.maxLocalSparks  = 500;
+#endif /* CONCURRENT */
+
+#ifdef PAR
+    RTSflags.ParFlags.parallelStats    = rtsFalse;
+    RTSflags.ParFlags.granSimStats     = rtsFalse;
+    RTSflags.ParFlags.granSimStats_Binary = rtsFalse;
+
+    RTSflags.ParFlags.outputDisabled   = rtsFalse;
+
+    RTSflags.ParFlags.packBufferSize   = 1024;
+#endif /* PAR */
+
+#ifdef TICKY_TICKY
+    RTSflags.TickyFlags.showTickyStats = rtsFalse;
+    RTSflags.TickyFlags.tickyFile      = NULL;
+
+    AllFlags.doUpdEntryCounts          = rtsTrue; /*ToDo:move? */
+#endif
+}
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Usage message for runtime-system (RTS) flags}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+static const char *
+usage_text[] = {
+"",
+"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
+"",
+"   +RTS    Indicates run time system options follow",
+"   -RTS    Indicates program arguments follow",
+"  --RTS    Indicates that ALL subsequent arguments will be given to the",
+"           program (including any of these RTS flags)",
+"",
+"The following run time system options are available:",
+"",
+"  -? -f    Prints this message and exits; the program is not executed",
+"",
+"  -K<size> Sets the stack size (default 64k)    Egs: -K32k   -K512k",
+"  -H<size> Sets the heap size  (default 4M)          -H512k  -H16M",
+"  -s<file> Summary GC statistics   (default file: <program>.stat)",
+"  -S<file> Detailed GC statistics  (with -Sstderr going to stderr)",
+"",
+#if defined(GCap)
+"  -M<n>%   Sets minimum size of alloc area as % of heap (default 3%)",
+"  -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)",
+"  -G<size> Fixes size of major generation (default is dynamic threshold)",
+"  -F2s     Forces program compiled for Appel gc to use 2s collection",
+#else
+# if defined(GCgn)
+"  -A<size> Specifies size of alloc area (default 64k)",
+"  -G<size> Fixes size of major generation (default is available heap)",
+"  -F2s     Forces program compiled for Gen gc to use 2s collection",
+# else
+"  -M<n>%   Minimum % of heap which must be available (default 3%)",
+"  -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)",
+# endif
+#endif
+"  -j<size> Forces major GC at every <size> bytes allocated",
+#if defined(GCdu)
+"  -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
+#endif
+"",
+"  -N       No black-holing during GC (for use when a signal handler is present)",
+"  -Z       Don't squeeze out update frames on stack overflow",
+"  -B       Sound the bell at the start of each (major) garbage collection",
+#if defined(PROFILING) || defined(PAR)
+"",
+"  -p<sort> Produce cost centre time profile  (output file <program>.prof)",
+"             sort: T = time (default), A = alloc, C = cost centre label",
+"  -P<sort> Produce serial time profile (output file <program>.time)",
+"             and a -p profile with detailed caf/enter/tick/alloc info",
+# if defined(PROFILING)
+"",
+"  -h<break-down> Heap residency profile      (output file <program>.hp)",
+"     break-down: C = cost centre (default), M = module, G = group",
+"                 D = closure description, Y = type description",
+"                 T<ints>,<start> = time closure created",
+"                    ints:  no. of interval bands plotted (default 18)",
+"                    start: seconds after which intervals start (default 0.0)",
+"  A subset of closures may be selected by the attached cost centre using:",
+"    -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
+"    -m{mod,mod...} all cost centres from the specified modules(s)",
+"    -g{grp,grp...} all cost centres from the specified group(s)",
+"  Selections can also be made by description, type, kind and age:",
+"    -d{des,des...} closures with specified closure descriptions",
+"    -y{typ,typ...} closures with specified type descriptions",
+"    -k{knd,knd...} closures of the specified kinds",
+"    -a<age>        closures which survived <age> complete intervals",
+"  The selection logic used is summarised as follows:",
+"    ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
+"    where an option is true if not specified",
+# endif
+"",
+"  -z<tbl><size>  set hash table <size> for <tbl> (C, M, G, D or Y)",
+"",
+"  -i<secs> Number of seconds in a profiling interval (default 1.0):",
+"           heap profile (-h) and/or serial time profile (-P) frequency",
+#endif /* PROFILING or PAR */
+"",
+#if defined(TICKY_TICKY)
+"  -r<file>  Produce reduction profiling statistics (with -rstderr for stderr)",
+"",
+#endif
+"  -T<level> Trace garbage collection execution (debugging)",
+#ifdef CONCURRENT
+"",
+# ifdef PAR
+"  -N<n>     Use <n> PVMish processors in parallel (default: 2)",
+/* NB: the -N<n> is implemented by the driver!! */
+# endif
+"  -C<secs>  Context-switch interval in seconds",
+"                (0 or no argument means switch as often as possible)",
+"                the default is .01 sec; resolution is .01 sec",
+"  -e<size>        Size of spark pools (default 100)",
+# ifdef PAR
+"  -q        Enable activity profile (output files in ~/<program>*.gr)",
+"  -qb       Enable binary activity profile (output file /tmp/<program>.gb)",
+"  -Q<size>  Set pack-buffer size (default: 1024)",
+# else
+"  -q[v]     Enable quasi-parallel profile (output file <program>.qp)",
+# endif
+"  -t<num>   Set maximum number of advisory threads per PE (default 32)",
+"  -o<num>   Set stack chunk size (default 1024)",
+# ifdef PAR
+"  -d        Turn on PVM-ish debugging",
+"  -O        Disable output for performance measurement",
+# endif /* PAR */
+#endif /* CONCURRENT */
+"",
+"Other RTS options may be available for programs compiled a different way.",
+"The GHC User's Guide has full details.",
+"",
+0
+};
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Processing command-line arguments to set @RTSFlags@}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+#define RTS 1
+#define PGM 0
+
+#ifndef atof
+extern double atof();
+/* no proto because some machines use const and some do not */
+#endif
+
+static __inline__ rtsBool
+strequal(const char *a, const char * b)
+{
+    return(strcmp(a, b) == 0);
+}
+
+void
+setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
+{
+    rtsBool error = rtsFalse;
+    I_ mode;
+    I_ arg, total_arg;
+    char *last_slash;
+
+    /* Remove directory from argv[0] -- default files in current directory */
+
+    if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL)
+       strcpy(argv[0], last_slash+1);
+
+    /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
+    /*   argv[0] must be PGM argument -- leave in argv                 */
+
+    total_arg = *argc;
+    arg = 1;
+
+    *argc = 1;
+    *rts_argc = 0;
+
+    for (mode = PGM; arg < total_arg && ! strequal("--RTS", argv[arg]); arg++) {
+       if (strequal("+RTS", argv[arg])) {
+           mode = RTS;
+       }
+       else if (strequal("-RTS", argv[arg])) {
+           mode = PGM;
+       }
+       else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
+           rts_argv[(*rts_argc)++] = argv[arg];
+       }
+       else if (mode == PGM) {
+           argv[(*argc)++] = argv[arg];
+       }
+       else {
+           fflush(stdout);
+           fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
+                   MAX_RTS_ARGS-1);
+           EXIT(EXIT_FAILURE);
+       }
+    }
+    if (arg < total_arg) {
+       /* arg must be --RTS; process remaining program arguments */
+       while (++arg < total_arg) {
+           argv[(*argc)++] = argv[arg];
+       }
+    }
+    argv[*argc] = (char *) 0;
+    rts_argv[*rts_argc] = (char *) 0;
+
+    /* Process RTS (rts_argv) part: mainly to determine statsfile */
+
+    for (arg = 0; arg < *rts_argc; arg++) {
+       if (rts_argv[arg][0] != '-') {
+           fflush(stdout);
+           fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
+                   rts_argv[arg]);
+           error = rtsTrue;
+
+        } else {
+           switch(rts_argv[arg][1]) {
+
+             /* process: general args, then PROFILING-only ones,
+                then CONCURRENT-only, PARallel-only, GRAN-only,
+                TICKY-only (same order as defined in RtsFlags.lh);
+                within those groups, mostly in case-insensitive
+                alphabetical order.
+             */
+
+#ifdef TICKY_TICKY
+# define TICKY_BUILD_ONLY(x) x
+#else
+# define TICKY_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: ticky-ticky stats\n"); \
+error = rtsTrue;
+#endif
+
+#if (defined(PROFILING) || defined(PAR))
+# define COST_CENTRE_USING_BUILD_ONLY(x) x
+#else
+# define COST_CENTRE_USING_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -prof or -parallel\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef PROFILING
+# define PROFILING_BUILD_ONLY(x)
+#else
+# define PROFILING_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -prof\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef CONCURRENT
+# define CONCURRENT_BUILD_ONLY(x)
+#else
+# define CONCURRENT_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -concurrent\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef PAR
+# define PAR_BUILD_ONLY(x)
+#else
+# define PAR_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -parallel\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef GRAN
+# define GRAN_BUILD_ONLY(x)
+#else
+# define GRAN_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -gransim\n"); \
+error = rtsTrue;
+#endif
+
+             /* =========== GENERAL ========================== */
+             case '?':
+             case 'f':
+               error = rtsTrue;
+               break;
+
+             case 'A':
+               RTSflags.GcFlags.allocAreaSize
+                 = decode(rts_argv[arg]+2) / sizeof(W_);
+               RTSflags.GcFlags.allocAreaSizeGiven = rtsTrue;
+               break;
+
+             case 'B':
+               RTSflags.GcFlags.ringBell = rtsTrue;
+               break;
+
+             case 'F':
+               if (strequal(rts_argv[arg]+2, "2s")) {
+                   RTSflags.GcFlags.force2s = rtsTrue;
+               } else {
+                   bad_option( rts_argv[arg] );
+               }
+               break;
+
+             case 'G':
+               RTSflags.GcFlags.specifiedOldGenSize
+                 = decode(rts_argv[arg]+2) / sizeof(W_);
+               break;
+
+             case 'K':
+               RTSflags.GcFlags.stksSize = decode(rts_argv[arg]+2) / sizeof(W_);
+
+               if (RTSflags.GcFlags.stksSize == 0) bad_option( rts_argv[arg] );
+               break;
+
+             case 'H':
+               RTSflags.GcFlags.heapSize = decode(rts_argv[arg]+2) / sizeof(W_);
+               /* user give size in *bytes* but "heapSize" is in *words* */
+
+               if (RTSflags.GcFlags.heapSize <= 0) bad_option(rts_argv[arg]);
+               break;
+
+             case 'j': /* force GC option */
+               RTSflags.GcFlags.forceGC = rtsTrue;
+               if (rts_argv[arg][2]) {
+                   RTSflags.GcFlags.forcingInterval
+                       = decode(rts_argv[arg]+2) / sizeof(W_);
+               }
+               break;
+
+             case 'M':
+               RTSflags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
+
+               if (RTSflags.GcFlags.pcFreeHeap < 0 || RTSflags.GcFlags.pcFreeHeap > 100)
+                   bad_option( rts_argv[arg] );
+               break;
+
+             case 'N':
+               RTSflags.GcFlags.lazyBlackHoling = rtsFalse;
+               break;
+
+             case 'n':
+               RTSflags.GcFlags.doSelectorsAtGC = rtsFalse;
+               break;
+
+             case 'S': /* NB: no difference at present ! */
+             case 's':
+               RTSflags.GcFlags.giveStats ++; /* will be VERBOSE_GC_STATS */
+#ifdef PAR
+               /* Opening all those files would almost certainly fail... */
+               RTSflags.ParFlags.parallelStats = rtsTrue;
+               RTSflags.GcFlags.statsFile = stderr; /* temporary; ToDo: rm */
+#else
+               RTSflags.GcFlags.statsFile
+                 = open_stats_file(arg, *argc, argv,
+                       *rts_argc, rts_argv, STAT_FILENAME_FMT);
+
+               if (RTSflags.GcFlags.statsFile == NULL) error = rtsTrue;
+#endif
+               break;
+
+             case 'T':
+               if (rts_argv[arg][2] != '\0')
+                   RTSflags.GcFlags.trace
+                     = (W_) strtol(rts_argv[arg]+2, (char **)NULL, 0);
+               else
+                   RTSflags.GcFlags.trace = 1; /* slightly weird; why, really? */
+               break;
+
+             case 'Z':
+               RTSflags.GcFlags.squeezeUpdFrames = rtsFalse;
+               break;
+
+             /* =========== PROFILING ========================== */
+
+             case 'P': /* detailed cost centre profiling (time/alloc) */
+               COST_CENTRE_USING_BUILD_ONLY(
+               RTSflags.CcFlags.doCostCentres++;
+               )
+             case 'p': /* cost centre profiling (time/alloc) */
+               COST_CENTRE_USING_BUILD_ONLY(
+               { char ch;
+               RTSflags.CcFlags.doCostCentres++;
+
+               for (ch = 2; rts_argv[arg][ch]; ch++) {
+               switch (rts_argv[arg][2]) {
+                 case SORTCC_LABEL:
+                 case SORTCC_TIME:
+                 case SORTCC_ALLOC:
+                       RTSflags.CcFlags.sortBy = rts_argv[arg][ch];
+                   break;
+                 default:
+                   fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]);
+                   error = 1;
+               }}}
+               ) break;
+
+             case 'i': /* serial profiling -- initial timer interval */
+               COST_CENTRE_USING_BUILD_ONLY(
+               interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY));
+               if (interval_ticks <= 0)
+                   interval_ticks = 1;
+               ) break;
+
+             case 'h': /* serial heap profile */
+               PROFILING_BUILD_ONLY(
+               switch (rts_argv[arg][2]) {
+                 case '\0':
+                 case CCchar:
+                   RTSflags.ProfFlags.doHeapProfile = HEAP_BY_CC;
+                   break;
+                 case MODchar:
+                   RTSflags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
+                   break;
+                 case GRPchar:
+                   RTSflags.ProfFlags.doHeapProfile = HEAP_BY_GRP;
+                   break;
+                 case DESCRchar:
+                   RTSflags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
+                   break;
+                 case TYPEchar:
+                   RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
+                   break;
+                 case TIMEchar:
+                   RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TIME;
+                   if (rts_argv[arg][3]) {
+                       char *start_str = strchr(rts_argv[arg]+3, ',');
+                       I_ intervals;
+                       if (start_str) *start_str = '\0';
+
+                       if ((intervals = decode(rts_argv[arg]+3)) != 0) {
+                           time_intervals = (hash_t) intervals;
+                           /* ToDo: and what if it *is* zero intervals??? */
+                       }
+                       if (start_str) {
+                           earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY));
+                       }
+                   }
+                   break;
+                 default:
+                   fprintf(stderr, "Invalid heap profile option: %s\n",
+                           rts_argv[arg]);
+                   error = 1;
+               }
+               ) break;
+
+             case 'z': /* size of index tables */
+               PROFILING_BUILD_ONLY(
+               switch (rts_argv[arg][2]) {
+                 case CCchar:
+                   max_cc_no = (hash_t) decode(rts_argv[arg]+3);
+                   if (max_cc_no == 0) {
+                       fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
+                       error = 1;
+                   }
+                   break;
+                 case MODchar:
+                   max_mod_no = (hash_t) decode(rts_argv[arg]+3);
+                   if (max_mod_no == 0) {
+                       fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
+                       error = 1;
+                   }
+                   break;
+                 case GRPchar:
+                   max_grp_no = (hash_t) decode(rts_argv[arg]+3);
+                   if (max_grp_no == 0) {
+                       fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
+                       error = 1;
+                   }
+                   break;
+                 case DESCRchar:
+                   max_descr_no = (hash_t) decode(rts_argv[arg]+3);
+                   if (max_descr_no == 0) {
+                       fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
+                       error = 1;
+                   }
+                   break;
+                 case TYPEchar:
+                   max_type_no = (hash_t) decode(rts_argv[arg]+3);
+                   if (max_type_no == 0) {
+                       fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
+                       error = 1;
+                   }
+                   break;
+                 default:
+                   fprintf(stderr, "Invalid index table size option: %s\n",
+                           rts_argv[arg]);
+                   error = 1;
+               }
+               ) break;
+
+             case 'c': /* cost centre label select */
+             case 'm': /* cost centre module select */
+             case 'g': /* cost centre group select */
+             case 'd': /* closure descr select */
+             case 'y': /* closure type select */
+             case 'k': /* closure kind select */
+               PROFILING_BUILD_ONLY(
+
+               left  = strchr(rts_argv[arg], '{');
+               right = strrchr(rts_argv[arg], '}');
+               if (! left || ! right ||
+                       strrchr(rts_argv[arg], '{') != left ||
+                        strchr(rts_argv[arg], '}') != right) {
+                   fprintf(stderr, "Invalid heap profiling selection bracketing\n   %s\n", rts_argv[arg]);
+                   error = 1;
+               } else {
+                   *right = '\0';
+                   switch (rts_argv[arg][1]) {
+                     case 'c': /* cost centre label select */
+                       select_cc = left + 1;
+                       break;
+                     case 'm': /* cost centre module select */
+                       select_mod = left + 1;
+                       break;
+                     case 'g': /* cost centre group select */
+                       select_grp = left + 1;
+                       break;
+                     case 'd': /* closure descr select */
+                       select_descr = left + 1;
+                       break;
+                     case 't': /* closure type select */
+                       select_type = left + 1;
+                       break;
+                     case 'k': /* closure kind select */
+                       select_kind = left + 1;
+                       break;
+               }
+               }
+               ) break;
+
+             /* =========== CONCURRENT ========================= */
+             case 'C': /* context switch interval */
+               CONCURRENT_BUILD_ONLY (
+               if (rts_argv[arg][2] == '\0')
+                   RTSflags.ConcFlags.ctxtSwitchTime = 0;
+               else {
+                   I_ cst; /* tmp */
+
+                   /* Convert to milliseconds */
+                   cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
+                   cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
+                   if (cst < CS_MIN_MILLISECS)
+                       cst = CS_MIN_MILLISECS;
+
+                   RTSflags.ConcFlags.ctxtSwitchTime = cst;
+               }
+               ) break;
+
+             case 't':
+               CONCURRENT_BUILD_ONLY(
+               if (rts_argv[arg][2] != '\0') {
+                   RTSflags.ConcFlags.maxThreads
+                     = strtol(rts_argv[arg]+2, (char **) NULL, 10);
+               } else {
+                   fprintf(stderr, "setupRtsFlags: missing size for -t\n");
+                   error = rtsTrue;
+               }
+               ) break;
+
+             case 'o':
+               CONCURRENT_BUILD_ONLY (
+               if (rts_argv[arg][2] != '\0') {
+                   I_ size = decode(rts_argv[arg]+2);
+
+                   if (size < MIN_STKO_CHUNK_SIZE)
+                       size = MIN_STKO_CHUNK_SIZE;
+
+                   RTSflags.ConcFlags.stkChunkSize = size;
+               } else {
+                   fprintf(stderr, "setupRtsFlags: missing size for -o\n");
+                   error = rtsTrue;
+               }
+               ) break;
+
+             /* =========== PARALLEL =========================== */
+             case 'e':
+               CONCURRENT_BUILD_ONLY(
+               if (rts_argv[arg][2] != '\0') { /* otherwise, stick w/ the default */
+
+                   RTSflags.ConcFlags.maxLocalSparks
+                     = strtol(rts_argv[arg]+2, (char **) NULL, 10);
+
+                   if (RTSflags.ConcFlags.maxLocalSparks <= 0) {
+                       fprintf(stderr, "setupRtsFlags: bad value for -e\n");
+                       error = rtsTrue;
+                   }
+               }
+               ) break;
+
+             case 'O':
+               PAR_BUILD_ONLY(
+               RTSflags.ParFlags.outputDisabled = rtsTrue;
+               ) break;
+
+             case 'q': /* activity profile option */
+               PAR_BUILD_ONLY(
+               if (rts_argv[arg][2] == 'b')
+                   RTSflags.ParFlags.granSimStats_Binary = rtsTrue;
+               else
+                   RTSflags.ParFlags.granSimStats = rtsTrue;
+               ) break;
+
+#if 0 /* or??? */
+             case 'q': /* quasi-parallel profile option */
+               GRAN_BUILD_ONLY (
+               if (rts_argv[arg][2] == 'v')
+                   do_qp_prof = 2;
+               else
+                   do_qp_prof++;
+               ) break;
+#endif /* 0??? */
+
+             case 'Q': /* Set pack buffer size */
+               PAR_BUILD_ONLY(
+               if (rts_argv[arg][2] != '\0') {
+                   RTSflags.ParFlags.packBufferSize = decode(rts_argv[arg]+2);
+               } else {
+                   fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n");
+                   error = rtsTrue;
+               }
+               ) break;
+
+             /* =========== GRAN =============================== */
+
+             case 'b':
+               GRAN_BUILD_ONLY(
+               process_gran_option();
+               ) break;
+
+             /* =========== TICKY ============================== */
+
+             case 'r': /* Basic profiling stats */
+               TICKY_BUILD_ONLY(
+
+               RTSflags.TickyFlags.showTickyStats = rtsTrue;
+               RTSflags.TickyFlags.tickyFile
+                 = open_stats_file(arg, *argc, argv,
+                       *rts_argc, rts_argv, TICKY_FILENAME_FMT);
+
+               if (RTSflags.TickyFlags.tickyFile == NULL) error = rtsTrue;
+               ) break;
+
+             /* =========== OH DEAR ============================ */
+             default:
+               fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]);
+               error = rtsTrue;
+               break;
+           }
+       }
+    }
+    if (error) {
+       const char **p;
+
+        fflush(stdout);
+       for (p = usage_text; *p; p++)
+           fprintf(stderr, "%s\n", *p);
+       EXIT(EXIT_FAILURE);
+    }
+
+}
+
+#ifdef GRAN
+static void
+process_gran_option()
+{
+    if (rts_argv[arg][2] != '\0') {
+
+      /* Should we emulate hbcpp */
+      if(strequal((rts_argv[arg]+2),"roken")) {
+       ++DoAlwaysCreateThreads;
+       strcpy(rts_argv[arg]+2,"oring");
+      }
+
+      /* or a ridiculously idealised simulator */
+      if(strequal((rts_argv[arg]+2),"oring")) {
+       gran_latency = gran_fetchtime = gran_additional_latency =
+         gran_gunblocktime = gran_lunblocktime
+           = gran_threadcreatetime = gran_threadqueuetime
+             = gran_threadscheduletime = gran_threaddescheduletime
+               = gran_threadcontextswitchtime
+                 = 0;
+
+       gran_mpacktime = gran_munpacktime = 0;
+
+       gran_arith_cost = gran_float_cost = gran_load_cost
+         = gran_store_cost = gran_branch_cost = 0;
+
+       gran_heapalloc_cost = 1;
+
+       /* ++DoFairSchedule; */
+       ++DoStealThreadsFirst;
+       ++DoThreadMigration;
+       RTSflags.ParFlags.granSimStats = rtsTrue;
+      }
+
+      /* or a ridiculously idealised simulator */
+      if(strequal((rts_argv[arg]+2),"onzo")) {
+       gran_latency = gran_fetchtime = gran_additional_latency =
+         gran_gunblocktime = gran_lunblocktime
+           = gran_threadcreatetime = gran_threadqueuetime
+             = gran_threadscheduletime = gran_threaddescheduletime
+               = gran_threadcontextswitchtime
+                 = 0;
+
+       gran_mpacktime = gran_munpacktime = 0;
+
+       /* Keep default values for these
+       gran_arith_cost = gran_float_cost = gran_load_cost
+         = gran_store_cost = gran_branch_cost = 0;
+         */
+
+       gran_heapalloc_cost = 1;
+
+       /* ++DoFairSchedule; */       /* -b-R */
+       /* ++DoStealThreadsFirst; */  /* -b-T */
+       ++DoReScheduleOnFetch;        /* -bZ */
+       ++DoThreadMigration;          /* -bM */
+       RTSflags.ParFlags.granSimStats = rtsTrue; /* -bP */
+#   if defined(GRAN_CHECK) && defined(GRAN)
+       debug = 0x20;       /* print event statistics   */
+#   endif
+      }
+
+      /* Communication and task creation cost parameters */
+      else switch(rts_argv[arg][2]) {
+       case 'l':
+         if (rts_argv[arg][3] != '\0')
+           {
+             gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
+             gran_fetchtime = 2* gran_latency;
+           }
+         else
+           gran_latency = LATENCY;
+         break;
+
+       case 'a':
+         if (rts_argv[arg][3] != '\0')
+           gran_additional_latency = decode(rts_argv[arg]+3);
+         else
+           gran_additional_latency = ADDITIONAL_LATENCY;
+         break;
+
+       case 'm':
+         if (rts_argv[arg][3] != '\0')
+           gran_mpacktime = decode(rts_argv[arg]+3);
+         else
+           gran_mpacktime = MSGPACKTIME;
+         break;
+
+       case 'x':
+         if (rts_argv[arg][3] != '\0')
+           gran_mtidytime = decode(rts_argv[arg]+3);
+         else
+           gran_mtidytime = 0;
+         break;
+
+       case 'r':
+         if (rts_argv[arg][3] != '\0')
+           gran_munpacktime = decode(rts_argv[arg]+3);
+         else
+           gran_munpacktime = MSGUNPACKTIME;
+         break;
+
+       case 'f':
+         if (rts_argv[arg][3] != '\0')
+           gran_fetchtime = decode(rts_argv[arg]+3);
+         else
+           gran_fetchtime = FETCHTIME;
+         break;
+
+       case 'n':
+         if (rts_argv[arg][3] != '\0')
+           gran_gunblocktime = decode(rts_argv[arg]+3);
+         else
+           gran_gunblocktime = GLOBALUNBLOCKTIME;
+         break;
+
+       case 'u':
+         if (rts_argv[arg][3] != '\0')
+           gran_lunblocktime = decode(rts_argv[arg]+3);
+         else
+           gran_lunblocktime = LOCALUNBLOCKTIME;
+         break;
+
+       /* Thread-related metrics */
+       case 't':
+         if (rts_argv[arg][3] != '\0')
+           gran_threadcreatetime = decode(rts_argv[arg]+3);
+         else
+           gran_threadcreatetime = THREADCREATETIME;
+         break;
+
+       case 'q':
+         if (rts_argv[arg][3] != '\0')
+           gran_threadqueuetime = decode(rts_argv[arg]+3);
+         else
+           gran_threadqueuetime = THREADQUEUETIME;
+         break;
+
+       case 'c':
+         if (rts_argv[arg][3] != '\0')
+           gran_threadscheduletime = decode(rts_argv[arg]+3);
+         else
+           gran_threadscheduletime = THREADSCHEDULETIME;
+
+         gran_threadcontextswitchtime = gran_threadscheduletime
+                                      + gran_threaddescheduletime;
+         break;
+
+       case 'd':
+         if (rts_argv[arg][3] != '\0')
+           gran_threaddescheduletime = decode(rts_argv[arg]+3);
+         else
+           gran_threaddescheduletime = THREADDESCHEDULETIME;
+
+         gran_threadcontextswitchtime = gran_threadscheduletime
+                                      + gran_threaddescheduletime;
+         break;
+
+       /* Instruction Cost Metrics */
+       case 'A':
+         if (rts_argv[arg][3] != '\0')
+           gran_arith_cost = decode(rts_argv[arg]+3);
+         else
+           gran_arith_cost = ARITH_COST;
+         break;
+
+       case 'F':
+         if (rts_argv[arg][3] != '\0')
+           gran_float_cost = decode(rts_argv[arg]+3);
+         else
+           gran_float_cost = FLOAT_COST;
+         break;
+
+       case 'B':
+         if (rts_argv[arg][3] != '\0')
+           gran_branch_cost = decode(rts_argv[arg]+3);
+         else
+           gran_branch_cost = BRANCH_COST;
+         break;
+
+       case 'L':
+         if (rts_argv[arg][3] != '\0')
+           gran_load_cost = decode(rts_argv[arg]+3);
+         else
+           gran_load_cost = LOAD_COST;
+         break;
+
+       case 'S':
+         if (rts_argv[arg][3] != '\0')
+           gran_store_cost = decode(rts_argv[arg]+3);
+         else
+           gran_store_cost = STORE_COST;
+         break;
+
+       case 'H':
+         if (rts_argv[arg][3] != '\0')
+           gran_heapalloc_cost = decode(rts_argv[arg]+3);
+         else
+           gran_heapalloc_cost = 0;
+         break;
+
+       case 'y':
+         if (rts_argv[arg][3] != '\0')
+           FetchStrategy = decode(rts_argv[arg]+3);
+         else
+           FetchStrategy = 4; /* default: fetch everything */
+         break;
+
+       /* General Parameters */
+       case 'p':
+         if (rts_argv[arg][3] != '\0')
+           {
+             max_proc = decode(rts_argv[arg]+3);
+             if(max_proc > MAX_PROC || max_proc < 1)
+               {
+                 fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
+                 error = rtsTrue;
+               }
+           }
+         else
+           max_proc = MAX_PROC;
+         break;
+
+       case 'C':
+         ++DoAlwaysCreateThreads;
+         ++DoThreadMigration;
+         break;
+
+       case 'G':
+         ++DoGUMMFetching;
+         break;
+
+       case 'M':
+         ++DoThreadMigration;
+         break;
+
+       case 'R':
+         ++DoFairSchedule;
+         break;
+
+       case 'T':
+         ++DoStealThreadsFirst;
+         ++DoThreadMigration;
+         break;
+
+       case 'Z':
+         ++DoReScheduleOnFetch;
+         break;
+
+       case 'z':
+         ++SimplifiedFetch;
+         break;
+
+       case 'N':
+         ++PreferSparksOfLocalNodes;
+         break;
+
+       case 'b':
+         RTSflags.ParFlags.granSimStats_Binary = rtsTrue;
+         break;
+
+       case 'P':
+         RTSflags.ParFlags.granSimStats = rtsTrue;
+         break;
+
+       case 's':
+         ++do_sp_profile;
+         break;
+
+       case '-':
+         switch(rts_argv[arg][3]) {
+
+          case 'C':
+            DoAlwaysCreateThreads=0;
+            DoThreadMigration=0;
+            break;
+
+          case 'G':
+            DoGUMMFetching=0;
+            break;
+
+          case 'M':
+            DoThreadMigration=0;
+            break;
+
+           case 'R':
+            DoFairSchedule=0;
+            break;
+
+          case 'T':
+            DoStealThreadsFirst=0;
+            DoThreadMigration=0;
+            break;
+
+          case 'Z':
+            DoReScheduleOnFetch=0;
+            break;
+
+          case 'N':
+            PreferSparksOfLocalNodes=0;
+            break;
+
+          case 'P':
+            RTSflags.ParFlags.granSimStats = rtsFalse;
+            no_gr_profile=1;
+            break;
+
+          case 's':
+            do_sp_profile=0;
+            break;
+
+          case 'b':
+            RTSflags.ParFlags.granSimStats_Binary = rtsFalse;
+            break;
+
+          default:
+            bad_option( rts_argv[arg] );
+            break;
+          }
+         break;
+
+#   if defined(GRAN_CHECK) && defined(GRAN)
+       case 'D':
+         switch(rts_argv[arg][3]) {
+             case 'e':       /* event trace */
+               fprintf(stderr,"Printing event trace.\n");
+               ++event_trace;
+               break;
+
+             case 'f':
+               fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
+               debug |= 0x2; /* print fwd messages */
+               break;
+
+             case 'z':
+               fprintf(stderr,"Check for blocked on fetch.\n");
+               debug |= 0x4; /* debug non-reschedule-on-fetch */
+               break;
+
+             case 't':
+               fprintf(stderr,"Check for TSO asleep on fetch.\n");
+               debug |= 0x10; /* debug TSO asleep for fetch  */
+               break;
+
+             case 'E':
+               fprintf(stderr,"Printing event statistics.\n");
+               debug |= 0x20; /* print event statistics   */
+               break;
+
+             case 'F':
+               fprintf(stderr,"Prohibiting forward.\n");
+               NoForward = 1; /* prohibit forwarding   */
+               break;
+
+             case 'm':
+               fprintf(stderr,"Printing fetch misses.\n");
+               PrintFetchMisses = 1; /* prohibit forwarding   */
+               break;
+
+             case 'd':
+               fprintf(stderr,"Debug mode.\n");
+               debug |= 0x40; 
+               break;
+
+             case 'D':
+               fprintf(stderr,"Severe debug mode.\n");
+               debug |= 0x80; 
+               break;
+
+             case '\0':
+               debug = 1;
+               break;
+
+             default:
+               bad_option( rts_argv[arg] );
+               break;
+             }
+         break;
+#   endif
+       default:
+         bad_option( rts_argv[arg] );
+         break;
+       }
+    }
+    do_gr_sim++;
+    RTSflags.ConcFlags.ctxtSwitchTime = 0;
+}
+#endif /* GRAN */
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Profiling RTS Arguments}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+I_ MaxResidency = 0;     /* in words; for stats only */
+I_ ResidencySamples = 0; /* for stats only */
+
+void
+initSM(void)
+{
+    RTSflags.GcFlags.minAllocAreaSize
+      = (I_) (RTSflags.GcFlags.heapSize * RTSflags.GcFlags.pcFreeHeap / 100);
+    /*
+       This needs to be here, in case the user changed some of these
+       values with a "hook".
+    */
+}
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Utility bits}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+static FILE *          /* return NULL on error */
+open_stats_file (
+    I_ arg,
+    int argc, char *argv[],
+    int rts_argc, char *rts_argv[],
+    const char *FILENAME_FMT)
+{
+    FILE *f = NULL;
+
+    if (strequal(rts_argv[arg]+2, "stderr")) /* use real stderr */
+       f = stderr;
+    else if (rts_argv[arg][2] != '\0')     /* stats file specified */
+       f = fopen(rts_argv[arg]+2,"w");
+    else {
+       char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
+       sprintf(stats_filename, FILENAME_FMT, argv[0]);
+       f = fopen(stats_filename,"w");
+    }
+    if (f == NULL) {
+       fprintf(stderr, "Can't open stats file %s\n", rts_argv[arg]+2);
+    } else {
+       /* Write argv and rtsv into start of stats file */
+       I_ count;
+       for(count = 0; count < argc; count++)
+           fprintf(f, "%s ", argv[count]);
+       fprintf(f, "+RTS ");
+       for(count = 0; count < rts_argc; count++)
+           fprintf(f, "%s ", rts_argv[count]);
+       fprintf(f, "\n");
+    }
+
+    return(f);
+}
+
+static I_
+decode(const char *s)
+{
+    I_ c;
+    StgDouble m;
+
+    if (!*s)
+       return 0;
+
+    m = atof(s);
+    c = s[strlen(s)-1];
+
+    if (c == 'g' || c == 'G')
+       m *= 1000*1000*1000;    /* UNchecked! */
+    else if (c == 'm' || c == 'M')
+       m *= 1000*1000;                 /* We do not use powers of 2 (1024) */
+    else if (c == 'k' || c == 'K')     /* to avoid possible bad effects on */
+       m *= 1000;                      /* a direct-mapped cache.           */ 
+    else if (c == 'w' || c == 'W')
+       m *= sizeof(W_);
+
+    return (I_)m;
+}
+
+static void
+bad_option(const char *s)
+{
+  fflush(stdout);
+  fprintf(stderr, "initSM: Bad RTS option: %s\n", s);
+  EXIT(EXIT_FAILURE);
+}              
+\end{code}
index 1f10c7a..4fdcaa4 100644 (file)
 # endif
 
 void
 # endif
 
 void
-AwaitEvent(delta)
-I_ delta;
+AwaitEvent(I_ delta)
 {
     P_ tso, prev, next;
     rtsBool ready;
     fd_set rfd;
     I_ us;
     I_ min;
 {
     P_ tso, prev, next;
     rtsBool ready;
     fd_set rfd;
     I_ us;
     I_ min;
+    I_ maxfd=0;
     struct timeval tv;
 
     min = delta == 0 ? 0x7fffffff : 0;
     struct timeval tv;
 
     min = delta == 0 ? 0x7fffffff : 0;
@@ -42,6 +42,9 @@ I_ delta;
     /* 
      * Collect all of the fd's that we're interested in, and capture
      * the minimum waiting time for the delayed threads.
     /* 
      * Collect all of the fd's that we're interested in, and capture
      * the minimum waiting time for the delayed threads.
+     *
+     * (I_)TSO_EVENT(tso) < 0 => thread waiting on fd (-(I_)TSO_EVENT(tso))
+     *
      */
     FD_ZERO(&rfd);
     for(tso = WaitingThreadsHd; tso != Nil_closure; tso = TSO_LINK(tso)) {
      */
     FD_ZERO(&rfd);
     for(tso = WaitingThreadsHd; tso != Nil_closure; tso = TSO_LINK(tso)) {
@@ -52,6 +55,7 @@ I_ delta;
                min = us;
        } else {
            /* Looking at a wait event */
                min = us;
        } else {
            /* Looking at a wait event */
+           maxfd = ((-us)> maxfd) ? (-us) : maxfd;
            FD_SET((-us), &rfd);
        }
     }
            FD_SET((-us), &rfd);
        }
     }
@@ -61,16 +65,16 @@ I_ delta;
     tv.tv_sec = min / 1000000;
     tv.tv_usec = min % 1000000;
 
     tv.tv_sec = min / 1000000;
     tv.tv_usec = min % 1000000;
 
-    while (select(FD_SETSIZE, &rfd, NULL, NULL, &tv) < 0) {
+    while (select((maxfd==0 ? 0 : (maxfd+1)), &rfd, NULL, NULL, &tv) < 0) {
        if (errno != EINTR) {
            fflush(stdout);
            fprintf(stderr, "AwaitEvent: select failed\n");
            EXIT(EXIT_FAILURE);
        }
     }  
        if (errno != EINTR) {
            fflush(stdout);
            fprintf(stderr, "AwaitEvent: select failed\n");
            EXIT(EXIT_FAILURE);
        }
     }  
-
     if (delta == 0)
     if (delta == 0)
-       delta = min;
+       delta=min;
 
     prev = NULL;
     for(tso = WaitingThreadsHd; tso != Nil_closure; tso = next) {
 
     prev = NULL;
     for(tso = WaitingThreadsHd; tso != Nil_closure; tso = next) {
index 3796f99..af2738e 100644 (file)
@@ -19,7 +19,6 @@ Since they're pretty rudimentary, they shouldn't actually cause as
 much pain.
 
 \begin{code}
 much pain.
 
 \begin{code}
-
 #include "platform.h"
 
 #if defined(sunos4_TARGET_OS)
 #include "platform.h"
 
 #if defined(sunos4_TARGET_OS)
@@ -32,9 +31,10 @@ much pain.
 # define _OSF_SOURCE 1
 #endif
 
 # define _OSF_SOURCE 1
 #endif
 
-#if defined(linuxaout_TARGET_OS) || defined(linux_TARGET_OS)
-    /* I have no idea why this works (WDP 95/03) */
-# define _BSD_SOURCE 1
+#if irix_TARGET_OS
+/* SIGVTALRM not avail w/ POSIX_SOURCE, but worse things happen without */
+/* SIGH: triple SIGH (WDP 95/07) */
+# define SIGVTALRM 28
 #endif
 
 #include "rtsdefs.h"
 #endif
 
 #include "rtsdefs.h"
@@ -46,11 +46,6 @@ much pain.
 #if defined(HAVE_SIGNAL_H)
 # include <signal.h>
 #endif
 #if defined(HAVE_SIGNAL_H)
 # include <signal.h>
 #endif
-#if irix_TARGET_OS
-/* SIGVTALRM not avail w/ POSIX_SOURCE, but worse things happen without */
-/* SIGH: triple SIGH (WDP 95/07) */
-# define SIGVTALRM 28
-#endif
 
 #if defined(HAVE_SIGINFO_H)
     /* DEC OSF1 seems to need this explicitly.  Maybe others do as well? */
 
 #if defined(HAVE_SIGINFO_H)
     /* DEC OSF1 seems to need this explicitly.  Maybe others do as well? */
@@ -72,12 +67,9 @@ that it really was a stack overflow and not some random segmentation
 fault.
 
 \begin{code}
 fault.
 
 \begin{code}
-
 #if STACK_CHECK_BY_PAGE_FAULT
 
 extern P_ stks_space;      /* Where the stacks live, from SMstacks.lc */
 #if STACK_CHECK_BY_PAGE_FAULT
 
 extern P_ stks_space;      /* Where the stacks live, from SMstacks.lc */
-extern I_ SM_word_stk_size; /* How big they are (ditto) */
-
 \end{code}
 
 SunOS 4.x is too old to have @SA_SIGINFO@ as a flag to @sigaction@, so
 \end{code}
 
 SunOS 4.x is too old to have @SA_SIGINFO@ as a flag to @sigaction@, so
@@ -86,20 +78,19 @@ to set up the handler to expect a different collection of arguments.
 Fun, eh?
 
 \begin{code}
 Fun, eh?
 
 \begin{code}
-
-# if defined(sunos4_TARGET_OS) || defined(linuxaout_TARGET_OS) || defined(linux_TARGET_OS)
+# if defined(sunos4_TARGET_OS)
 
 static void
 segv_handler(sig, code, scp, addr)
   int sig;
 
 static void
 segv_handler(sig, code, scp, addr)
   int sig;
-  int code;
+  int code; /* NB: all except first argument are "implementation defined" */
   struct sigcontext *scp;
   caddr_t addr;
 {
     extern void StackOverflow(STG_NO_ARGS) STG_NORETURN;
 
     if (addr >= (caddr_t) stks_space
   struct sigcontext *scp;
   caddr_t addr;
 {
     extern void StackOverflow(STG_NO_ARGS) STG_NORETURN;
 
     if (addr >= (caddr_t) stks_space
-      && addr < (caddr_t) (stks_space + SM_word_stk_size))
+      && addr < (caddr_t) (stks_space + RTSflags.GcFlags.stksSize))
        StackOverflow();
 
     fflush(stdout);
        StackOverflow();
 
     fflush(stdout);
@@ -108,9 +99,12 @@ segv_handler(sig, code, scp, addr)
 }
 
 int
 }
 
 int
-install_segv_handler()
+install_segv_handler(void)
 {
 {
-    return (int) signal(SIGSEGV, segv_handler) == -1;
+    return ((int) signal(SIGSEGV, segv_handler) == SIG_ERR);
+    /* I think the "== SIG_ERR" is saying "there was no
+       handler for SIGSEGV before this one".  WDP 95/12
+    */
 }
 
 # else /* Not SunOS 4 */
 }
 
 # else /* Not SunOS 4 */
@@ -121,16 +115,15 @@ install_segv_handler()
 #  endif
 
 static void
 #  endif
 
 static void
-segv_handler(sig, sip)
-  int sig;
-  siginfo_t *sip;
+segv_handler(int sig, siginfo_t *sip)
+  /* NB: the second "siginfo_t" argument is not really standard */
 {
     fflush(stdout);
     if (sip == NULL) {
        fprintf(stderr, "Segmentation fault caught, address unknown\n");
     } else {
        if (sip->si_addr >= (caddr_t) stks_space
 {
     fflush(stdout);
     if (sip == NULL) {
        fprintf(stderr, "Segmentation fault caught, address unknown\n");
     } else {
        if (sip->si_addr >= (caddr_t) stks_space
-         && sip->si_addr < (caddr_t) (stks_space + SM_word_stk_size))
+         && sip->si_addr < (caddr_t) (stks_space + RTSflags.GcFlags.stksSize))
            StackOverflow();
 
        fprintf(stderr, "Segmentation fault caught, address = %08lx\n", (W_) sip->si_addr);
            StackOverflow();
 
        fprintf(stderr, "Segmentation fault caught, address = %08lx\n", (W_) sip->si_addr);
@@ -139,13 +132,14 @@ segv_handler(sig, sip)
 }
 
 int
 }
 
 int
-install_segv_handler()
+install_segv_handler(STG_NO_ARGS)
 {
     struct sigaction action;
 
     action.sa_handler = segv_handler;
     sigemptyset(&action.sa_mask);
     action.sa_flags = SA_SIGINFO;
 {
     struct sigaction action;
 
     action.sa_handler = segv_handler;
     sigemptyset(&action.sa_mask);
     action.sa_flags = SA_SIGINFO;
+
     return sigaction(SIGSEGV, &action, NULL);
 }
 
     return sigaction(SIGSEGV, &action, NULL);
 }
 
@@ -167,27 +161,16 @@ the non-POSIX signal under SunOS 4.1.X, we adopt the same approach
 here.
 
 \begin{code}
 here.
 
 \begin{code}
-#if (defined(USE_COST_CENTRES) || defined(CONCURRENT)) && !defined(GRAN)
-
-# if defined(USE_COST_CENTRES)
-extern I_ heap_profiling_req;
-# endif
+#if (defined(PROFILING) || defined(CONCURRENT)) && !defined(GRAN)
 
 # ifdef CONCURRENT
 
 
 # ifdef CONCURRENT
 
-#  if defined(USE_COST_CENTRES) || defined(GUM)
-I_ contextSwitchTicks;
-I_ profilerTicks;
-#  endif
-  
 #  ifdef PAR
 extern P_ CurrentTSO;
 #  endif
 #  ifdef PAR
 extern P_ CurrentTSO;
 #  endif
-extern I_ contextSwitchTime;
 
 static void
 
 static void
-vtalrm_handler(sig)
-  int sig;
+vtalrm_handler(int sig)
 {
 /*
    For the parallel world, currentTSO is set if there is any work
 {
 /*
    For the parallel world, currentTSO is set if there is any work
@@ -195,38 +178,41 @@ vtalrm_handler(sig)
    in case other PEs have sent us messages which must be processed.
 */
 
    in case other PEs have sent us messages which must be processed.
 */
 
-#  if defined(USE_COST_CENTRES) || defined(GUM)
+#  if defined(PROFILING) || defined(PAR)
     static I_ csTicks = 0, pTicks = 0;
 
     if (time_profiling) {
     static I_ csTicks = 0, pTicks = 0;
 
     if (time_profiling) {
-       if (++pTicks % profilerTicks == 0) {
-#   if ! defined(USE_COST_CENTRES)
+       if (++pTicks % RTSflags.CcFlags.profilerTicks == 0) {
+#   if ! defined(PROFILING)
            handle_tick_serial();
 #   else
            handle_tick_serial();
 #   else
-           if (cc_profiling > 1 || heap_profiling_req != HEAP_NO_PROFILING)
+           if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
+            || RTSflags.ProfFlags.doHeapProfile)
                handle_tick_serial();
            else
                handle_tick_noserial();
 #   endif
        }
                handle_tick_serial();
            else
                handle_tick_noserial();
 #   endif
        }
-       if (++csTicks % contextSwitchTicks != 0)
+       if (++csTicks % RTSflags.CcFlags.ctxtSwitchTicks != 0)
            return;
     }
 #  endif
 
     if (WaitingThreadsHd != Nil_closure)
            return;
     }
 #  endif
 
     if (WaitingThreadsHd != Nil_closure)
-       AwaitEvent(contextSwitchTime);
+       AwaitEvent(RTSflags.ConcFlags.ctxtSwitchTime);
 
 #  ifdef PAR
     if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL] ||
       PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) {
        PruneSparks();
 
 #  ifdef PAR
     if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL] ||
       PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) {
        PruneSparks();
-       if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL])
+       if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL]) 
            PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] +
              SparkLimit[REQUIRED_POOL] / 2;
            PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] +
              SparkLimit[REQUIRED_POOL] / 2;
-       if (PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL])
+       if (PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) {
            PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] +
              SparkLimit[ADVISORY_POOL] / 2;
            PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] +
              SparkLimit[ADVISORY_POOL] / 2;
+            sparksIgnored += SparkLimit[REQUIRED_POOL] / 2; 
+        }
     }
 
     if (CurrentTSO != NULL ||
     }
 
     if (CurrentTSO != NULL ||
@@ -242,22 +228,23 @@ vtalrm_handler(sig)
 
 # endif
 
 
 # endif
 
-# if defined(sunos4_TARGET_OS) || defined(linuxaout_TARGET_OS) || defined(linux_TARGET_OS)
+# if defined(sunos4_TARGET_OS)
 
 int
 
 int
-install_vtalrm_handler()
+install_vtalrm_handler(void)
 {
     void (*old)();
 
 #  ifdef CONCURRENT
     old = signal(SIGVTALRM, vtalrm_handler);
 #  else
 {
     void (*old)();
 
 #  ifdef CONCURRENT
     old = signal(SIGVTALRM, vtalrm_handler);
 #  else
-    if (cc_profiling > 1 || heap_profiling_req != HEAP_NO_PROFILING)
+    if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
+     || RTSflags.ProfFlags.doHeapProfile)
         old = signal(SIGVTALRM, handle_tick_serial);
     else
         old = signal(SIGVTALRM, handle_tick_noserial);
 #  endif
         old = signal(SIGVTALRM, handle_tick_serial);
     else
         old = signal(SIGVTALRM, handle_tick_noserial);
 #  endif
-    return (int) old == -1;
+    return ((int) old == SIG_ERR);
 }
 
 static int vtalrm_mask;
 }
 
 static int vtalrm_mask;
@@ -284,7 +271,8 @@ install_vtalrm_handler(STG_NO_ARGS)
 #  ifdef CONCURRENT
     action.sa_handler = vtalrm_handler;
 #  else
 #  ifdef CONCURRENT
     action.sa_handler = vtalrm_handler;
 #  else
-    if (cc_profiling > 1 || heap_profiling_req != HEAP_NO_PROFILING)
+    if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
+     || RTSflags.ProfFlags.doHeapProfile)
        action.sa_handler = handle_tick_serial;
     else
        action.sa_handler = handle_tick_noserial;
        action.sa_handler = handle_tick_serial;
     else
        action.sa_handler = handle_tick_noserial;
@@ -318,9 +306,9 @@ unblockVtAlrmSignal(STG_NO_ARGS)
     (void) sigprocmask(SIG_UNBLOCK, &signals, NULL);
 }
 
     (void) sigprocmask(SIG_UNBLOCK, &signals, NULL);
 }
 
-# endif /* SunOS 4 */
+# endif /* ! SunOS 4 */
 
 
-#endif /* USE_COST_CENTRES || CONCURRENT (but not GRAN) */
+#endif /* PROFILING || CONCURRENT (but not GRAN) */
 
 \end{code}
 
 
 \end{code}
 
@@ -333,13 +321,13 @@ parallel world.  Sorry.
 #ifdef PAR
 
 void
 #ifdef PAR
 
 void
-blockUserSignals()
+blockUserSignals(void)
 {
     return;
 }
 
 void
 {
     return;
 }
 
 void
-unblockUserSignals()
+unblockUserSignals(void)
 {
     return;
 }
 {
     return;
 }
@@ -371,8 +359,7 @@ static I_ *handlers = NULL; /* Dynamically grown array of signal handlers */
 static I_ nHandlers = 0;    /* Size of handlers array */
 
 static void
 static I_ nHandlers = 0;    /* Size of handlers array */
 
 static void
-more_handlers(sig)
-  I_ sig;
+more_handlers(I_ sig)
 {
     I_ i;
 
 {
     I_ i;
 
@@ -386,7 +373,7 @@ more_handlers(sig)
 
     if (handlers == NULL) {
        fflush(stdout);
 
     if (handlers == NULL) {
        fflush(stdout);
-       fprintf(stderr, "VM exhausted\n");
+       fprintf(stderr, "VM exhausted (in more_handlers)\n");
        EXIT(EXIT_FAILURE);
     }
     for(i = nHandlers; i <= sig; i++)
        EXIT(EXIT_FAILURE);
     }
     for(i = nHandlers; i <= sig; i++)
@@ -399,12 +386,12 @@ more_handlers(sig)
 # ifdef _POSIX_SOURCE
 
 static void
 # ifdef _POSIX_SOURCE
 
 static void
-generic_handler(sig)
+generic_handler(int sig)
 {
     sigset_t signals;
 
     SAVE_Hp = SAVE_HpLim;      /* Just to be safe */
 {
     sigset_t signals;
 
     SAVE_Hp = SAVE_HpLim;      /* Just to be safe */
-    if (initStacks(&StorageMgrInfo) != 0) {
+    if (! initStacks(&StorageMgrInfo)) {
        fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
        EXIT(EXIT_FAILURE);
        fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
        EXIT(EXIT_FAILURE);
@@ -420,19 +407,19 @@ static sigset_t userSignals;
 static sigset_t savedSignals;
 
 void
 static sigset_t savedSignals;
 
 void
-initUserSignals()
+initUserSignals(void)
 {
     sigemptyset(&userSignals);
 }
 
 void
 {
     sigemptyset(&userSignals);
 }
 
 void
-blockUserSignals()
+blockUserSignals(void)
 {
     sigprocmask(SIG_SETMASK, &userSignals, &savedSignals);
 }
 
 void
 {
     sigprocmask(SIG_SETMASK, &userSignals, &savedSignals);
 }
 
 void
-unblockUserSignals()
+unblockUserSignals(void)
 {
     sigprocmask(SIG_SETMASK, &savedSignals, NULL);
 }
 {
     sigprocmask(SIG_SETMASK, &savedSignals, NULL);
 }
@@ -485,6 +472,7 @@ sig_install(sig, spi, mask)
        sigemptyset(&action.sa_mask);
 
     action.sa_flags = sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
        sigemptyset(&action.sa_mask);
 
     action.sa_flags = sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
+
     if (sigaction(sig, &action, NULL) || sigprocmask(SIG_UNBLOCK, &signals, NULL)) {
        if (previous_spi)
          freeStablePointer(handlers[sig]);
     if (sigaction(sig, &action, NULL) || sigprocmask(SIG_UNBLOCK, &signals, NULL)) {
        if (previous_spi)
          freeStablePointer(handlers[sig]);
@@ -500,7 +488,7 @@ static void
 generic_handler(sig)
 {
     SAVE_Hp = SAVE_HpLim;      /* Just to be safe */
 generic_handler(sig)
 {
     SAVE_Hp = SAVE_HpLim;      /* Just to be safe */
-    if (initStacks(&StorageMgrInfo) != 0) {
+    if (! initStacks(&StorageMgrInfo)) {
        fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
        EXIT(EXIT_FAILURE);
        fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
        EXIT(EXIT_FAILURE);
@@ -514,19 +502,19 @@ static int userSignals;
 static int savedSignals;
 
 void
 static int savedSignals;
 
 void
-initUserSignals()
+initUserSignals(void)
 {
     userSignals = 0;
 }
 
 void
 {
     userSignals = 0;
 }
 
 void
-blockUserSignals()
+blockUserSignals(void)
 {
     savedSignals = sigsetmask(userSignals);
 }
 
 void
 {
     savedSignals = sigsetmask(userSignals);
 }
 
 void
-unblockUserSignals()
+unblockUserSignals(void)
 {
     sigsetmask(savedSignals);
 }
 {
     sigsetmask(savedSignals);
 }
@@ -538,7 +526,7 @@ sig_install(sig, spi)
 {
     I_ previous_spi;
     int mask;
 {
     I_ previous_spi;
     int mask;
-    void (*handler)();
+    void (*handler)(int);
 
     /* Block the signal until we figure out what to do */
     /* Count on this to fail if the signal number is invalid */
 
     /* Block the signal until we figure out what to do */
     /* Count on this to fail if the signal number is invalid */
@@ -581,7 +569,7 @@ sig_install(sig, spi)
     return previous_spi;
 }
 
     return previous_spi;
 }
 
-# endif    /* POSIX */
+# endif    /* !POSIX */
 
 #endif /* PAR */
 
 
 #endif /* PAR */
 
index 720f243..aac16e5 100644 (file)
@@ -10,8 +10,7 @@
 
 #include "rtsdefs.h"
 
 
 #include "rtsdefs.h"
 
-extern void PrintRednCountInfo(STG_NO_ARGS);
-extern I_   showRednCountStats;
+void PrintTickyInfo(STG_NO_ARGS);
 
 #ifdef __DO_ARITY_CHKS__
 I_ ExpectedArity;
 
 #ifdef __DO_ARITY_CHKS__
 I_ ExpectedArity;
@@ -24,10 +23,8 @@ ArityError(n)
     fprintf(stderr, "Arity error: called with %ld args, should have been %ld\n",
                ExpectedArity, n);
 
     fprintf(stderr, "Arity error: called with %ld args, should have been %ld\n",
                ExpectedArity, n);
 
-#if defined(DO_REDN_COUNTING)
-    if (showRednCountStats) {
-       PrintRednCountInfo();
-    }
+#if defined(TICKY_TICKY)
+    if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
 
     EXIT(EXIT_FAILURE);
 #endif
 
     EXIT(EXIT_FAILURE);
@@ -49,12 +46,10 @@ void
 StackOverflow(STG_NO_ARGS)
 {
     fflush(stdout);
 StackOverflow(STG_NO_ARGS)
 {
     fflush(stdout);
-    StackOverflowHook(SM_word_stk_size * sizeof(W_)); /*msg*/
+    StackOverflowHook(RTSflags.GcFlags.stksSize * sizeof(W_)); /*msg*/
 
 
-#if defined(DO_REDN_COUNTING)
-    if (showRednCountStats) {
-       PrintRednCountInfo();
-    }
+#if defined(TICKY_TICKY)
+    if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
 
     EXIT(EXIT_FAILURE);
 #endif
 
     EXIT(EXIT_FAILURE);
@@ -72,9 +67,6 @@ Code for squeezing out vacuous update frames.  Updatees of squeezed frames
 are turned into indirections to the common black hole (or blocking queue).
 
 \begin{code}
 are turned into indirections to the common black hole (or blocking queue).
 
 \begin{code}
-
-I_ squeeze_upd_frames = 1; /* now ON by default */
-
 I_
 SqueezeUpdateFrames(bottom, top, frame)
 P_ bottom;
 I_
 SqueezeUpdateFrames(bottom, top, frame)
 P_ bottom;
@@ -93,8 +85,8 @@ P_ frame;
        return 0;
 
     if ((prev_frame = GRAB_SuB(frame)) <= bottom) {
        return 0;
 
     if ((prev_frame = GRAB_SuB(frame)) <= bottom) {
-#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
-        if (!noBlackHoles)
+#if !defined(CONCURRENT)
+        if ( RTSflags.GcFlags.lazyBlackHoling )
            UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
        return 0;
            UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
        return 0;
@@ -115,30 +107,31 @@ P_ frame;
     }
 
     /*
     }
 
     /*
-     * Now, we're at the bottom.  Frame points to the lowest update frame on the
-     * stack, and its saved SuB actually points to the frame above. We have to walk
-     * back up the stack, squeezing out empty update frames and turning the pointers
-     * back around on the way back up.
+     * Now, we're at the bottom.  Frame points to the lowest update
+     * frame on the stack, and its saved SuB actually points to the
+     * frame above. We have to walk back up the stack, squeezing out
+     * empty update frames and turning the pointers back around on the
+     * way back up.
      */
 
     /*
      */
 
     /*
-     * The bottom-most frame has not been altered, and we never want to eliminate it
-     * anyway.  Just black hole the updatee and walk one step up
-     * before starting to squeeze. When you get to the topmost frame,
-     * remember that there are still some words above it that might
-     * have to be moved.
+     * The bottom-most frame has not been altered, and we never want
+     * to eliminate it anyway.  Just black hole the updatee and walk
+     * one step up before starting to squeeze. When you get to the
+     * topmost frame, remember that there are still some words above
+     * it that might have to be moved.
      */
 
      */
 
-#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
-    if (!noBlackHoles)
+#if !defined(CONCURRENT)
+    if ( RTSflags.GcFlags.lazyBlackHoling )
        UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
     prev_frame = frame;
     frame = next_frame;
 
     /* 
        UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
     prev_frame = frame;
     frame = next_frame;
 
     /* 
-     * Loop through all of the middle frames (everything except the very 
-     * bottom and the very top).
+     * Loop through all of the middle frames (everything except the
+     * very bottom and the very top).
      */
     while ((next_frame = GRAB_SuB(frame)) != NULL) {
        P_ sp;
      */
     while ((next_frame = GRAB_SuB(frame)) != NULL) {
        P_ sp;
@@ -155,7 +148,7 @@ P_ frame;
            /*
              fprintf(stderr, "squeezing frame at %lx, ret %lx\n", frame,
              GRAB_RET(frame));
            /*
              fprintf(stderr, "squeezing frame at %lx, ret %lx\n", frame,
              GRAB_RET(frame));
-            */
+           */
 
 #ifdef CONCURRENT
            /* Check for a blocking queue on the node that's going away */
 
 #ifdef CONCURRENT
            /* Check for a blocking queue on the node that's going away */
@@ -182,15 +175,15 @@ P_ frame;
            }
 #endif
 
            }
 #endif
 
-           UPD_EXISTING();     /* ticky stuff (NB: nothing for spat-profiling) */
+           UPD_SQUEEZED();     /* ticky stuff (NB: nothing for spat-profiling) */
            UPD_IND(updatee_bypass, updatee_keep);
 
            sp = frame - BREL(1);       /* Toss the current frame */
            displacement += STD_UF_SIZE;
 
        } else {
            UPD_IND(updatee_bypass, updatee_keep);
 
            sp = frame - BREL(1);       /* Toss the current frame */
            displacement += STD_UF_SIZE;
 
        } else {
-#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
-           if (!noBlackHoles)
+#if !defined(CONCURRENT)
+           if ( RTSflags.GcFlags.lazyBlackHoling )
                UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
 
                UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
 
@@ -206,7 +199,7 @@ P_ frame;
        if (displacement > 0) {
            P_ next_frame_bottom = next_frame + BREL(STD_UF_SIZE);
 
        if (displacement > 0) {
            P_ next_frame_bottom = next_frame + BREL(STD_UF_SIZE);
 
-           /*      
+           /*
             fprintf(stderr, "sliding [%lx, %lx] by %d\n", sp, next_frame_bottom,
             displacement);
            */
             fprintf(stderr, "sliding [%lx, %lx] by %d\n", sp, next_frame_bottom,
             displacement);
            */
@@ -221,14 +214,14 @@ P_ frame;
     }
 
     /* 
     }
 
     /* 
-     * Now handle the topmost frame.  Patch SuB, black hole the updatee,
-     * and slide down.
+     * Now handle the topmost frame.  Patch SuB, black hole the
+     * updatee, and slide down.
      */
 
     PUSH_SuB(frame, prev_frame);
 
      */
 
     PUSH_SuB(frame, prev_frame);
 
-#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
-    if (!noBlackHoles)
+#if !defined(CONCURRENT)
+    if ( RTSflags.GcFlags.lazyBlackHoling )
        UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
 
        UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 #endif
 
@@ -246,7 +239,6 @@ P_ frame;
     }
     return displacement;
 }
     }
     return displacement;
 }
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -293,29 +285,35 @@ W_ args2;
     SET_TASK_ACTIVITY(ST_OVERHEAD);
 
 
     SET_TASK_ACTIVITY(ST_OVERHEAD);
 
 
-    /*
-     * fprintf(stderr,"StackOverflow:liveness=%lx,a=%lx,b=%lx\n",
-     * liveness,words_of_a,words_of_b);
-     */
+    /*?/
+      fprintf(stderr,"StackOverflow:liveness=%lx,a=%lx,b=%lx\n",
+      liveness,words_of_a,words_of_b);
+    /?*/
 
     old_stko = SAVE_StkO;
 
 
     old_stko = SAVE_StkO;
 
-    /*
-     * fprintf(stderr, "SpA %lx SuA %lx SpB %lx SuB %lx\n", STKO_SpA(old_stko),
-     * STKO_SuA(old_stko), STKO_SpB(old_stko), STKO_SuB(old_stko));
-     */
+    /*?/
+      fprintf(stderr, "stko: %lx SpA %lx SuA %lx SpB %lx SuB %lx\n",
+      old_stko, STKO_SpA(old_stko),
+      STKO_SuA(old_stko), STKO_SpB(old_stko), STKO_SuB(old_stko));
+    /?*/
+
+    if (RTSflags.GcFlags.squeezeUpdFrames) {
 
 
-    if (squeeze_upd_frames) {
        i = SqueezeUpdateFrames(STKO_BSTK_BOT(old_stko), STKO_SpB(old_stko),
        i = SqueezeUpdateFrames(STKO_BSTK_BOT(old_stko), STKO_SpB(old_stko),
-         STKO_SuB(old_stko));
+                               STKO_SuB(old_stko));
+
        STKO_SuB(old_stko) += BREL(i);
        STKO_SpB(old_stko) += BREL(i);
        STKO_SuB(old_stko) += BREL(i);
        STKO_SpB(old_stko) += BREL(i);
+
+     /*?/ fprintf(stderr, "Just squeezed; now: SpB %lx SuB %lx retval %d\n", STKO_SpB(old_stko), STKO_SuB(old_stko), i); /?*/
+
        if ((P_) STKO_SpA(old_stko) - AREL(headroom) > STKO_SpB(old_stko)) {
 
        if ((P_) STKO_SpA(old_stko) - AREL(headroom) > STKO_SpB(old_stko)) {
 
-           /*
-            * fprintf(stderr, "SpA %lx SpB %lx headroom %d\n", STKO_SpA(old_stko),
-            * STKO_SpB(old_stko), headroom);
-            */
+           /*?/
+             fprintf(stderr, "Squeezed; now: SpA %lx SpB %lx headroom %d\n", STKO_SpA(old_stko),
+             STKO_SpB(old_stko), headroom);
+           /?*/
 
            /* We saved enough space to continue on the old StkO */
            return 0;
 
            /* We saved enough space to continue on the old StkO */
            return 0;
@@ -323,7 +321,10 @@ W_ args2;
     }
     SAVE_Liveness = liveness;
 
     }
     SAVE_Liveness = liveness;
 
+    ASSERT(sanityChk_StkO(old_stko));
+
     /* Double the stack chunk size each time we grow the stack */
     /* Double the stack chunk size each time we grow the stack */
+    /*?/ fprintf(stderr, "Stko %lx: about to double stk-chk size from %d...\n", old_stko, STKO_CLOSURE_CTS_SIZE(old_stko)); /?*/
     cts_size = STKO_CLOSURE_CTS_SIZE(old_stko) * 2;
 
     if (SAVE_Hp + STKO_HS + cts_size > SAVE_HpLim) {
     cts_size = STKO_CLOSURE_CTS_SIZE(old_stko) * 2;
 
     if (SAVE_Hp + STKO_HS + cts_size > SAVE_HpLim) {
@@ -332,11 +333,21 @@ W_ args2;
             * Even in the uniprocessor world, we may have to reenter node in case
             * node is a selector shorted out by GC.
             */
             * Even in the uniprocessor world, we may have to reenter node in case
             * node is a selector shorted out by GC.
             */
-           assert(liveness & LIVENESS_R1);
+           ASSERT(liveness & LIVENESS_R1);
            TSO_PC2(CurrentTSO) = EnterNodeCode;
            really_reenter_node = 1;
        }
            TSO_PC2(CurrentTSO) = EnterNodeCode;
            really_reenter_node = 1;
        }
+       /*?/ fprintf(stderr, "StkO %lx: stk-chk GC: size %d...\n", old_stko, STKO_HS + cts_size);/?*/
        ReallyPerformThreadGC(STKO_HS + cts_size, rtsFalse);
        ReallyPerformThreadGC(STKO_HS + cts_size, rtsFalse);
+       /* 
+          now, GC semantics promise to have left SAVE_Hp with
+          the requested space *behind* it; as we will bump
+          SAVE_Hp just below, we had better first put it back.
+          (PS: Finding this was a two-day bug-hunting trip...)
+          Will & Phil 95/10
+       */
+       SAVE_Hp -= STKO_HS + cts_size;
+
        old_stko = SAVE_StkO;
     }
     ALLOC_STK(STKO_HS, cts_size, 0);
        old_stko = SAVE_StkO;
     }
     ALLOC_STK(STKO_HS, cts_size, 0);
@@ -344,12 +355,16 @@ W_ args2;
     SAVE_Hp += STKO_HS + cts_size;
     SET_STKO_HDR(new_stko, StkO_info, CCC);
 
     SAVE_Hp += STKO_HS + cts_size;
     SET_STKO_HDR(new_stko, StkO_info, CCC);
 
+    /*?/ fprintf(stderr, "New StkO now %lx...\n", new_stko); /?*/
+
     /* Initialize the StkO, as in NewThread */
     STKO_SIZE(new_stko) = cts_size + STKO_VHS;
     STKO_SpB(new_stko) = STKO_SuB(new_stko) = STKO_BSTK_BOT(new_stko) + BREL(1);
     STKO_SpA(new_stko) = STKO_SuA(new_stko) = STKO_ASTK_BOT(new_stko) + AREL(1);
     STKO_LINK(new_stko) = old_stko;
 
     /* Initialize the StkO, as in NewThread */
     STKO_SIZE(new_stko) = cts_size + STKO_VHS;
     STKO_SpB(new_stko) = STKO_SuB(new_stko) = STKO_BSTK_BOT(new_stko) + BREL(1);
     STKO_SpA(new_stko) = STKO_SuA(new_stko) = STKO_ASTK_BOT(new_stko) + AREL(1);
     STKO_LINK(new_stko) = old_stko;
 
+    /*?/ fprintf(stderr, "New StkO SpA = %lx...\n", STKO_SpA(new_stko) ); /?*/
     STKO_RETURN(new_stko) = SAVE_Ret;
 
 #ifdef PAR
     STKO_RETURN(new_stko) = SAVE_Ret;
 
 #ifdef PAR
@@ -358,7 +373,7 @@ W_ args2;
      * When we fall off of the top stack segment, we will either be
      * returning an algebraic data type, in which case R2 holds a
      * valid info ptr, or we will be returning a primitive
      * When we fall off of the top stack segment, we will either be
      * returning an algebraic data type, in which case R2 holds a
      * valid info ptr, or we will be returning a primitive
-     * (e.g. int#), in which case R2 is garbage. If we need to perform
+     * (e.g. Int#), in which case R2 is garbage. If we need to perform
      * GC to pull in the lower stack segment (this should only happen
      * because of task migration), then we need to know the register
      * liveness for the algebraic returns.  We get the liveness out of
      * GC to pull in the lower stack segment (this should only happen
      * because of task migration), then we need to know the register
      * liveness for the algebraic returns.  We get the liveness out of
@@ -378,7 +393,7 @@ W_ args2;
     STKO_SpA(old_stko) += AREL(words_of_a);
     STKO_SpB(old_stko) += BREL(words_of_b);
 
     STKO_SpA(old_stko) += AREL(words_of_a);
     STKO_SpB(old_stko) += BREL(words_of_b);
 
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
     /* Record the stack depths in chunks below the new stack object */
 
     STKO_ADEP(new_stko) = STKO_ADEP(old_stko) +
     /* Record the stack depths in chunks below the new stack object */
 
     STKO_ADEP(new_stko) = STKO_ADEP(old_stko) +
@@ -388,17 +403,17 @@ W_ args2;
 #endif
 
     if (STKO_SpB(old_stko) < STKO_BSTK_BOT(old_stko)) {
 #endif
 
     if (STKO_SpB(old_stko) < STKO_BSTK_BOT(old_stko)) {
-
        /*
        /*
-        * This _should_ only happen if PAP_entry fails a stack check and there is
-        * no update frame on the current stack.  We can deal with this by storing a
-        * function's argument requirements in its info table, peering into the PAP
-        * (it had better be in R1) for the function pointer and taking only the
-        * necessary number of arguments, but this would be hard, so we haven't done
-        * it.
+        * This _should_ only happen if PAP_entry fails a stack check
+        * and there is no update frame on the current stack.  We can
+        * deal with this by storing a function's argument
+        * requirements in its info table, peering into the PAP (it
+        * had better be in R1) for the function pointer and taking
+        * only the necessary number of arguments, but this would be
+        * hard, so we haven't done it.
         */
        fflush(stdout);
         */
        fflush(stdout);
-       fprintf(stderr, "StackOverflow too deep.  Probably a PAP with no update frame.\n");
+       fprintf(stderr, "StackOverflow too deep (SpB=%lx, Bstk bot=%lx).  Probably a PAP with no update frame.\n", STKO_SpB(old_stko), STKO_BSTK_BOT(old_stko));
        abort(); /* an 'abort' may be overkill WDP 95/04 */
     }
     /* Move A stack words from old StkO to new StkO */
        abort(); /* an 'abort' may be overkill WDP 95/04 */
     }
     /* Move A stack words from old StkO to new StkO */
@@ -420,9 +435,9 @@ W_ args2;
        P_ frame = STKO_SuB(new_stko) - BREL(STD_UF_SIZE);
 
        /*
        P_ frame = STKO_SuB(new_stko) - BREL(STD_UF_SIZE);
 
        /*
-        * fprintf(stderr, "Stolen update frame: (old %lx, new %lx) SuA %lx, SuB
-        * %lx, return %lx\n", old_stko, new_stko, GRAB_SuA(frame), GRAB_SuB(frame),
-        * GRAB_RET(frame));
+         fprintf(stderr, "Stolen update frame: (old %lx, new %lx) SuA %lx, SuB
+         %lx, return %lx\n", old_stko, new_stko, GRAB_SuA(frame), GRAB_SuB(frame),
+         GRAB_RET(frame));
         */
 
        STKO_SuA(old_stko) = GRAB_SuA(frame);
         */
 
        STKO_SuA(old_stko) = GRAB_SuA(frame);
@@ -437,7 +452,11 @@ W_ args2;
 
        STKO_SuB(new_stko) = frame;
     }
 
        STKO_SuB(new_stko) = frame;
     }
+
+    ASSERT(sanityChk_StkO(new_stko));
+
     SAVE_StkO = new_stko;
     SAVE_StkO = new_stko;
+
     return really_reenter_node;
 }
 \end{code}
     return really_reenter_node;
 }
 \end{code}
index 9728711..3bd53e8 100644 (file)
@@ -131,8 +131,8 @@ MallocPtr_ITBL(MallocPtr_info,MallocPtr_entry,UpdErr,0,INFO_OTHER_TAG,,,const,EF
 /* Ditto for the unused Stable Pointer info table. [ADR]
 */
 
 /* Ditto for the unused Stable Pointer info table. [ADR]
 */
 
-extern void raiseError PROTO((StgStablePtr));
-extern StgStablePtr errorHandler;
+void raiseError PROTO((StgStablePtr));
+extern StgStablePtr errorHandler; /* NB: prone to magic-value-ery (WDP 95/12) */
 
 /* Unused Stable Pointer (ie unused slot in a stable pointer table) */
 STATICFUN(UnusedSP_entry)
 
 /* Unused Stable Pointer (ie unused slot in a stable pointer table) */
 STATICFUN(UnusedSP_entry)
@@ -145,13 +145,23 @@ STATICFUN(UnusedSP_entry)
     FE_
 }
 
     FE_
 }
 
-STATIC_ITBL(UnusedSP_static_info,UnusedSP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,CON_K,"UNUSED STABLE PTR","USP");
+STATIC_ITBL(UnusedSP_info,UnusedSP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,CON_K,"UNUSED STABLE PTR","USP");
 
 
-SET_STATIC_HDR(UnusedSP_closure,UnusedSP_static_info,CC_SUBSUMED,,ED_RO_)
+SET_STATIC_HDR(UnusedSP_closure,UnusedSP_info,CC_SUBSUMED,,ED_RO_)
 };
 
 /* Entry point and Info table for Stable Pointer Table. */
 
 };
 
 /* Entry point and Info table for Stable Pointer Table. */
 
+STATICFUN(EmptyStablePointerTable_entry)
+{
+    FB_
+    /* Don't wrap the calls; we're done with STG land */
+    fflush(stdout);
+    fprintf(stderr, "Entered *empty* stable pointer table---this shouldn't happen!\n");
+    abort();
+    FE_
+}
+
 STATICFUN(StablePointerTable_entry)
 {
     FB_
 STATICFUN(StablePointerTable_entry)
 {
     FB_
@@ -162,7 +172,7 @@ STATICFUN(StablePointerTable_entry)
     FE_
 }
 
     FE_
 }
 
-STATIC_ITBL(EmptyStablePointerTable_static_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
+STATIC_ITBL(EmptyStablePointerTable_info,EmptyStablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
 /* ToDo: could put a useful tag in there!!! */
 
 DYN_ITBL(StablePointerTable_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
 /* ToDo: could put a useful tag in there!!! */
 
 DYN_ITBL(StablePointerTable_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
@@ -174,7 +184,7 @@ DYN_ITBL(StablePointerTable_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TA
    overflow will trigger creation of a table of useful size.
 */
 
    overflow will trigger creation of a table of useful size.
 */
 
-SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_static_info,CC_SUBSUMED,,ED_RO_)
+SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_info,CC_SUBSUMED,,ED_RO_)
 , (W_) DYN_VHS + 0 + 1 + 0  /* size = DYN_VHS + n + 1 + n with n = 0 */
 , (W_) 0   /* number of ptrs */
 , (W_) 0   /* top of stack */
 , (W_) DYN_VHS + 0 + 1 + 0  /* size = DYN_VHS + n + 1 + n with n = 0 */
 , (W_) 0   /* number of ptrs */
 , (W_) 0   /* top of stack */
@@ -207,10 +217,6 @@ STGFUN(startStgWorld)
        up to date, and is used to load the STG registers.
     */
 
        up to date, and is used to load the STG registers.
     */
 
-#if defined (DO_SPAT_PROFILING)
-    SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns  */
-#endif
-
     RestoreAllStgRegs();    /* inline! */
 
     /* ------- STG registers are now valid! -------------------------*/
     RestoreAllStgRegs();    /* inline! */
 
     /* ------- STG registers are now valid! -------------------------*/
@@ -340,7 +346,7 @@ STGFUN(ErrorIO_innards)
     default:
         /* Don't wrap the calls; we're done with STG land */
         fflush(stdout);
     default:
         /* Don't wrap the calls; we're done with STG land */
         fflush(stdout);
-       fprintf(stderr,"ErrorIO: %x unknown\n", TSO_TYPE(CurrentTSO));
+       fprintf(stderr,"ErrorIO: %lx unknown\n", TSO_TYPE(CurrentTSO));
        EXIT(EXIT_FAILURE);
     }
 
        EXIT(EXIT_FAILURE);
     }
 
@@ -353,7 +359,7 @@ STGFUN(ErrorIO_innards)
     STKO_LINK(StkOReg) = Nil_closure;
     STKO_RETURN(StkOReg) = NULL;
 
     STKO_LINK(StkOReg) = Nil_closure;
     STKO_RETURN(StkOReg) = NULL;
 
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
     STKO_ADEP(StkOReg) = STKO_BDEP(StkOReg) = 0;
 #endif
 
     STKO_ADEP(StkOReg) = STKO_BDEP(StkOReg) = 0;
 #endif
 
@@ -395,7 +401,7 @@ ErrorIO_innards(STG_NO_ARGS)
 
     SaveAllStgRegs();  /* inline! */
 
 
     SaveAllStgRegs();  /* inline! */
 
-    if ( initStacks( &StorageMgrInfo ) != 0) {
+    if (! initStacks( &StorageMgrInfo )) {
         /* Don't wrap the calls; we're done with STG land */
         fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
         /* Don't wrap the calls; we're done with STG land */
         fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
@@ -477,10 +483,10 @@ STGFUN(STK_STUB_entry) {
 }
 
 /* info table */
 }
 
 /* info table */
-STATIC_ITBL(STK_STUB_static_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,INTERNAL_KIND,"STK_STUB","STK_STUB");
+STATIC_ITBL(STK_STUB_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,INTERNAL_KIND,"STK_STUB","STK_STUB");
 
 /* closure */
 
 /* closure */
-SET_STATIC_HDR(STK_STUB_closure,STK_STUB_static_info,CC_SUBSUMED,,EXTDATA_RO)
+SET_STATIC_HDR(STK_STUB_closure,STK_STUB_info,CC_SUBSUMED,,EXTDATA_RO)
   , (W_)0, (W_)0
 };
 \end{code}
   , (W_)0, (W_)0
 };
 \end{code}
@@ -595,7 +601,7 @@ N.B. ALL prelude cost centres should be declared here as none will
 ToDo: Explicit cost centres in prelude for Input and Output costs.
 
 \begin{code}
 ToDo: Explicit cost centres in prelude for Input and Output costs.
 
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 
 STGFUN(startCcRegisteringWorld)
 {
 
 STGFUN(startCcRegisteringWorld)
 {
index b3f9f28..ab63382 100644 (file)
@@ -111,7 +111,7 @@ STGFUN(BQ_entry)
        QP_Event1("GR", CurrentTSO);
     }
 #ifdef PAR
        QP_Event1("GR", CurrentTSO);
     }
 #ifdef PAR
-    if(do_gr_profile) {
+    if(RTSflags.ParFlags.granSimStats) {
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
@@ -182,7 +182,7 @@ STGFUN(RBH_entry)
        QP_Event1("GR", CurrentTSO);
     }
 
        QP_Event1("GR", CurrentTSO);
     }
 
-    if(do_gr_profile) {
+    if(RTSflags.ParFlags.granSimStats) {
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
         /* Note that CURRENT_TIME may perform an unsafe call */
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
@@ -211,22 +211,21 @@ STGFUN(RBH_entry)
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-The normal way of entering a thread is through resumeThread, which 
-short-circuits and indirections to the TSO and StkO, sets up STG registers,
-and jumps to the saved PC.
+The normal way of entering a thread is through \tr{resumeThread},
+which short-circuits any indirections to the TSO and StkO, sets up STG
+registers, and jumps to the saved PC.
 
 \begin{code}
 
 \begin{code}
-
 STGFUN(resumeThread)
 {
     FB_
 
 STGFUN(resumeThread)
 {
     FB_
 
-    while((P_) INFO_PTR(CurrentTSO) == Ind_info) {
+    while(IS_INDIRECTION(INFO_PTR(CurrentTSO))) {
        CurrentTSO = (P_) IND_CLOSURE_PTR(CurrentTSO);
     }
 
 #ifdef PAR
        CurrentTSO = (P_) IND_CLOSURE_PTR(CurrentTSO);
     }
 
 #ifdef PAR
-    if (do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
        TSO_QUEUE(CurrentTSO) = Q_RUNNING;
        /* Note that CURRENT_TIME may perform an unsafe call */
         TSO_BLOCKEDAT(CurrentTSO) = CURRENT_TIME;
        TSO_QUEUE(CurrentTSO) = Q_RUNNING;
        /* Note that CURRENT_TIME may perform an unsafe call */
         TSO_BLOCKEDAT(CurrentTSO) = CURRENT_TIME;
@@ -235,18 +234,16 @@ STGFUN(resumeThread)
 
     CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
 
 
     CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
 
-    while((P_) INFO_PTR(SAVE_StkO) == Ind_info) {
+    while(IS_INDIRECTION(INFO_PTR(SAVE_StkO))) {
        SAVE_StkO = (P_) IND_CLOSURE_PTR(SAVE_StkO);
     }
     RestoreAllStgRegs();
 
     SET_TASK_ACTIVITY(ST_REDUCING);
        SAVE_StkO = (P_) IND_CLOSURE_PTR(SAVE_StkO);
     }
     RestoreAllStgRegs();
 
     SET_TASK_ACTIVITY(ST_REDUCING);
-    SET_ACTIVITY(ACT_REDN); /* back to normal reduction */
     RESTORE_CCC(TSO_CCC(CurrentTSO));
     JMP_(TSO_PC1(CurrentTSO));
     FE_
 }
     RESTORE_CCC(TSO_CCC(CurrentTSO));
     JMP_(TSO_PC1(CurrentTSO));
     FE_
 }
-
 \end{code}
 
 Since we normally context switch during a heap check, it is possible
 \end{code}
 
 Since we normally context switch during a heap check, it is possible
@@ -255,26 +252,22 @@ sufficient heap for the thread to continue.  However, we have cleverly
 stashed away the heap requirements in @TSO_ARG1@ so that we can decide
 whether or not to perform a garbage collection before resuming the
 thread.  The actual thread resumption address (either @EnterNodeCode@
 stashed away the heap requirements in @TSO_ARG1@ so that we can decide
 whether or not to perform a garbage collection before resuming the
 thread.  The actual thread resumption address (either @EnterNodeCode@
-or elsewhere) is stashed in TSO_PC2.
+or elsewhere) is stashed in @TSO_PC2@.
 
 \begin{code}
 
 \begin{code}
-
 STGFUN(CheckHeapCode)
 {
     FB_
 
     ALLOC_HEAP(TSO_ARG1(CurrentTSO)); /* ticky profiling */
 STGFUN(CheckHeapCode)
 {
     FB_
 
     ALLOC_HEAP(TSO_ARG1(CurrentTSO)); /* ticky profiling */
-    SET_ACTIVITY(ACT_HEAP_CHK); /* SPAT counting */
     if ((Hp += TSO_ARG1(CurrentTSO)) > HpLim) {
        ReallyPerformThreadGC(TSO_ARG1(CurrentTSO), rtsFalse);
        JMP_(resumeThread);
     }
     SET_TASK_ACTIVITY(ST_REDUCING);
     if ((Hp += TSO_ARG1(CurrentTSO)) > HpLim) {
        ReallyPerformThreadGC(TSO_ARG1(CurrentTSO), rtsFalse);
        JMP_(resumeThread);
     }
     SET_TASK_ACTIVITY(ST_REDUCING);
-    SET_ACTIVITY(ACT_REDN); /* back to normal reduction */
     RESUME_(TSO_PC2(CurrentTSO));
     FE_
 }
     RESUME_(TSO_PC2(CurrentTSO));
     FE_
 }
-
 \end{code}
 
 Often, a thread starts (or rather, resumes) by entering the closure
 \end{code}
 
 Often, a thread starts (or rather, resumes) by entering the closure
@@ -283,7 +276,6 @@ The saved PC in the TSO can be set to @EnterNodeCode@ whenever we
 want this to happen upon resumption of the thread.
 
 \begin{code}
 want this to happen upon resumption of the thread.
 
 \begin{code}
-
 STGFUN(EnterNodeCode)
 {
     FB_
 STGFUN(EnterNodeCode)
 {
     FB_
@@ -293,28 +285,26 @@ STGFUN(EnterNodeCode)
     JMP_(ENTRY_CODE(InfoPtr));
     FE_
 }
     JMP_(ENTRY_CODE(InfoPtr));
     FE_
 }
-
 \end{code}
 
 \end{code}
 
-Then, there are the occasions when we just want to pick up where we left off.
-We use RESUME_ here instead of JMP_, because when we return to a call site,
-the alpha is going to try to load %gp from %ra rather than %pv, and JMP_ only
-sets %pv.  Resuming to the start of a function is currently okay, but an
-extremely bad practice.  As we add support for more architectures, we can expect 
-the difference between RESUME_ and JMP_ to become more acute.
+Then, there are the occasions when we just want to pick up where we
+left off.  We use \tr{RESUME_} here instead of \tr{JMP_}, because when
+we return to a call site, the Alpha is going to try to load \tr{%gp}
+from \tr{%ra} rather than \tr{%pv}, and \tr{JMP_} only sets \tr{%pv}.
+Resuming to the start of a function is currently okay, but an
+extremely bad practice.  As we add support for more architectures, we
+can expect the difference between \tr{RESUME_} and \tr{JMP_} to become
+more acute.
 
 \begin{code}
 
 \begin{code}
-
 STGFUN(Continue)
 {
     FB_
 
     SET_TASK_ACTIVITY(ST_REDUCING);
 STGFUN(Continue)
 {
     FB_
 
     SET_TASK_ACTIVITY(ST_REDUCING);
-    SET_ACTIVITY(ACT_REDN); /* back to normal reduction */
     RESUME_(TSO_PC2(CurrentTSO));
     FE_
 }
     RESUME_(TSO_PC2(CurrentTSO));
     FE_
 }
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -324,11 +314,7 @@ STGFUN(Continue)
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-
-extern P_ AvailableStack;
-
 #ifndef PAR
 #ifndef PAR
-
 \end{code}
 
 On a uniprocessor, stack underflow causes us no great headaches.  The
 \end{code}
 
 On a uniprocessor, stack underflow causes us no great headaches.  The
@@ -388,6 +374,20 @@ STGFUN(CommonUnderflow)
 
     FB_
     temp = STKO_LINK(StkOReg);
 
     FB_
     temp = STKO_LINK(StkOReg);
+
+    /* fprintf(stderr,"Stk Underflow from: %lx to: %lx size abandoned: %d\n",StkOReg,temp,STKO_CLOSURE_CTS_SIZE(StkOReg)); */
+
+    /* change the guy we are abandoning into something
+       that will not be "interesting" on the mutables
+       list.  (As long as it is there, it will be
+       scavenged in GC, and we cannot guarantee that
+       it is still a "sane" StkO object).  (And, besides,
+       why continue to keep it [and all it pts to] alive?)
+       Will & Phil 95/10
+    */
+    FREEZE_MUT_HDR(StkOReg, ImMutArrayOfPtrs_info);
+    MUTUPLE_CLOSURE_SIZE(StkOReg) = MUTUPLE_VHS;
+
     StkOReg = temp;
     /* ToDo: Fetch the remote stack object here! */
     RestoreStackStgRegs();
     StkOReg = temp;
     /* ToDo: Fetch the remote stack object here! */
     RestoreStackStgRegs();
diff --git a/ghc/runtime/main/StgTrace.lc b/ghc/runtime/main/StgTrace.lc
deleted file mode 100644 (file)
index 0c4ab4c..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-\begin{code}
-
-#include "rtsdefs.h"
-
-#if defined(DO_RUNTIME_TRACE_UPDATES)
-
-/********** Debugging Tracing of Updates ***********/
-
-/* These will only be called if StgUpdate.h macro calls
-   compiled with -DDO_RUNTIME_TRACE_UPDATES
- */
-
-extern I_ traceUpdates; /* a Bool, essentially */
-
-void
-TRACE_UPDATE_Ind(updclosure,heapptr)
-P_ updclosure,heapptr;
-{
-#if defined(GCap)
-    if (traceUpdates) {
-       fprintf(stderr,"Upd Ind %s Gen: 0x%lx -> 0x%lx\n",
-               (updclosure) <= StorageMgrInfo.OldLim ? "Old" : "New",
-               (W_) updclosure, (W_) heapptr);
-    }
-#else
-    if (traceUpdates) {
-       fprintf(stderr,"Upd Ind: 0x%lx -> 0x%lx\n",
-                       (W_) updclosure, (W_) heapptr);
-    }
-#endif
-}
-
-void
-TRACE_UPDATE_Inplace_NoPtrs(updclosure)
-P_ updclosure;
-{
-#if defined(GCap)
-    if (traceUpdates) {
-       fprintf(stderr,"Upd Inplace  %s Gen: 0x%lx\n",
-               (updclosure) <= StorageMgrInfo.OldLim ? "Old" : "New",
-               (W_) updclosure);
-    }
-#else
-    if (traceUpdates) {
-       fprintf(stderr,"Upd Inplace: 0x%lx\n", (W_) updclosure);
-    }
-#endif
-}
-
-void
-TRACE_UPDATE_Inplace_Ptrs(updclosure, hp)
-P_ updclosure;
-P_ hp;
-{
-#if defined(GCap)
-    if (traceUpdates) {
-       if ((updclosure) <= StorageMgrInfo.OldLim) {
-           fprintf(stderr,"Upd Redirect Old Gen (Ptrs): 0x%lx -> 0x%lx\n",
-                   (W_) updclosure,
-                   (W_) (hp + 1));
-       } else {
-           fprintf(stderr,"Upd Inplace  New Gen (Ptrs): 0x%lx\n", (W_) updclosure);
-       }
-    }
-#else
-    if (traceUpdates) {
-       fprintf(stderr,"Update Inplace: 0x%lx\n", (W_) updclosure);
-    }
-#endif
-}
-
-#endif /* DO_RUNTIME_TRACE_UPDATES */
-
-\end{code}
index 904f637..e0cb245 100644 (file)
@@ -33,9 +33,8 @@ System-wide constants need to be included:
 
 EXTDATA(Nil_closure);
 
 
 EXTDATA(Nil_closure);
 
-#if defined(DO_REDN_COUNTING)
-extern void PrintRednCountInfo(STG_NO_ARGS);
-extern I_   showRednCountStats;
+#if defined(TICKY_TICKY)
+void PrintTickyInfo(STG_NO_ARGS);
 #endif
 \end{code}
 
 #endif
 \end{code}
 
@@ -51,7 +50,6 @@ STGFUN(Ind_entry)
 {
     FB_
     ENT_IND(Node);     /* Ticky-ticky profiling info */
 {
     FB_
     ENT_IND(Node);     /* Ticky-ticky profiling info */
-    SET_ACTIVITY(ACT_INDIRECT); /* SPAT profiling */
 
     Node = (P_) IND_CLOSURE_PTR((P_) Node);
     ENT_VIA_NODE();
 
     Node = (P_) IND_CLOSURE_PTR((P_) Node);
     ENT_VIA_NODE();
@@ -61,7 +59,6 @@ STGFUN(Ind_entry)
 }
 
 IND_ITBL(Ind_info,Ind_entry,const,EF_);
 }
 
 IND_ITBL(Ind_info,Ind_entry,const,EF_);
-
 \end{code}
 
 We also need a special @CAF@ indirection info table which is used to
 \end{code}
 
 We also need a special @CAF@ indirection info table which is used to
@@ -71,7 +68,6 @@ STGFUN(Caf_entry)     /* same as Ind_entry */
 {
     FB_
     ENT_IND(Node);
 {
     FB_
     ENT_IND(Node);
-    SET_ACTIVITY(ACT_INDIRECT); /* SPAT profiling */
 
     Node = (P_) IND_CLOSURE_PTR((P_) Node);
     ENT_VIA_NODE();
 
     Node = (P_) IND_CLOSURE_PTR((P_) Node);
     ENT_VIA_NODE();
@@ -102,8 +98,8 @@ EXTFUN(EnterNodeCode);
 EXTFUN(StackUnderflowEnterNode);
 EXTDATA_RO(BQ_info);
 #else
 EXTFUN(StackUnderflowEnterNode);
 EXTDATA_RO(BQ_info);
 #else
-extern StgStablePtr errorHandler;
-extern void raiseError PROTO((StgStablePtr));
+void raiseError PROTO((StgStablePtr));
+extern StgStablePtr errorHandler; /* NB: prone to magic-value-ery (WDP 95/12) */
 #endif
 
 STGFUN(BH_UPD_entry)
 #endif
 
 STGFUN(BH_UPD_entry)
@@ -113,16 +109,16 @@ STGFUN(BH_UPD_entry)
     (void) STGCALL1(int,(void *, FILE *),fflush,stdout);
     (void) STGCALL2(int,(),fprintf,stderr,"Entered a `black hole': the program has a cyclic data dependency.\n");
 
     (void) STGCALL1(int,(void *, FILE *),fflush,stdout);
     (void) STGCALL2(int,(),fprintf,stderr,"Entered a `black hole': the program has a cyclic data dependency.\n");
 
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
     {
        CostCentre cc = (CostCentre) CC_HDR(Node);
        (void) STGCALL5(int,(),fprintf,stderr,"Cost Centre: %s  Module: %s  Group %s\n",cc->label, cc->module, cc->group);
     }
 # endif    
 
     {
        CostCentre cc = (CostCentre) CC_HDR(Node);
        (void) STGCALL5(int,(),fprintf,stderr,"Cost Centre: %s  Module: %s  Group %s\n",cc->label, cc->module, cc->group);
     }
 # endif    
 
-# if defined(DO_REDN_COUNTING)
-    if (showRednCountStats) {
-       (void) STGCALL0(void,(),PrintRednCountInfo);
+# if defined(TICKY_TICKY)
+    if (RTSflags.TickyFlags.showTickyStats) {
+       (void) STGCALL0(void,(),PrintTickyInfo);
     }
 # endif
 
     }
 # endif
 
@@ -166,7 +162,7 @@ STGFUN(BH_UPD_entry)
     }
 
 # ifdef PAR
     }
 
 # ifdef PAR
-    if(do_gr_profile) {
+    if(RTSflags.ParFlags.granSimStats) {
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
         TSO_BLOCKCOUNT(CurrentTSO)++;
        TIME now = CURRENT_TIME;
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
         TSO_BLOCKCOUNT(CurrentTSO)++;
@@ -184,6 +180,7 @@ STGFUN(BH_UPD_entry)
 # endif
 
     FE_
 # endif
 
     FE_
+
 #endif /* threads */
 }
 
 #endif /* threads */
 }
 
@@ -197,16 +194,16 @@ STGFUN(BH_SINGLE_entry)
     (void) STGCALL2(int,(),fprintf,stderr,"either the compiler made a mistake on single-entryness,\n");
     (void) STGCALL2(int,(),fprintf,stderr,"or the program has a cyclic data dependency.\n");
 
     (void) STGCALL2(int,(),fprintf,stderr,"either the compiler made a mistake on single-entryness,\n");
     (void) STGCALL2(int,(),fprintf,stderr,"or the program has a cyclic data dependency.\n");
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     {
        CostCentre cc = (CostCentre) CC_HDR(Node);
        (void) STGCALL5(int,(),fprintf,stderr, "Cost Centre: %s  Module: %s  Group %s\n",cc->label, cc->module, cc->group);
     }
 #endif    
 
     {
        CostCentre cc = (CostCentre) CC_HDR(Node);
        (void) STGCALL5(int,(),fprintf,stderr, "Cost Centre: %s  Module: %s  Group %s\n",cc->label, cc->module, cc->group);
     }
 #endif    
 
-# if defined(DO_REDN_COUNTING)
-    if (showRednCountStats) {
-       (void) STGCALL0(void,(),PrintRednCountInfo);
+# if defined(TICKY_TICKY)
+    if (RTSflags.TickyFlags.showTickyStats) {
+       (void) STGCALL0(void,(),PrintTickyInfo);
     }
 # endif
 
     }
 # endif
 
@@ -303,27 +300,27 @@ vtbl_StdUpdFrame[] = {
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-Here is the standard update code for objects that are returned in the heap
-(or those which are initially returned in registers, but have already been
-allocated in the heap earlier in the update chain.)  In either case, Node
-points to the heap object.  The update code grabs the address of the updatee
-out of the partial update frame (the return address has already been popped),
-makes the updatee an indirection to Node, and returns according to the convention
-for the constructor.
+Here is the standard update code for objects that are returned in the
+heap (or those which are initially returned in registers, but have
+already been allocated in the heap earlier in the update chain).  In
+either case, @Node@ points to the heap object.  The update code grabs
+the address of the updatee out of the partial update frame (the return
+address has already been popped), makes the updatee an indirection to
+@Node@, and returns according to the convention for the constructor.
 
 \begin{code}
 
 \begin{code}
-#define IND_UPD_TEMPLATE(label, retvector)                                     \
-  STGFUN(label)                                                                \
-  {                                                                            \
-    FB_                                                                                \
-    UPD_EXISTING();                    /* Ticky-ticky profiling info */        \
-    /* Update thing off stk with an indirection to Node */                     \
-    UPD_IND(GRAB_UPDATEE(SpB), Node);                                          \
-    /* Pop the standard update frame */                                         \
-    POP_STD_UPD_FRAME()                                                                \
-                                                                               \
-    JMP_(retvector);                                                           \
-    FE_                                                                        \
+#define IND_UPD_TEMPLATE(label, retvector)                     \
+  STGFUN(label)                                                \
+  {                                                            \
+    FB_                                                                \
+    UPD_EXISTING();    /* Ticky-ticky profiling info */        \
+    /* Update thing off stk with an indirection to Node */     \
+    UPD_IND(GRAB_UPDATEE(SpB), Node);                           \
+    /* Pop the standard update frame */                         \
+    POP_STD_UPD_FRAME()                                                \
+                                                               \
+    JMP_(retvector);                                           \
+    FE_                                                        \
   }
 
 IND_UPD_TEMPLATE(IndUpdRetDir, DIRECT(((P_)RetReg)))
   }
 
 IND_UPD_TEMPLATE(IndUpdRetDir, DIRECT(((P_)RetReg)))
@@ -335,7 +332,6 @@ IND_UPD_TEMPLATE(IndUpdRetV4, ((P_)RetReg)[RVREL(4)])
 IND_UPD_TEMPLATE(IndUpdRetV5, ((P_)RetReg)[RVREL(5)])
 IND_UPD_TEMPLATE(IndUpdRetV6, ((P_)RetReg)[RVREL(6)])
 IND_UPD_TEMPLATE(IndUpdRetV7, ((P_)RetReg)[RVREL(7)])
 IND_UPD_TEMPLATE(IndUpdRetV5, ((P_)RetReg)[RVREL(5)])
 IND_UPD_TEMPLATE(IndUpdRetV6, ((P_)RetReg)[RVREL(6)])
 IND_UPD_TEMPLATE(IndUpdRetV7, ((P_)RetReg)[RVREL(7)])
-
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -385,8 +381,12 @@ the cost centre when entered. The heap profiler ignores the space
 occupied by it as it would not reside in the heap during normal
 execution.
 
 occupied by it as it would not reside in the heap during normal
 execution.
 
+In ticky-land: If we are trying to collect update-entry counts
+(controlled by an RTS flag), then we must use permanent indirections
+(the shorting-out of regular indirections loses the counts).
+
 \begin{code}
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
 
 STGFUN(Perm_Ind_entry)
 {
 
 STGFUN(Perm_Ind_entry)
 {
@@ -394,15 +394,17 @@ STGFUN(Perm_Ind_entry)
 
     /* Don't add INDs to granularity cost */
 
 
     /* Don't add INDs to granularity cost */
 
-    ENT_IND(Node);     /* Ticky-ticky profiling info */
+    /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help ticky */
 
     /* Enter PAP cost centre -- lexical scoping only */
     ENTER_CC_PAP_CL(Node);
 
     Node = (P_) IND_CLOSURE_PTR((P_) Node);
 
     /* Enter PAP cost centre -- lexical scoping only */
     ENTER_CC_PAP_CL(Node);
 
     Node = (P_) IND_CLOSURE_PTR((P_) Node);
-    ENT_VIA_NODE();    /* Ticky-ticky profiling info */
+
+    /* Dont: ENT_VIA_NODE(); for ticky-ticky; as above */
 
     InfoPtr=(D_)(INFO_PTR(Node));
 
     InfoPtr=(D_)(INFO_PTR(Node));
+
 # if defined(GRAN)
     GRAN_EXEC(1,1,2,0,0);
 # endif
 # if defined(GRAN)
     GRAN_EXEC(1,1,2,0,0);
 # endif
@@ -412,7 +414,7 @@ STGFUN(Perm_Ind_entry)
 
 PERM_IND_ITBL(Perm_Ind_info,Perm_Ind_entry,const,EF_);
 
 
 PERM_IND_ITBL(Perm_Ind_info,Perm_Ind_entry,const,EF_);
 
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING or TICKY */
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -443,7 +445,6 @@ stack chunk.
 \end{itemize}
 
 \begin{code}
 \end{itemize}
 
 \begin{code}
-
 STGFUN(UpdatePAP)
 {
     /* 
 STGFUN(UpdatePAP)
 {
     /* 
@@ -455,7 +456,7 @@ STGFUN(UpdatePAP)
 #define NPtrWords      (R3.i)
 #define NArgWords      (R4.i)
 #define PapSize                (R5.i)
 #define NPtrWords      (R3.i)
 #define NArgWords      (R4.i)
 #define PapSize                (R5.i)
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 # define CC_pap        ((CostCentre)(R7.p))
 #endif
 
 # define CC_pap        ((CostCentre)(R7.p))
 #endif
 
@@ -472,8 +473,6 @@ STGFUN(UpdatePAP)
       ++nPAPs;
 #endif
 
       ++nPAPs;
 #endif
 
-    SET_ACTIVITY(ACT_UPDATE_PAP);   /* SPAT profiling */
-
     NPtrWords    = AREL(SuA - SpA);
     NNonPtrWords = BREL(SuB - SpB);
 
     NPtrWords    = AREL(SuA - SpA);
     NNonPtrWords = BREL(SuB - SpB);
 
@@ -482,7 +481,7 @@ STGFUN(UpdatePAP)
 
     NArgWords = NPtrWords + NNonPtrWords + 1;  /* +1 for Node */
 
 
     NArgWords = NPtrWords + NNonPtrWords + 1;  /* +1 for Node */
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
       /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
 
     CC_pap /*really cc_enter*/ = (CostCentre) CC_HDR(Node);
       /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
 
     CC_pap /*really cc_enter*/ = (CostCentre) CC_HDR(Node);
@@ -516,8 +515,6 @@ STGFUN(UpdatePAP)
        /* Allocate PapClosure -- Only Node (R1) is live */
        HEAP_CHK(LIVENESS_R1, PapSize, 0);
 
        /* Allocate PapClosure -- Only Node (R1) is live */
        HEAP_CHK(LIVENESS_R1, PapSize, 0);
 
-       SET_ACTIVITY(ACT_UPDATE_PAP);   /* back to it (for SPAT profiling) */
-    
        PapClosure = Hp + 1 - PapSize;  /* The new PapClosure */
 
        SET_DYN_HDR(PapClosure, PAP_info, CC_pap, NArgWords + DYN_VHS, NPtrWords + 1);
        PapClosure = Hp + 1 - PapSize;  /* The new PapClosure */
 
        SET_DYN_HDR(PapClosure, PAP_info, CC_pap, NArgWords + DYN_VHS, NPtrWords + 1);
@@ -526,13 +523,14 @@ STGFUN(UpdatePAP)
 
        p = Hp;
         for (i = NNonPtrWords - 1; i >= 0; i--) *p-- = (W_) SpB[BREL(i)];
 
        p = Hp;
         for (i = NNonPtrWords - 1; i >= 0; i--) *p-- = (W_) SpB[BREL(i)];
-        for (i = NPtrWords - 1; i >= 0; i--)    *p-- = (W_) SpA[AREL(i)];
+        for (i = NPtrWords    - 1; i >= 0; i--) *p-- = (W_) SpA[AREL(i)];
        *p = (W_) Node;
        }
 
     /* 
        *p = (W_) Node;
        }
 
     /* 
-     * Finished constructing PAP closure; now update the updatee. 
-     * But wait!  What if there is no updatee?  Then we fall off the stack.
+     * Finished constructing PAP closure; now update the updatee.  But
+     * wait!  What if there is no updatee?  Then we fall off the
+     * stack.
      */
 
 #ifdef CONCURRENT
      */
 
 #ifdef CONCURRENT
@@ -558,12 +556,12 @@ STGFUN(UpdatePAP)
     UPD_IND(Updatee, PapClosure);   /* Indirect Updatee to PapClosure */
 
     if (NArgWords != 1) {
     UPD_IND(Updatee, PapClosure);   /* Indirect Updatee to PapClosure */
 
     if (NArgWords != 1) {
-       UPD_PAP_IN_NEW();
+       UPD_PAP_IN_NEW(NArgWords);
 
     } else {
        UPD_PAP_IN_PLACE();     
 
 
     } else {
        UPD_PAP_IN_PLACE();     
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
        /* 
          * Lexical scoping requires a *permanent* indirection, and we
          * also have to set the cost centre for the indirection.
        /* 
          * Lexical scoping requires a *permanent* indirection, and we
          * also have to set the cost centre for the indirection.
@@ -571,10 +569,10 @@ STGFUN(UpdatePAP)
        INFO_PTR(Updatee) = (W_) Perm_Ind_info;
        SET_CC_HDR(Updatee, CC_pap);
 
        INFO_PTR(Updatee) = (W_) Perm_Ind_info;
        SET_CC_HDR(Updatee, CC_pap);
 
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
     }
 
     }
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     /* 
      * Restore the Cost Centre too (if required); again see Sansom thesis p 183.
      * Take the CC out of the update frame if a CAF/DICT.
     /* 
      * Restore the Cost Centre too (if required); again see Sansom thesis p 183.
      * Take the CC out of the update frame if a CAF/DICT.
@@ -582,7 +580,7 @@ STGFUN(UpdatePAP)
 
     CCC = (IS_CAF_OR_DICT_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap;
 
 
     CCC = (IS_CAF_OR_DICT_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap;
 
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 
     /* Restore SuA, SuB, RetReg */
     RetReg = GRAB_RET(SuB);
 
     /* Restore SuA, SuB, RetReg */
     RetReg = GRAB_RET(SuB);
@@ -615,7 +613,7 @@ STGFUN(UpdatePAP)
 #undef NPtrWords
 #undef NArgWords
 #undef PapSize
 #undef NPtrWords
 #undef NArgWords
 #undef PapSize
-#ifdef USE_COST_CENTRES
+#ifdef PROFILING
 # undef CC_pap
 #endif
 }
 # undef CC_pap
 #endif
 }
@@ -631,11 +629,11 @@ STGFUN(PAP_entry)
     /* Use STG registers for these locals which must survive the STK_CHK */
 #define NPtrWords      (R2.i)
 #define NNonPtrWords   (R3.i)
     /* Use STG registers for these locals which must survive the STK_CHK */
 #define NPtrWords      (R2.i)
 #define NNonPtrWords   (R3.i)
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 # define CC_pap        ((CostCentre)(R7.p))
 #endif
 
 # define CC_pap        ((CostCentre)(R7.p))
 #endif
 
-    /* These locals don't have to survive a HEAP_CHK */
+    /* These locals don't have to survive the STK_CHK */
     P_ Updatee;
     P_ p;
     I_ i;
     P_ Updatee;
     P_ p;
     I_ i;
@@ -643,8 +641,6 @@ STGFUN(PAP_entry)
 
     FB_
 
 
     FB_
 
-    SET_ACTIVITY(ACT_UPDATE_PAP);   /* SPAT profiling */
-
     while (AREL(SuA - SpA) == 0 && BREL(SuB - SpB) == 0) {
 #ifdef CONCURRENT
         if (SuB < STKO_BSTK_BOT(StkOReg)) {
     while (AREL(SuA - SpA) == 0 && BREL(SuB - SpB) == 0) {
 #ifdef CONCURRENT
         if (SuB < STKO_BSTK_BOT(StkOReg)) {
@@ -660,16 +656,17 @@ STGFUN(PAP_entry)
         Updatee = GRAB_UPDATEE(SuB);
        UPD_IND(Updatee, Node);
 
         Updatee = GRAB_UPDATEE(SuB);
        UPD_IND(Updatee, Node);
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
         /* 
         /* 
-         * Restore the Cost Centre too (if required); again see Sansom thesis p 183.
-         * Take the CC out of the update frame if a CAF/DICT.
-     */
+         * Restore the Cost Centre too (if required); again see Sansom
+         * thesis p 183.  Take the CC out of the update frame if a
+         * CAF/DICT.
+         */
 
         CC_pap = (CostCentre) CC_HDR(Node);
         CCC = (IS_CAF_OR_DICT_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap;
 
 
         CC_pap = (CostCentre) CC_HDR(Node);
         CCC = (IS_CAF_OR_DICT_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap;
 
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 
         RetReg = GRAB_RET(SuB);
         SuA = GRAB_SuA(SuB);
 
         RetReg = GRAB_RET(SuB);
         SuA = GRAB_SuA(SuB);
@@ -718,7 +715,7 @@ STGFUN(PAP_entry)
 
 #undef NPtrWords
 #undef NNonPtrWords
 
 #undef NPtrWords
 #undef NNonPtrWords
-#ifdef USE_COST_CENTRES
+#ifdef PROFILING
 # undef CC_pap
 #endif
 }
 # undef CC_pap
 #endif
 }
index a5f175f..4df5c8e 100644 (file)
@@ -40,7 +40,8 @@ static void init_qp_profiling(STG_NO_ARGS); /* forward decl */
 @AvailableStack@ is used to determine whether an existing stack can be
 reused without new allocation, so reducing garbage collection, and
 stack setup time.  At present, it is only used for the first stack
 @AvailableStack@ is used to determine whether an existing stack can be
 reused without new allocation, so reducing garbage collection, and
 stack setup time.  At present, it is only used for the first stack
-chunk of a thread, the one that's got @StkOChunkSize@ words.
+chunk of a thread, the one that's got
+@RTSflags.ConcFlags.stkChunkSize@ words.
 
 \begin{code}
 P_ AvailableStack = Nil_closure;
 
 \begin{code}
 P_ AvailableStack = Nil_closure;
@@ -58,7 +59,6 @@ which should be <= the length of a word in bits.  -- HWL
 /* mattson thinks this is obsolete */
 
 # if 0 && defined(GRAN)
 /* mattson thinks this is obsolete */
 
 # if 0 && defined(GRAN)
-extern FILE *main_statsfile;         /* Might be of general interest  HWL */
 
 typedef unsigned long TIME;
 typedef unsigned char PROC;
 
 typedef unsigned long TIME;
 typedef unsigned char PROC;
@@ -145,8 +145,6 @@ I_ nUPDs = 0, nUPDs_old = 0, nUPDs_new = 0, nUPDs_BQ = 0, nPAPs = 0,
    BQ_lens = 0;
 # endif
 
    BQ_lens = 0;
 # endif
 
-I_ do_gr_binary = 0;
-I_ do_gr_profile = 0;        /* Full .gr profile or only END events? */
 I_ no_gr_profile = 0;        /* Don't create any .gr file at all? */
 I_ do_sp_profile = 0;
 I_ do_gr_migration = 0;
 I_ no_gr_profile = 0;        /* Don't create any .gr file at all? */
 I_ do_sp_profile = 0;
 I_ do_gr_migration = 0;
@@ -297,7 +295,7 @@ static eventq getnextevent()
   if(EventHd == NULL)
     {
       fprintf(stderr,"No next event\n");
   if(EventHd == NULL)
     {
       fprintf(stderr,"No next event\n");
-      exit(EXIT_FAILURE); /* ToDo: abort()? EXIT??? */
+      exit(EXIT_FAILURE); /* ToDo: abort()? EXIT? */
     }
 
   if(entry != NULL)
     }
 
   if(entry != NULL)
@@ -361,8 +359,7 @@ EVTTYPE evttype;
 P_ tso, node;
 sparkq spark;
 {
 P_ tso, node;
 sparkq spark;
 {
-  extern P_ xmalloc();
-  eventq newentry = (eventq) xmalloc(sizeof(struct event));
+  eventq newentry = (eventq) stgMallocBytes(sizeof(struct event), "newevent");
 
   EVENT_PROC(newentry) = proc;
   EVENT_CREATOR(newentry) = creator;
 
   EVENT_PROC(newentry) = proc;
   EVENT_CREATOR(newentry) = creator;
@@ -395,7 +392,6 @@ PP_ PendingSparksTl[SPARK_POOLS];
 
 static jmp_buf scheduler_loop;
 
 
 static jmp_buf scheduler_loop;
 
-I_ MaxThreads = DEFAULT_MAX_THREADS;
 I_ required_thread_count = 0;
 I_ advisory_thread_count = 0;
 
 I_ required_thread_count = 0;
 I_ advisory_thread_count = 0;
 
@@ -405,27 +401,26 @@ P_ NewThread PROTO((P_, W_));
 
 I_ context_switch = 0;
 
 
 I_ context_switch = 0;
 
-I_ contextSwitchTime = CS_MIN_MILLISECS;  /* In milliseconds */
-
 #if !defined(GRAN)
 
 I_ threadId = 0;
 #if !defined(GRAN)
 
 I_ threadId = 0;
+I_ sparksIgnored =0;
 
 
-I_ MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS;
 I_ SparkLimit[SPARK_POOLS];
 
 I_ SparkLimit[SPARK_POOLS];
 
-extern I_ doSanityChks;
-extern void checkAStack(STG_NO_ARGS);
-
 rtsBool
 rtsBool
-initThreadPools(size)
-I_ size;
+initThreadPools(STG_NO_ARGS)
 {
 {
+    I_ size = RTSflags.ConcFlags.maxLocalSparks;
+
     SparkLimit[ADVISORY_POOL] = SparkLimit[REQUIRED_POOL] = size;
     SparkLimit[ADVISORY_POOL] = SparkLimit[REQUIRED_POOL] = size;
+
     if ((PendingSparksBase[ADVISORY_POOL] = (PP_) malloc(size * sizeof(P_))) == NULL)
        return rtsFalse;
     if ((PendingSparksBase[ADVISORY_POOL] = (PP_) malloc(size * sizeof(P_))) == NULL)
        return rtsFalse;
+
     if ((PendingSparksBase[REQUIRED_POOL] = (PP_) malloc(size * sizeof(P_))) == NULL)
        return rtsFalse;
     if ((PendingSparksBase[REQUIRED_POOL] = (PP_) malloc(size * sizeof(P_))) == NULL)
        return rtsFalse;
+
     PendingSparksLim[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] + size;
     PendingSparksLim[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] + size;
     return rtsTrue;
     PendingSparksLim[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] + size;
     PendingSparksLim[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] + size;
     return rtsTrue;
@@ -440,15 +435,17 @@ void
 ScheduleThreads(topClosure)
 P_ topClosure;
 {
 ScheduleThreads(topClosure)
 P_ topClosure;
 {
+#ifdef GRAN
     I_ i;
     I_ i;
+#endif
     P_ tso;
 
     P_ tso;
 
-#if defined(USE_COST_CENTRES) || defined(GUM)
-    if (time_profiling || contextSwitchTime > 0) {
-        if (initialize_virtual_timer(tick_millisecs)) {
+#if defined(PROFILING) || defined(PAR)
+    if (time_profiling || RTSflags.ConcFlags.ctxtSwitchTime > 0) {
+        if (initialize_virtual_timer(RTSflags.CcFlags.msecsPerTick)) {
 #else
 #else
-    if (contextSwitchTime > 0) {
-        if (initialize_virtual_timer(contextSwitchTime)) {
+    if (RTSflags.ConcFlags.ctxtSwitchTime > 0) {
+        if (initialize_virtual_timer(RTSflags.ConcFlags.ctxtSwitchTime)) {
 #endif
             fflush(stdout);
             fprintf(stderr, "Can't initialize virtual timer.\n");
 #endif
             fflush(stdout);
             fprintf(stderr, "Can't initialize virtual timer.\n");
@@ -486,8 +483,8 @@ P_ topClosure;
         init_qp_profiling();
 
     /*
         init_qp_profiling();
 
     /*
-     * We perform GC so that a signal handler can install a new TopClosure and start
-     * a new main thread.
+     * We perform GC so that a signal handler can install a new
+     * TopClosure and start a new main thread.
      */
 #ifdef PAR
     if (IAmMainThread) {
      */
 #ifdef PAR
     if (IAmMainThread) {
@@ -517,7 +514,7 @@ P_ topClosure;
 #endif
 
 #ifdef PAR
 #endif
 
 #ifdef PAR
-    if (do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
        DumpGranEvent(GR_START, tso);
        sameThread = rtsTrue;
     }
        DumpGranEvent(GR_START, tso);
        sameThread = rtsTrue;
     }
@@ -574,33 +571,37 @@ P_ topClosure;
            fprintf(stderr, "No runnable threads!\n");
            EXIT(EXIT_FAILURE);
        }
            fprintf(stderr, "No runnable threads!\n");
            EXIT(EXIT_FAILURE);
        }
-       AwaitEvent(0);
+       AwaitEvent(RTSflags.ConcFlags.ctxtSwitchTime);
     }
 #else
     if (RunnableThreadsHd == Nil_closure) {
     }
 #else
     if (RunnableThreadsHd == Nil_closure) {
-       if (advisory_thread_count < MaxThreads &&
+       if (advisory_thread_count < RTSflags.ConcFlags.maxThreads &&
           (PendingSparksHd[REQUIRED_POOL] < PendingSparksTl[REQUIRED_POOL] ||
          PendingSparksHd[ADVISORY_POOL] < PendingSparksTl[ADVISORY_POOL])) {
            /* 
           (PendingSparksHd[REQUIRED_POOL] < PendingSparksTl[REQUIRED_POOL] ||
          PendingSparksHd[ADVISORY_POOL] < PendingSparksTl[ADVISORY_POOL])) {
            /* 
-             * If we're here (no runnable threads) and we have pending sparks,
-            * we must have a space problem.  Get enough space to turn one of
-             * those pending sparks into a thread...ReallyPerformGC doesn't 
-             * return until the space is available, so it may force global GC.
-             * ToDo: Is this unnecessary here?  Duplicated in ReSchedule()? --JSM
+            * If we're here (no runnable threads) and we have pending
+            * sparks, we must have a space problem.  Get enough space
+            * to turn one of those pending sparks into a
+            * thread... ReallyPerformGC doesn't return until the
+            * space is available, so it may force global GC.  ToDo:
+            * Is this unnecessary here?  Duplicated in ReSchedule()?
+            * --JSM
              */
            ReallyPerformThreadGC(THREAD_SPACE_REQUIRED, rtsTrue);
            SAVE_Hp -= THREAD_SPACE_REQUIRED;
        } else {
            /*
              */
            ReallyPerformThreadGC(THREAD_SPACE_REQUIRED, rtsTrue);
            SAVE_Hp -= THREAD_SPACE_REQUIRED;
        } else {
            /*
-             * We really have absolutely no work.  Send out a fish (there may be
-             * some out there already), and wait for something to arrive.  We 
-             * clearly can't run any threads until a SCHEDULE or RESUME arrives, 
-             * and so that's what we're hoping to see.  (Of course, we still have 
-             * to respond to other types of messages.)
+            * We really have absolutely no work.  Send out a fish
+            * (there may be some out there already), and wait for
+            * something to arrive.  We clearly can't run any threads
+            * until a SCHEDULE or RESUME arrives, and so that's what
+            * we're hoping to see.  (Of course, we still have to
+            * respond to other types of messages.)
              */
            if (!fishing)
                sendFish(choosePE(), mytid, NEW_FISH_AGE, NEW_FISH_HISTORY, 
                   NEW_FISH_HUNGER);
              */
            if (!fishing)
                sendFish(choosePE(), mytid, NEW_FISH_AGE, NEW_FISH_HISTORY, 
                   NEW_FISH_HUNGER);
+
            processMessages();
        }
        ReSchedule(0);
            processMessages();
        }
        ReSchedule(0);
@@ -614,7 +615,7 @@ P_ topClosure;
     }
 
 #ifdef PAR
     }
 
 #ifdef PAR
-    if (do_gr_profile && !sameThread)
+    if (RTSflags.ParFlags.granSimStats && !sameThread)
         DumpGranEvent(GR_SCHEDULE, RunnableThreadsHd);
 #endif
 
         DumpGranEvent(GR_SCHEDULE, RunnableThreadsHd);
 #endif
 
@@ -635,7 +636,7 @@ P_ topClosure;
 #endif
 
     /* If we're not running a timer, just leave the flag on */
 #endif
 
     /* If we're not running a timer, just leave the flag on */
-    if (contextSwitchTime > 0)
+    if (RTSflags.ConcFlags.ctxtSwitchTime > 0)
         context_switch = 0;
 
 #if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
         context_switch = 0;
 
 #if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
@@ -661,14 +662,7 @@ P_ topClosure;
     }
 #endif
 
     }
 #endif
 
-# if defined(__STG_TAILJUMPS__)
     miniInterpret((StgFunPtr)resumeThread);
     miniInterpret((StgFunPtr)resumeThread);
-# else
-    if (doSanityChks)
-        miniInterpret_debug((StgFunPtr)resumeThread, checkAStack);
-    else
-        miniInterpret((StgFunPtr)resumeThread);
-# endif /* __STG_TAILJUMPS__ */
 }
 \end{code}
 
 }
 \end{code}
 
@@ -724,13 +718,13 @@ int what_next;           /* Run the current thread again? */
       /* This code does round-Robin, if preferred. */
       if(DoFairSchedule && TSO_LINK(CurrentTSO) != Nil_closure)
         {
       /* This code does round-Robin, if preferred. */
       if(DoFairSchedule && TSO_LINK(CurrentTSO) != Nil_closure)
         {
-          if(do_gr_profile)
+          if(RTSflags.ParFlags.granSimStats)
             DumpGranEvent(GR_DESCHEDULE,ThreadQueueHd);
           ThreadQueueHd =           TSO_LINK(CurrentTSO);
           TSO_LINK(ThreadQueueTl) = CurrentTSO;
           ThreadQueueTl =           CurrentTSO;
           TSO_LINK(CurrentTSO) =    Nil_closure;
             DumpGranEvent(GR_DESCHEDULE,ThreadQueueHd);
           ThreadQueueHd =           TSO_LINK(CurrentTSO);
           TSO_LINK(ThreadQueueTl) = CurrentTSO;
           ThreadQueueTl =           CurrentTSO;
           TSO_LINK(CurrentTSO) =    Nil_closure;
-          if (do_gr_profile)
+          if (RTSflags.ParFlags.granSimStats)
             DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
           CurrentTime[CurrentProc] += gran_threadcontextswitchtime;
         }
             DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
           CurrentTime[CurrentProc] += gran_threadcontextswitchtime;
         }
@@ -747,7 +741,7 @@ int what_next;           /* Run the current thread again? */
         }
 #endif
 
         }
 #endif
 
-      if(do_gr_profile)
+      if(RTSflags.ParFlags.granSimStats)
         DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
 
       CurrentTSO = ThreadQueueHd;
         DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
 
       CurrentTSO = ThreadQueueHd;
@@ -908,7 +902,7 @@ int what_next;           /* Run the current thread again? */
           ++TSO_FETCHCOUNT(EVENT_TSO(event));
           TSO_FETCHTIME(EVENT_TSO(event)) += gran_fetchtime;
               
           ++TSO_FETCHCOUNT(EVENT_TSO(event));
           TSO_FETCHTIME(EVENT_TSO(event)) += gran_fetchtime;
               
-          if (do_gr_profile)
+          if (RTSflags.ParFlags.granSimStats)
             DumpGranEventAndNode(GR_REPLY,EVENT_TSO(event),
                                  EVENT_NODE(event),EVENT_CREATOR(event));
 
             DumpGranEventAndNode(GR_REPLY,EVENT_TSO(event),
                                  EVENT_NODE(event),EVENT_CREATOR(event));
 
@@ -926,7 +920,7 @@ int what_next;           /* Run the current thread again? */
                      CONTINUETHREAD,Nil_closure,Nil_closure,NULL);
             TSO_BLOCKTIME(EVENT_TSO(event)) += CurrentTime[CurrentProc] - 
                                                TSO_BLOCKEDAT(EVENT_TSO(event));
                      CONTINUETHREAD,Nil_closure,Nil_closure,NULL);
             TSO_BLOCKTIME(EVENT_TSO(event)) += CurrentTime[CurrentProc] - 
                                                TSO_BLOCKEDAT(EVENT_TSO(event));
-            if(do_gr_profile)
+            if(RTSflags.ParFlags.granSimStats)
               DumpGranEvent(GR_RESUME,EVENT_TSO(event));
             continue;
           } else {
               DumpGranEvent(GR_RESUME,EVENT_TSO(event));
             continue;
           } else {
@@ -991,7 +985,7 @@ int what_next;           /* Run the current thread again? */
                       if(do_sp_profile)
                         DumpSparkGranEvent(SP_PRUNED,spark);
 
                       if(do_sp_profile)
                         DumpSparkGranEvent(SP_PRUNED,spark);
 
-                      assert(spark != NULL);
+                     ASSERT(spark != NULL);
 
                       SparkQueueHd = SPARK_NEXT(spark);
                       if(SparkQueueHd == NULL)
 
                       SparkQueueHd = SPARK_NEXT(spark);
                       if(SparkQueueHd == NULL)
@@ -1058,7 +1052,7 @@ int what_next;           /* Run the current thread again? */
                   newevent(CurrentProc,CurrentProc,CurrentTime[CurrentProc],
                            STARTTHREAD,tso,Nil_closure,NULL);
 
                   newevent(CurrentProc,CurrentProc,CurrentTime[CurrentProc],
                            STARTTHREAD,tso,Nil_closure,NULL);
 
-                  assert(spark != NULL);
+                 ASSERT(spark != NULL);
 
                   SparkQueueHd = SPARK_NEXT(spark);
                   if(SparkQueueHd == NULL)
 
                   SparkQueueHd = SPARK_NEXT(spark);
                   if(SparkQueueHd == NULL)
@@ -1128,11 +1122,11 @@ int again;                              /* Run the current thread again? */
 #ifdef PAR
     /* 
      * In the parallel world, we do unfair scheduling for the moment.
 #ifdef PAR
     /* 
      * In the parallel world, we do unfair scheduling for the moment.
-     * Ultimately, this should all be merged with the more sophicticated
-     * GrAnSim scheduling options.  (Of course, some provision should be
-     * made for *required* threads to make sure that they don't starve,
-     * but for now we assume that no one is running concurrent Haskell on
-     * a multi-processor platform.)
+     * Ultimately, this should all be merged with the more
+     * sophisticated GrAnSim scheduling options.  (Of course, some
+     * provision should be made for *required* threads to make sure
+     * that they don't starve, but for now we assume that no one is
+     * running concurrent Haskell on a multi-processor platform.)
      */
 
     sameThread = again;
      */
 
     sameThread = again;
@@ -1186,7 +1180,7 @@ int again;                                /* Run the current thread again? */
             if (RunnableThreadsHd == Nil_closure) {
                RunnableThreadsHd = tso;
 #ifdef PAR
             if (RunnableThreadsHd == Nil_closure) {
                RunnableThreadsHd = tso;
 #ifdef PAR
-               if (do_gr_profile) {
+               if (RTSflags.ParFlags.granSimStats) {
                    DumpGranEvent(GR_START, tso);
                    sameThread = rtsTrue;
                }
                    DumpGranEvent(GR_START, tso);
                    sameThread = rtsTrue;
                }
@@ -1194,7 +1188,7 @@ int again;                                /* Run the current thread again? */
            } else {
                TSO_LINK(RunnableThreadsTl) = tso;
 #ifdef PAR
            } else {
                TSO_LINK(RunnableThreadsTl) = tso;
 #ifdef PAR
-               if (do_gr_profile)
+               if (RTSflags.ParFlags.granSimStats)
                    DumpGranEvent(GR_STARTQ, tso);
 #endif
            }
                    DumpGranEvent(GR_STARTQ, tso);
 #endif
            }
@@ -1224,14 +1218,14 @@ int again;                              /* Run the current thread again? */
              (RunnableThreadsHd != Nil_closure ||
               (required_thread_count == 0 && IAmMainThread)) || 
 #endif
              (RunnableThreadsHd != Nil_closure ||
               (required_thread_count == 0 && IAmMainThread)) || 
 #endif
-             advisory_thread_count == MaxThreads ||
+             advisory_thread_count == RTSflags.ConcFlags.maxThreads ||
              (tso = NewThread(spark, T_ADVISORY)) == NULL)
                break;
            advisory_thread_count++;
             if (RunnableThreadsHd == Nil_closure) {
                RunnableThreadsHd = tso;
 #ifdef PAR
              (tso = NewThread(spark, T_ADVISORY)) == NULL)
                break;
            advisory_thread_count++;
             if (RunnableThreadsHd == Nil_closure) {
                RunnableThreadsHd = tso;
 #ifdef PAR
-               if (do_gr_profile) {
+               if (RTSflags.ParFlags.granSimStats) {
                    DumpGranEvent(GR_START, tso);
                    sameThread = rtsTrue;
                }
                    DumpGranEvent(GR_START, tso);
                    sameThread = rtsTrue;
                }
@@ -1239,7 +1233,7 @@ int again;                                /* Run the current thread again? */
             } else {
                TSO_LINK(RunnableThreadsTl) = tso;
 #ifdef PAR
             } else {
                TSO_LINK(RunnableThreadsTl) = tso;
 #ifdef PAR
-               if (do_gr_profile)
+               if (RTSflags.ParFlags.granSimStats)
                    DumpGranEvent(GR_STARTQ, tso);
 #endif
            }
                    DumpGranEvent(GR_STARTQ, tso);
 #endif
            }
@@ -1288,7 +1282,7 @@ enum gran_event_types event_type;
       CurrentTSO = ThreadQueueHd = ThreadQueueTl = EVENT_TSO(event);
       newevent(CurrentProc,CurrentProc,CurrentTime[CurrentProc]+gran_threadqueuetime,
                CONTINUETHREAD,Nil_closure,Nil_closure,NULL);
       CurrentTSO = ThreadQueueHd = ThreadQueueTl = EVENT_TSO(event);
       newevent(CurrentProc,CurrentProc,CurrentTime[CurrentProc]+gran_threadqueuetime,
                CONTINUETHREAD,Nil_closure,Nil_closure,NULL);
-      if(do_gr_profile)
+      if(RTSflags.ParFlags.granSimStats)
         DumpGranEvent(event_type,EVENT_TSO(event));
     }
   else
         DumpGranEvent(event_type,EVENT_TSO(event));
     }
   else
@@ -1299,7 +1293,7 @@ enum gran_event_types event_type;
       if(DoThreadMigration)
         ++SurplusThreads;
 
       if(DoThreadMigration)
         ++SurplusThreads;
 
-      if(do_gr_profile)
+      if(RTSflags.ParFlags.granSimStats)
         DumpGranEvent(event_type+1,EVENT_TSO(event));
 
     }
         DumpGranEvent(event_type+1,EVENT_TSO(event));
 
     }
@@ -1498,7 +1492,7 @@ PROC proc;
               MAKE_BUSY(proc);
               --SurplusThreads;
 
               MAKE_BUSY(proc);
               --SurplusThreads;
 
-              if(do_gr_profile)
+              if(RTSflags.ParFlags.granSimStats)
                 DumpRawGranEvent(p,GR_STEALING,TSO_ID(thread));
           
               CurrentTime[p] += 5l * gran_mtidytime;
                 DumpRawGranEvent(p,GR_STEALING,TSO_ID(thread));
           
               CurrentTime[p] += 5l * gran_mtidytime;
@@ -1543,7 +1537,7 @@ UNVEC(EXTFUN(stopThreadDirectReturn);,EXTDATA(vtbl_stopStgWorld);)
 
 #if defined(GRAN)
 
 
 #if defined(GRAN)
 
-/* Slow but relatively reliable method uses xmalloc */
+/* Slow but relatively reliable method uses stgMallocBytes */
 /* Eventually change that to heap allocated sparks. */
 
 sparkq 
 /* Eventually change that to heap allocated sparks. */
 
 sparkq 
@@ -1551,8 +1545,8 @@ NewSpark(node,name,local)
 P_ node;
 I_ name, local;
 {
 P_ node;
 I_ name, local;
 {
-  extern P_ xmalloc();
-  sparkq newspark = (sparkq) xmalloc(sizeof(struct spark));
+  sparkq newspark = (sparkq) stgMallocBytes(sizeof(struct spark), "NewSpark");
+
   SPARK_PREV(newspark) = SPARK_NEXT(newspark) = NULL;
   SPARK_NODE(newspark) = node;
   SPARK_NAME(newspark) = name;
   SPARK_PREV(newspark) = SPARK_NEXT(newspark) = NULL;
   SPARK_NODE(newspark) = node;
   SPARK_NAME(newspark) = name;
@@ -1594,8 +1588,6 @@ sparkq spark;
 
 #endif
 
 
 #endif
 
-I_ StkOChunkSize = DEFAULT_STKO_CHUNK_SIZE;
-
 /* Create a new TSO, with the specified closure to enter and thread type */
 
 P_
 /* Create a new TSO, with the specified closure to enter and thread type */
 
 P_
@@ -1622,7 +1614,9 @@ W_ type;
     }
 
     TSO_LINK(tso) = Nil_closure;
     }
 
     TSO_LINK(tso) = Nil_closure;
+#ifdef PAR
     TSO_CCC(tso) = (CostCentre)STATIC_CC_REF(CC_MAIN);
     TSO_CCC(tso) = (CostCentre)STATIC_CC_REF(CC_MAIN);
+#endif
     TSO_NAME(tso) = (P_) INFO_PTR(topClosure);  /* A string would be nicer -- JSM */
     TSO_ID(tso) = threadId++;
     TSO_TYPE(tso) = type;
     TSO_NAME(tso) = (P_) INFO_PTR(topClosure);  /* A string would be nicer -- JSM */
     TSO_ID(tso) = threadId++;
     TSO_TYPE(tso) = type;
@@ -1630,7 +1624,7 @@ W_ type;
     TSO_ARG1(tso) = TSO_EVENT(tso) = 0;
     TSO_SWITCH(tso) = NULL;
 
     TSO_ARG1(tso) = TSO_EVENT(tso) = 0;
     TSO_SWITCH(tso) = NULL;
 
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
     TSO_AHWM(tso) = 0;
     TSO_BHWM(tso) = 0;
 #endif
     TSO_AHWM(tso) = 0;
     TSO_BHWM(tso) = 0;
 #endif
@@ -1672,15 +1666,15 @@ W_ type;
             SET_PROCS(stko,ThisPE);
 #endif
            AvailableStack = STKO_LINK(AvailableStack);
             SET_PROCS(stko,ThisPE);
 #endif
            AvailableStack = STKO_LINK(AvailableStack);
-        } else if (SAVE_Hp + STKO_HS + StkOChunkSize > SAVE_HpLim) {
+        } else if (SAVE_Hp + STKO_HS + RTSflags.ConcFlags.stkChunkSize > SAVE_HpLim) {
             return(NULL);
         } else {
             return(NULL);
         } else {
-            ALLOC_STK(STKO_HS,StkOChunkSize,0);
+            ALLOC_STK(STKO_HS,RTSflags.ConcFlags.stkChunkSize,0);
             stko = SAVE_Hp + 1;
             stko = SAVE_Hp + 1;
-           SAVE_Hp += STKO_HS + StkOChunkSize;
+           SAVE_Hp += STKO_HS + RTSflags.ConcFlags.stkChunkSize;
             SET_STKO_HDR(stko, StkO_info, CCC);
         }
             SET_STKO_HDR(stko, StkO_info, CCC);
         }
-        STKO_SIZE(stko) = StkOChunkSize + STKO_VHS;
+        STKO_SIZE(stko) = RTSflags.ConcFlags.stkChunkSize + STKO_VHS;
         STKO_SpB(stko) = STKO_SuB(stko) = STKO_BSTK_BOT(stko) + BREL(1);
         STKO_SpA(stko) = STKO_SuA(stko) = STKO_ASTK_BOT(stko) + AREL(1);
         STKO_LINK(stko) = Nil_closure;
         STKO_SpB(stko) = STKO_SuB(stko) = STKO_BSTK_BOT(stko) + BREL(1);
         STKO_SpA(stko) = STKO_SuA(stko) = STKO_ASTK_BOT(stko) + AREL(1);
         STKO_LINK(stko) = Nil_closure;
@@ -1689,7 +1683,7 @@ W_ type;
     }
 # endif
     
     }
 # endif
     
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
     STKO_ADEP(stko) = STKO_BDEP(stko) = 0;
 #endif
 
     STKO_ADEP(stko) = STKO_BDEP(stko) = 0;
 #endif
 
@@ -1701,6 +1695,8 @@ W_ type;
     SAVE_Ret = (StgRetAddr) UNVEC(stopThreadDirectReturn,vtbl_stopStgWorld);
     SAVE_StkO = stko;
 
     SAVE_Ret = (StgRetAddr) UNVEC(stopThreadDirectReturn,vtbl_stopStgWorld);
     SAVE_StkO = stko;
 
+    ASSERT(sanityChk_StkO(stko));
+
     if (DO_QP_PROF) {
         QP_Event1(do_qp_prof > 1 ? "*A" : "*G", tso);
     }
     if (DO_QP_PROF) {
         QP_Event1(do_qp_prof > 1 ? "*A" : "*G", tso);
     }
@@ -1716,14 +1712,14 @@ EndThread(STG_NO_ARGS)
 #ifdef PAR
     TIME now = CURRENT_TIME;
 #endif
 #ifdef PAR
     TIME now = CURRENT_TIME;
 #endif
-#ifdef DO_REDN_COUNTING
-    extern FILE *tickyfile;
-
-    if (tickyfile != NULL) {
-       fprintf(tickyfile, "Thread %d (%lx)\n\tA stack max. depth: %ld words\n",
-         TSO_ID(CurrentTSO), TSO_NAME(CurrentTSO), TSO_AHWM(CurrentTSO));
-       fprintf(tickyfile, "\tB stack max. depth: %ld words\n",
-         TSO_BHWM(CurrentTSO));
+#ifdef TICKY_TICKY
+    if (RTSflags.TickyFlags.showTickyStats) {
+       fprintf(RTSflags.TickyFlags.tickyFile,
+               "Thread %d (%lx)\n\tA stack max. depth: %ld words\n",
+               TSO_ID(CurrentTSO), TSO_NAME(CurrentTSO), TSO_AHWM(CurrentTSO));
+       fprintf(RTSflags.TickyFlags.tickyFile,
+               "\tB stack max. depth: %ld words\n",
+               TSO_BHWM(CurrentTSO));
     }
 #endif
 
     }
 #endif
 
@@ -1732,7 +1728,7 @@ EndThread(STG_NO_ARGS)
     }
 
 #if defined(GRAN)
     }
 
 #if defined(GRAN)
-    assert(CurrentTSO == ThreadQueueHd);
+    ASSERT(CurrentTSO == ThreadQueueHd);
     ThreadQueueHd = TSO_LINK(CurrentTSO);
 
     if(ThreadQueueHd == Nil_closure)
     ThreadQueueHd = TSO_LINK(CurrentTSO);
 
     if(ThreadQueueHd == Nil_closure)
@@ -1754,7 +1750,7 @@ EndThread(STG_NO_ARGS)
                   /* make the job of bookkeeping the running, runnable, */
                   /* blocked threads easier for scripts like gr2ps  -- HWL */ 
 
                   /* make the job of bookkeeping the running, runnable, */
                   /* blocked threads easier for scripts like gr2ps  -- HWL */ 
 
-                  if (do_gr_profile && !is_first)
+                  if (RTSflags.ParFlags.granSimStats && !is_first)
                     DumpRawGranEvent(i,GR_SCHEDULE,
                                      TSO_ID(RunnableThreadsHd[i]));
                  if (!no_gr_profile)
                     DumpRawGranEvent(i,GR_SCHEDULE,
                                      TSO_ID(RunnableThreadsHd[i]));
                  if (!no_gr_profile)
@@ -1790,19 +1786,19 @@ EndThread(STG_NO_ARGS)
         /* Note ThreadQueueHd is Nil when the main thread terminates */
         if(ThreadQueueHd != Nil_closure)
           {
         /* Note ThreadQueueHd is Nil when the main thread terminates */
         if(ThreadQueueHd != Nil_closure)
           {
-            if (do_gr_profile && !no_gr_profile)
+            if (RTSflags.ParFlags.granSimStats && !no_gr_profile)
               DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
             CurrentTime[CurrentProc] += gran_threadscheduletime;
           }
 
               DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
             CurrentTime[CurrentProc] += gran_threadscheduletime;
           }
 
-        else if (do_gr_binary && TSO_TYPE(CurrentTSO)==T_MAIN &&
+        else if (RTSflags.ParFlags.granSimStats_Binary && TSO_TYPE(CurrentTSO)==T_MAIN &&
                 !no_gr_profile)
           grterminate(CurrentTime[CurrentProc]);
       }
 #endif  /* GRAN */
 
 #ifdef PAR
                 !no_gr_profile)
           grterminate(CurrentTime[CurrentProc]);
       }
 #endif  /* GRAN */
 
 #ifdef PAR
-    if (do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
        DumpGranInfo(thisPE, CurrentTSO, TSO_TYPE(CurrentTSO) != T_ADVISORY);
     }
         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
        DumpGranInfo(thisPE, CurrentTSO, TSO_TYPE(CurrentTSO) != T_ADVISORY);
     }
@@ -1812,7 +1808,7 @@ EndThread(STG_NO_ARGS)
     case T_MAIN:
         required_thread_count--;
 #ifdef PAR
     case T_MAIN:
         required_thread_count--;
 #ifdef PAR
-        if (do_gr_binary)
+        if (RTSflags.ParFlags.granSimStats_Binary)
             grterminate(now);
 #endif
 
             grterminate(now);
 #endif
 
@@ -1913,7 +1909,7 @@ AwakenBlockingQueue(bqe)
                QP_Event2(do_qp_prof > 1 ? "RA" : "RG", bqe, CurrentTSO);
            }
 # ifdef PAR
                QP_Event2(do_qp_prof > 1 ? "RA" : "RG", bqe, CurrentTSO);
            }
 # ifdef PAR
-           if (do_gr_profile) {
+           if (RTSflags.ParFlags.granSimStats) {
                DumpGranEvent(GR_RESUMEQ, bqe);
                switch (TSO_QUEUE(bqe)) {
                case Q_BLOCKED:
                DumpGranEvent(GR_RESUMEQ, bqe);
                switch (TSO_QUEUE(bqe)) {
                case Q_BLOCKED:
@@ -1993,7 +1989,7 @@ AwakenBlockingQueue(node)
 
         while(tso != Nil_closure) {
           W_ proc;
 
         while(tso != Nil_closure) {
           W_ proc;
-          assert(TSO_INTERNAL_PTR(tso)->rR[0].p == node);
+         ASSERT(TSO_INTERNAL_PTR(tso)->rR[0].p == node);
 
 # if defined(COUNT)
           ++BQ_lens;
 
 # if defined(COUNT)
           ++BQ_lens;
@@ -2028,14 +2024,14 @@ AwakenBlockingQueue(node)
          TSO_LINK(ThreadQueueTl) = tso;
 
         while(TSO_LINK(tso) != Nil_closure) {
          TSO_LINK(ThreadQueueTl) = tso;
 
         while(TSO_LINK(tso) != Nil_closure) {
-          assert(TSO_INTERNAL_PTR(tso)->rR[0].p == node);
+          ASSERT(TSO_INTERNAL_PTR(tso)->rR[0].p == node);
           if (DO_QP_PROF) {
             QP_Event2(do_qp_prof > 1 ? "RA" : "RG", tso, CurrentTSO);
           }
           tso = TSO_LINK(tso);
         }
         
           if (DO_QP_PROF) {
             QP_Event2(do_qp_prof > 1 ? "RA" : "RG", tso, CurrentTSO);
           }
           tso = TSO_LINK(tso);
         }
         
-        assert(TSO_INTERNAL_PTR(tso)->rR[0].p == node);
+        ASSERT(TSO_INTERNAL_PTR(tso)->rR[0].p == node);
         if (DO_QP_PROF) {
           QP_Event2(do_qp_prof > 1 ? "RA" : "RG", tso, CurrentTSO);
         }
         if (DO_QP_PROF) {
           QP_Event2(do_qp_prof > 1 ? "RA" : "RG", tso, CurrentTSO);
         }
@@ -2060,7 +2056,7 @@ W_ args;
        QP_Event1("GR", CurrentTSO);
     }
 #ifdef PAR
        QP_Event1("GR", CurrentTSO);
     }
 #ifdef PAR
-    if (do_gr_profile) {
+    if (RTSflags.ParFlags.granSimStats) {
         /* Note that CURRENT_TIME may perform an unsafe call */
        TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO);
     }
         /* Note that CURRENT_TIME may perform an unsafe call */
        TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO);
     }
@@ -2100,7 +2096,8 @@ FetchNode(node,from,to)
 P_ node;
 PROC from, to;
 {
 P_ node;
 PROC from, to;
 {
-  assert(to==CurrentProc);
+  ASSERT(to==CurrentProc);
+
   if (!IS_LOCAL_TO(PROCS(node),from) &&
       !IS_LOCAL_TO(PROCS(node),to) ) 
     return 1;
   if (!IS_LOCAL_TO(PROCS(node),from) &&
       !IS_LOCAL_TO(PROCS(node),to) ) 
     return 1;
@@ -2135,7 +2132,7 @@ PROC p;
     {                               /* start tso                           */ 
       newevent(p,CurrentProc,
                CurrentTime[CurrentProc] /* +gran_latency */,
     {                               /* start tso                           */ 
       newevent(p,CurrentProc,
                CurrentTime[CurrentProc] /* +gran_latency */,
-               FETCHREPLY,tso,node,NULL);            /* node needed ?? */
+               FETCHREPLY,tso,node,NULL);            /* node needed ? */
       CurrentTime[CurrentProc] += gran_mtidytime;
     }
   else if (IS_LOCAL_TO(PROCS(node),CurrentProc) )   /* Is node still here? */
       CurrentTime[CurrentProc] += gran_mtidytime;
     }
   else if (IS_LOCAL_TO(PROCS(node),CurrentProc) )   /* Is node still here? */
@@ -2146,7 +2143,7 @@ PROC p;
 
       newevent(p,CurrentProc,
                CurrentTime[CurrentProc]+gran_latency,
 
       newevent(p,CurrentProc,
                CurrentTime[CurrentProc]+gran_latency,
-               FETCHREPLY,tso,node,NULL);            /* node needed ?? */
+               FETCHREPLY,tso,node,NULL);            /* node needed ? */
       
       CurrentTime[CurrentProc] += gran_mtidytime;
     }
       
       CurrentTime[CurrentProc] += gran_mtidytime;
     }
@@ -2159,7 +2156,7 @@ PROC p;
       if (NoForward) {
         newevent(p,p_new,
                  max(CurrentTime[p_new],CurrentTime[CurrentProc])+gran_latency,
       if (NoForward) {
         newevent(p,p_new,
                  max(CurrentTime[p_new],CurrentTime[CurrentProc])+gran_latency,
-                 FETCHREPLY,tso,node,NULL);            /* node needed ?? */
+                 FETCHREPLY,tso,node,NULL);            /* node needed ? */
         CurrentTime[CurrentProc] += gran_mtidytime;
         return;
       }
         CurrentTime[CurrentProc] += gran_mtidytime;
         return;
       }
@@ -2205,7 +2202,7 @@ int prog_argc, rts_argc;
 
     if(do_gr_sim)
       { 
 
     if(do_gr_sim)
       { 
-        char *extension = do_gr_binary? "gb": "gr";
+        char *extension = RTSflags.ParFlags.granSimStats_Binary? "gb": "gr";
         sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0],extension);
 
         if ((gr_file = fopen(gr_filename,"w")) == NULL ) 
         sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0],extension);
 
         if ((gr_file = fopen(gr_filename,"w")) == NULL ) 
@@ -2283,7 +2280,7 @@ int prog_argc, rts_argc;
         fputs("\n\n++++++++++++++++++++\n\n",gr_file);
       }
 
         fputs("\n\n++++++++++++++++++++\n\n",gr_file);
       }
 
-    if(do_gr_binary)
+    if(RTSflags.ParFlags.granSimStats_Binary)
       grputw(sizeof(TIME));
 
     Idlers = max_proc;
       grputw(sizeof(TIME));
 
     Idlers = max_proc;
@@ -2339,7 +2336,10 @@ init_qp_profiling(STG_NO_ARGS)
             fputc(' ', qp_file);
             fputs(prog_argv[i], qp_file);
         }
             fputc(' ', qp_file);
             fputs(prog_argv[i], qp_file);
         }
-        fprintf(qp_file, " +RTS -C%d -t%d\n", contextSwitchTime, MaxThreads);
+        fprintf(qp_file, " +RTS -C%d -t%d\n"
+               , RTSflags.ConcFlags.ctxtSwitchTime
+               , RTSflags.ConcFlags.maxThreads);
+
         fputs(time_str(), qp_file);
         fputc('\n', qp_file);
     }
         fputs(time_str(), qp_file);
         fputc('\n', qp_file);
     }
@@ -2406,7 +2406,7 @@ ActivateNextThread ()
   if(ThreadQueueHd==Nil_closure) {
     MAKE_IDLE(CurrentProc);
     ThreadQueueTl = Nil_closure;
   if(ThreadQueueHd==Nil_closure) {
     MAKE_IDLE(CurrentProc);
     ThreadQueueTl = Nil_closure;
-  } else if (do_gr_profile) {
+  } else if (RTSflags.ParFlags.granSimStats) {
     CurrentTime[CurrentProc] += gran_threadcontextswitchtime;
     DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
   }
     CurrentTime[CurrentProc] += gran_threadcontextswitchtime;
     DumpGranEvent(GR_SCHEDULE,ThreadQueueHd);
   }
@@ -2526,7 +2526,7 @@ P_ node;
                  -- assumes head of queue == CurrentTSO */
               if(!DoFairSchedule)
                 {
                  -- assumes head of queue == CurrentTSO */
               if(!DoFairSchedule)
                 {
-                  if(do_gr_profile)
+                  if(RTSflags.ParFlags.granSimStats)
                     DumpGranEventAndNode(GR_FETCH,CurrentTSO,node,p);
 
                   ActivateNextThread();
                     DumpGranEventAndNode(GR_FETCH,CurrentTSO,node,p);
 
                   ActivateNextThread();
@@ -2560,7 +2560,7 @@ P_ node;
           else                                /* !DoReScheduleOnFetch */
             {
               /* Note: CurrentProc is still busy as it's blocked on fetch */
           else                                /* !DoReScheduleOnFetch */
             {
               /* Note: CurrentProc is still busy as it's blocked on fetch */
-              if(do_gr_profile)
+              if(RTSflags.ParFlags.granSimStats)
                 DumpGranEventAndNode(GR_FETCH,CurrentTSO,node,p);
 
 #if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
                 DumpGranEventAndNode(GR_FETCH,CurrentTSO,node,p);
 
 #if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
@@ -2640,7 +2640,7 @@ I_ identifier;
 void 
 GranSimBlock()
 {
 void 
 GranSimBlock()
 {
-  if(do_gr_profile)
+  if(RTSflags.ParFlags.granSimStats)
     DumpGranEvent(GR_BLOCK,CurrentTSO);
 
   ++TSO_BLOCKCOUNT(CurrentTSO);
     DumpGranEvent(GR_BLOCK,CurrentTSO);
 
   ++TSO_BLOCKCOUNT(CurrentTSO);
@@ -2717,7 +2717,7 @@ I_ num_ptr_roots;
             {
 #if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
             {
 #if defined(GRAN_CHECK) && defined(GRAN)
              if ( debug & 0x40 ) 
-               fprintf(main_statsfile,"Saving Spark Root %d(proc: %d; pool: %d) -- 0x%lx\n",
+               fprintf(RTSflags.GcFlags.statsFile,"Saving Spark Root %d(proc: %d; pool: %d) -- 0x%lx\n",
                        num_ptr_roots,proc,i,SPARK_NODE(spark));
 #endif       
               StorageMgrInfo.roots[num_ptr_roots++] = SPARK_NODE(spark);
                        num_ptr_roots,proc,i,SPARK_NODE(spark));
 #endif       
               StorageMgrInfo.roots[num_ptr_roots++] = SPARK_NODE(spark);
@@ -2735,7 +2735,7 @@ I_ num_ptr_roots;
             }
         }  /* forall spark ... */
         if (prunedSparks>0) {
             }
         }  /* forall spark ... */
         if (prunedSparks>0) {
-          fprintf(main_statsfile,"Pruning and disposing %lu excess sparks (> %lu) on proc %d for GC purposes\n",
+          fprintf(RTSflags.GcFlags.statsFile,"Pruning and disposing %lu excess sparks (> %lu) on proc %d for GC purposes\n",
                   prunedSparks,MAX_SPARKS,proc);
          if (disposeQ == PendingSparksHd[proc][i])
            PendingSparksHd[proc][i] = NULL;
                   prunedSparks,MAX_SPARKS,proc);
          if (disposeQ == PendingSparksHd[proc][i])
            PendingSparksHd[proc][i] = NULL;
@@ -2806,14 +2806,14 @@ I_ num_ptr_roots, sparkroots;
           SPARK_NODE(spark) = StorageMgrInfo.roots[--num_ptr_roots];
 #if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
           SPARK_NODE(spark) = StorageMgrInfo.roots[--num_ptr_roots];
 #if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
-           fprintf(main_statsfile,"Restoring Spark Root %d -- new: 0x%lx \n",
+           fprintf(RTSflags.GcFlags.statsFile,"Restoring Spark Root %d -- new: 0x%lx \n",
                    num_ptr_roots,SPARK_NODE(spark));
 #endif
         }
       else
 #if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
                    num_ptr_roots,SPARK_NODE(spark));
 #endif
         }
       else
 #if defined(GRAN_CHECK) && defined(GRAN)
          if ( debug & 0x40 ) 
-           fprintf(main_statsfile,"Error in RestoreSpkRoots (%d; @ spark 0x%x): More than MAX_SPARKS (%d) sparks\n",
+           fprintf(RTSflags.GcFlags.statsFile,"Error in RestoreSpkRoots (%d; @ spark 0x%x): More than MAX_SPARKS (%d) sparks\n",
                    num_ptr_roots,SPARK_NODE(spark),MAX_SPARKS);
 #endif
 
                    num_ptr_roots,SPARK_NODE(spark),MAX_SPARKS);
 #endif
 
@@ -2882,7 +2882,7 @@ PROC proc;
   if(name > GR_EVENT_MAX)
     name = GR_EVENT_MAX;
 
   if(name > GR_EVENT_MAX)
     name = GR_EVENT_MAX;
 
-  if(do_gr_binary)
+  if(RTSflags.ParFlags.granSimStats_Binary)
     {
       grputw(name);
       grputw(pe);
     {
       grputw(name);
       grputw(pe);
@@ -2902,7 +2902,7 @@ W_ id;
   if(name > GR_EVENT_MAX)
     name = GR_EVENT_MAX;
 
   if(name > GR_EVENT_MAX)
     name = GR_EVENT_MAX;
 
-  if(do_gr_binary)
+  if(RTSflags.ParFlags.granSimStats_Binary)
     {
       grputw(name);
       grputw(pe);
     {
       grputw(name);
       grputw(pe);
@@ -2919,7 +2919,7 @@ PROC pe;
 P_ tso;
 I_ mandatory_thread;
 {
 P_ tso;
 I_ mandatory_thread;
 {
-  if(do_gr_binary)
+  if(RTSflags.ParFlags.granSimStats_Binary)
     {
       grputw(GR_END);
       grputw(pe);
     {
       grputw(GR_END);
       grputw(pe);
@@ -3327,7 +3327,7 @@ P_ node;
    fprintf(stderr," [GA: 0x%lx]",GA(node));
 #endif
 
    fprintf(stderr," [GA: 0x%lx]",GA(node));
 #endif
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
 #endif
 
    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
 #endif
 
@@ -3399,7 +3399,7 @@ P_ node;
   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 #endif
 
   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 #endif
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
   fprintf(stderr,"Cost Centre (???):       0x%lx\n",INFO_CAT(info_ptr));
 #endif
 
   fprintf(stderr,"Cost Centre (???):       0x%lx\n",INFO_CAT(info_ptr));
 #endif
 
@@ -3659,7 +3659,10 @@ init_qp_profiling(STG_NO_ARGS)
            fputc(' ', qp_file);
            fputs(prog_argv[i], qp_file);
        }
            fputc(' ', qp_file);
            fputs(prog_argv[i], qp_file);
        }
-       fprintf(qp_file, "+RTS -C%ld -t%ld\n", contextSwitchTime, MaxThreads);
+       fprintf(qp_file, "+RTS -C%ld -t%ld\n"
+               , RTSflags.ConcFlags.ctxtSwitchTime
+               , RTSflags.ConcFlags.maxThreads);
+
        fputs(time_str(), qp_file);
        fputc('\n', qp_file);
     }
        fputs(time_str(), qp_file);
        fputc('\n', qp_file);
     }
@@ -3700,35 +3703,24 @@ unsigned CurrentProc = 0;
 W_ IdleProcs = ~0l, Idlers = 32; 
 
 void 
 W_ IdleProcs = ~0l, Idlers = 32; 
 
 void 
-GranSimAllocate(n,node,liveness)
-I_ n;
-P_ node;
-W_ liveness;
+GranSimAllocate(I_ n, P_ node, W_ liveness)
 { }
 
 void 
 { }
 
 void 
-GranSimUnallocate(n,node,liveness)
-W_ n;
-P_ node;
-W_ liveness;
+GranSimUnallocate(W_ n, P_ node, W_ liveness)
 { }
 
 { }
 
-
 void 
 void 
-GranSimExec(ariths,branches,loads,stores,floats)
-W_ ariths,branches,loads,stores,floats;
+GranSimExec(W_ ariths, W_ branches, W_ loads, W_ stores, W_ floats)
 { }
 
 { }
 
-I_ 
-GranSimFetch(node /* , liveness_mask */ )
-P_ node;
+int
+GranSimFetch(P_ node /* , liveness_mask */ )
 /* I_ liveness_mask; */
 /* I_ liveness_mask; */
-{ }
+{ return(9999999); }
 
 void 
 
 void 
-GranSimSpark(local,node)
-W_ local;
-P_ node;
+GranSimSpark(W_ local, P_ node)
 { }
 
 #if 0
 { }
 
 #if 0
@@ -3741,7 +3733,7 @@ I_ identifier;
 #endif
 
 void 
 #endif
 
 void 
-GranSimBlock()
+GranSimBlock(STG_NO_ARGS)
 { }
 #endif 
 
 { }
 #endif 
 
diff --git a/ghc/runtime/main/Ticky.lc b/ghc/runtime/main/Ticky.lc
new file mode 100644 (file)
index 0000000..d0276dc
--- /dev/null
@@ -0,0 +1,871 @@
+%
+% (c) The GRASP Project, Glasgow University, 1992-1993
+%
+%************************************************************************
+%*                                                                     *
+\section[Ticky.lc]{Stuff for ``ticky-ticky'' profiling}
+%*                                                                     *
+%************************************************************************
+
+Goes with \tr{imports/Ticky.lh}; more documentation there.
+
+%************************************************************************
+%*                                                                     *
+\subsection[Ticky-counters]{Declare all the counters}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+#define NULL_REG_MAP   /* Not threaded */
+
+#include "../storage/SMinternal.h" /* Bad boy, Will (ToDo) */
+
+#if defined(TICKY_TICKY)
+
+I_ ALLOC_HEAP_ctr = 0;
+I_ ALLOC_HEAP_tot = 0;
+
+PP_ max_SpA; /* set in re_enterable_part_of_main */
+P_  max_SpB;
+
+/* not used at all
+I_ A_STK_REUSE_ctr = 0;
+I_ B_STK_REUSE_ctr = 0;
+*/
+I_ A_STK_STUB_ctr = 0;
+
+I_ ALLOC_FUN_ctr = 0;
+I_ ALLOC_FUN_adm = 0;
+I_ ALLOC_FUN_gds = 0;
+I_ ALLOC_FUN_slp = 0;
+I_ ALLOC_FUN_hst[5] = {0,0,0,0,0};
+I_ ALLOC_THK_ctr = 0;
+I_ ALLOC_THK_adm = 0;
+I_ ALLOC_THK_gds = 0;
+I_ ALLOC_THK_slp = 0;
+I_ ALLOC_THK_hst[5] = {0,0,0,0,0};
+I_ ALLOC_CON_ctr = 0;
+I_ ALLOC_CON_adm = 0;
+I_ ALLOC_CON_gds = 0;
+I_ ALLOC_CON_slp = 0;
+I_ ALLOC_CON_hst[5] = {0,0,0,0,0};
+I_ ALLOC_TUP_ctr = 0;
+I_ ALLOC_TUP_adm = 0;
+I_ ALLOC_TUP_gds = 0;
+I_ ALLOC_TUP_slp = 0;
+I_ ALLOC_TUP_hst[5] = {0,0,0,0,0};
+I_ ALLOC_BH_ctr = 0;
+I_ ALLOC_BH_adm = 0;
+I_ ALLOC_BH_gds = 0;
+I_ ALLOC_BH_slp = 0;
+I_ ALLOC_BH_hst[5] = {0,0,0,0,0};
+I_ ALLOC_PRIM_ctr = 0;
+I_ ALLOC_PRIM_adm = 0;
+I_ ALLOC_PRIM_gds = 0;
+I_ ALLOC_PRIM_slp = 0;
+I_ ALLOC_PRIM_hst[5] = {0,0,0,0,0};
+I_ ALLOC_UPD_PAP_ctr = 0;
+I_ ALLOC_UPD_PAP_adm = 0;
+I_ ALLOC_UPD_PAP_gds = 0;
+I_ ALLOC_UPD_PAP_slp = 0;
+I_ ALLOC_UPD_PAP_hst[5] = {0,0,0,0,0};
+
+#ifdef CONCURRENT
+I_ ALLOC_STK_ctr = 0;
+I_ ALLOC_STK_adm = 0;
+I_ ALLOC_STK_gds = 0;
+I_ ALLOC_STK_slp = 0;
+I_ ALLOC_STK_hst[5] = {0,0,0,0,0};
+I_ ALLOC_TSO_ctr = 0;
+I_ ALLOC_TSO_adm = 0;
+I_ ALLOC_TSO_gds = 0;
+I_ ALLOC_TSO_slp = 0;
+I_ ALLOC_TSO_hst[5] = {0,0,0,0,0};
+
+# ifdef PAR
+I_ ALLOC_FMBQ_ctr = 0;
+I_ ALLOC_FMBQ_adm = 0;
+I_ ALLOC_FMBQ_gds = 0;
+I_ ALLOC_FMBQ_slp = 0;
+I_ ALLOC_FMBQ_hst[5] = {0,0,0,0,0};
+I_ ALLOC_FME_ctr = 0;
+I_ ALLOC_FME_adm = 0;
+I_ ALLOC_FME_gds = 0;
+I_ ALLOC_FME_slp = 0;
+I_ ALLOC_FME_hst[5] = {0,0,0,0,0};
+I_ ALLOC_BF_ctr = 0;
+I_ ALLOC_BF_adm = 0;
+I_ ALLOC_BF_gds = 0;
+I_ ALLOC_BF_slp = 0;
+I_ ALLOC_BF_hst[5] = {0,0,0,0,0};
+# endif
+#endif
+
+I_ ENT_VIA_NODE_ctr = 0;
+I_ ENT_CON_ctr = 0;
+I_ ENT_FUN_STD_ctr = 0;
+I_ ENT_FUN_DIRECT_ctr = 0;
+I_ ENT_IND_ctr = 0;
+I_ ENT_PAP_ctr = 0;
+I_ ENT_THK_ctr = 0;
+
+I_ RET_NEW_IN_HEAP_ctr = 0;
+I_ RET_NEW_IN_REGS_ctr = 0;
+I_ RET_OLD_IN_HEAP_ctr = 0;
+I_ RET_OLD_IN_REGS_ctr = 0;
+I_ RET_SEMI_BY_DEFAULT_ctr = 0;
+I_ RET_SEMI_IN_HEAP_ctr = 0;
+I_ RET_SEMI_IN_REGS_ctr = 0;
+I_ RET_SEMI_FAILED_IND_ctr = 0;
+I_ RET_SEMI_FAILED_UNEVAL_ctr = 0;
+I_ VEC_RETURN_ctr = 0;
+
+I_ RET_NEW_IN_HEAP_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ RET_NEW_IN_REGS_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ RET_OLD_IN_HEAP_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ RET_OLD_IN_REGS_hst[9] = {0,0,0,0,0,0,0,0,0};
+/* no such thing: I_ RET_SEMI_BY_DEFAULT_hst[9] = {0,0,0,0,0,0,0,0,0}; */
+I_ RET_SEMI_IN_HEAP_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ RET_SEMI_IN_REGS_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ RET_VEC_RETURN_hst[9] = {0,0,0,0,0,0,0,0,0};
+
+I_ RET_SEMI_loads_avoided = 0;
+
+I_ ReturnInRegsNodeValid = 0; /* i.e., False */
+
+I_ UPDF_OMITTED_ctr = 0;
+I_ UPDF_STD_PUSHED_ctr = 0;
+I_ UPDF_CON_PUSHED_ctr = 0;
+I_ UPDF_HOLE_PUSHED_ctr = 0;
+
+I_ UPDF_RCC_PUSHED_ctr = 0;
+I_ UPDF_RCC_OMITTED_ctr = 0;
+
+I_ UPD_EXISTING_ctr = 0;
+I_ UPD_SQUEEZED_ctr = 0;
+I_ UPD_CON_W_NODE_ctr = 0;
+I_ UPD_CON_IN_PLACE_ctr = 0;
+I_ UPD_CON_IN_NEW_ctr = 0;
+I_ UPD_PAP_IN_PLACE_ctr = 0;
+I_ UPD_PAP_IN_NEW_ctr = 0;
+
+I_ UPD_CON_IN_PLACE_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ UPD_CON_IN_NEW_hst[9] = {0,0,0,0,0,0,0,0,0};
+I_ UPD_PAP_IN_NEW_hst[9] = {0,0,0,0,0,0,0,0,0};
+
+I_ UPD_ENTERED_hst[9] = {0,0,0,0,0,0,0,0,0};
+
+I_ UPD_NEW_IND_ctr = 0;
+I_ UPD_NEW_IN_PLACE_PTRS_ctr = 0;
+I_ UPD_NEW_IN_PLACE_NOPTRS_ctr = 0;
+I_ UPD_OLD_IND_ctr = 0;
+I_ UPD_OLD_IN_PLACE_PTRS_ctr = 0;
+I_ UPD_OLD_IN_PLACE_NOPTRS_ctr = 0;
+
+I_ UPD_IN_PLACE_COPY_ctr = 0;
+
+I_ GC_SEL_ABANDONED_ctr = 0;
+I_ GC_SEL_MINOR_ctr = 0;
+I_ GC_SEL_MAJOR_ctr = 0;
+
+I_ GC_SHORT_IND_ctr = 0;
+I_ GC_SHORT_CAF_ctr = 0;
+I_ GC_COMMON_CHARLIKE_ctr = 0;
+I_ GC_COMMON_INTLIKE_ctr = 0;
+I_ GC_COMMON_INTLIKE_FAIL_ctr = 0;
+I_ GC_COMMON_CONST_ctr = 0;
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[Ticky-print]{Print out all the counters}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+static void printRegisteredCounterInfo (FILE *); /* fwd decl */
+
+#define INTAVG(a,b) ((b == 0) ? 0.0 : ((StgDouble) (a) / (StgDouble) (b)))
+#define PC(a)      (100.0 * a)
+
+#define AVG(thing) \
+       StgDouble CAT2(avg,thing)  = INTAVG(CAT2(tot,thing),CAT2(ctr,thing))
+
+void
+PrintTickyInfo()
+{
+  I_ i;
+  I_ tot_allocs = /* total number of things allocated */
+       ALLOC_FUN_ctr + ALLOC_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr +
+#ifdef CONCURRENT
+       ALLOC_STK_ctr + ALLOC_TSO_ctr +
+# ifdef PAR
+       ALLOC_FMBQ_ctr + ALLOC_FME_ctr + ALLOC_BF_ctr +
+# endif
+#endif
+       ALLOC_BH_ctr  + ALLOC_UPD_PAP_ctr + ALLOC_PRIM_ctr;
+  I_ tot_adm_wds = /* total number of admin words allocated */
+       ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm +
+#ifdef CONCURRENT
+       ALLOC_STK_adm + ALLOC_TSO_adm +
+# ifdef PAR
+       ALLOC_FMBQ_adm + ALLOC_FME_adm + ALLOC_BF_adm +
+# endif
+#endif
+       ALLOC_BH_adm  + ALLOC_UPD_PAP_adm + ALLOC_PRIM_adm;
+  I_ tot_gds_wds = /* total number of words of ``good stuff'' allocated */
+       ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds +
+#ifdef CONCURRENT
+       ALLOC_STK_gds + ALLOC_TSO_gds +
+# ifdef PAR
+       ALLOC_FMBQ_gds + ALLOC_FME_gds + ALLOC_BF_gds +
+# endif
+#endif
+       ALLOC_BH_gds  + ALLOC_UPD_PAP_gds + ALLOC_PRIM_gds;
+  I_ tot_slp_wds = /* total number of ``slop'' words allocated */
+       ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp +
+#ifdef CONCURRENT
+       ALLOC_STK_slp + ALLOC_TSO_slp +
+# ifdef PAR
+       ALLOC_FMBQ_slp + ALLOC_FME_slp + ALLOC_BF_slp +
+# endif
+#endif
+       ALLOC_BH_slp  + ALLOC_UPD_PAP_slp + ALLOC_PRIM_slp;
+  I_ tot_wds = /* total words */
+       tot_adm_wds + tot_gds_wds + tot_slp_wds;
+
+  I_ tot_enters =
+       ENT_CON_ctr + ENT_FUN_DIRECT_ctr +
+       ENT_IND_ctr + ENT_PAP_ctr + ENT_THK_ctr;
+  I_ jump_direct_enters =
+       tot_enters - ENT_VIA_NODE_ctr;
+  I_ bypass_enters =
+       ENT_FUN_DIRECT_ctr -
+       (ENT_FUN_STD_ctr - UPD_PAP_IN_PLACE_ctr - UPD_PAP_IN_NEW_ctr);
+
+  I_ tot_returns_in_regs =
+       RET_NEW_IN_REGS_ctr + RET_OLD_IN_REGS_ctr + RET_SEMI_IN_REGS_ctr;
+  I_ tot_returns_in_heap =
+       RET_NEW_IN_HEAP_ctr + RET_OLD_IN_HEAP_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_BY_DEFAULT_ctr/*???*/;
+  I_ tot_returns_of_new =
+       RET_NEW_IN_REGS_ctr + RET_NEW_IN_HEAP_ctr;
+  I_ tot_returns_of_old = /* NB: NOT USED ???!  94/05 WDP */
+       RET_OLD_IN_REGS_ctr + RET_OLD_IN_HEAP_ctr +
+       RET_SEMI_BY_DEFAULT_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_IN_REGS_ctr /*???*/;
+
+  I_ tot_returns =
+       tot_returns_in_regs + tot_returns_in_heap;
+
+  I_ tot_upd_frames =
+       UPDF_STD_PUSHED_ctr + UPDF_CON_PUSHED_ctr;      /*DBH*/
+
+  I_ con_updates =
+       UPD_CON_W_NODE_ctr + UPD_CON_IN_PLACE_ctr + UPD_CON_IN_NEW_ctr;
+  I_ pap_updates =
+       UPD_PAP_IN_PLACE_ctr + UPD_PAP_IN_NEW_ctr;
+  I_ tot_updates =
+       UPD_EXISTING_ctr + UPD_SQUEEZED_ctr + con_updates + pap_updates;
+  I_ tot_in_place_updates =
+       UPD_CON_IN_PLACE_ctr + UPD_PAP_IN_PLACE_ctr;
+
+  I_ tot_new_updates = 
+        UPD_NEW_IN_PLACE_NOPTRS_ctr + UPD_NEW_IN_PLACE_PTRS_ctr + UPD_NEW_IND_ctr;
+  I_ tot_old_updates =
+        UPD_OLD_IN_PLACE_NOPTRS_ctr + UPD_OLD_IN_PLACE_PTRS_ctr + UPD_OLD_IND_ctr;
+  I_ tot_gengc_updates =
+        tot_new_updates + tot_old_updates;
+
+  FILE *tf = RTSflags.TickyFlags.tickyFile;
+
+  fprintf(tf,"\n\nALLOCATIONS: %ld (%ld words total: %ld admin, %ld goods, %ld slop)\n",
+       tot_allocs, tot_wds, tot_adm_wds, tot_gds_wds, tot_slp_wds);
+  fprintf(tf,"\t\t\t\ttotal words:\t    2     3     4     5    6+\n");
+
+#define ALLOC_HISTO_MAGIC(categ) \
+       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[0], CAT3(ALLOC_,categ,_ctr)))), \
+       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[1], CAT3(ALLOC_,categ,_ctr)))), \
+       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[2], CAT3(ALLOC_,categ,_ctr)))), \
+       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[3], CAT3(ALLOC_,categ,_ctr)))), \
+       (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[4], CAT3(ALLOC_,categ,_ctr))))
+
+  fprintf(tf,"%7ld (%5.1f%%) function values",
+       ALLOC_FUN_ctr,
+       PC(INTAVG(ALLOC_FUN_ctr, tot_allocs)));
+  if (ALLOC_FUN_ctr != 0)
+      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FUN));
+
+  fprintf(tf,"\n%7ld (%5.1f%%) thunks",
+       ALLOC_THK_ctr,
+       PC(INTAVG(ALLOC_THK_ctr, tot_allocs)));
+  if (ALLOC_THK_ctr != 0)
+      fprintf(tf,"\t\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(THK));
+
+  fprintf(tf,"\n%7ld (%5.1f%%) data values",
+       ALLOC_CON_ctr,
+       PC(INTAVG(ALLOC_CON_ctr, tot_allocs)));
+  if (ALLOC_CON_ctr != 0)
+      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(CON));
+
+  fprintf(tf,"\n%7ld (%5.1f%%) big tuples",
+       ALLOC_TUP_ctr,
+       PC(INTAVG(ALLOC_TUP_ctr, tot_allocs)));
+  if (ALLOC_TUP_ctr != 0)
+      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TUP));
+
+  fprintf(tf,"\n%7ld (%5.1f%%) black holes",
+       ALLOC_BH_ctr,
+       PC(INTAVG(ALLOC_BH_ctr, tot_allocs)));
+  if (ALLOC_BH_ctr != 0)
+      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BH));
+
+  fprintf(tf,"\n%7ld (%5.1f%%) prim things",
+       ALLOC_PRIM_ctr,
+       PC(INTAVG(ALLOC_PRIM_ctr, tot_allocs)));
+  if (ALLOC_PRIM_ctr != 0)
+      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PRIM));
+
+  fprintf(tf,"\n%7ld (%5.1f%%) partial applications",
+       ALLOC_UPD_PAP_ctr,
+       PC(INTAVG(ALLOC_UPD_PAP_ctr, tot_allocs)));
+  if (ALLOC_UPD_PAP_ctr != 0)
+      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(UPD_PAP));
+
+#ifdef CONCURRENT
+  fprintf(tf,"\n%7ld (%5.1f%%) stack objects",
+       ALLOC_STK_ctr,
+       PC(INTAVG(ALLOC_STK_ctr, tot_allocs)));
+  if (ALLOC_STK_ctr != 0)
+      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(STK));
+  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
+       ALLOC_TSO_ctr,
+       PC(INTAVG(ALLOC_TSO_ctr, tot_allocs)));
+  if (ALLOC_TSO_ctr != 0)
+      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TSO));
+# ifdef PAR
+  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
+       ALLOC_FMBQ_ctr,
+       PC(INTAVG(ALLOC_FMBQ_ctr, tot_allocs)));
+  if (ALLOC_FMBQ_ctr != 0)
+      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FMBQ));
+  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
+       ALLOC_FME_ctr,
+       PC(INTAVG(ALLOC_FME_ctr, tot_allocs)));
+  if (ALLOC_FME_ctr != 0)
+      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FME));
+  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
+       ALLOC_BF_ctr,
+       PC(INTAVG(ALLOC_BF_ctr, tot_allocs)));
+  if (ALLOC_BF_ctr != 0)
+      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF));
+# endif
+#endif
+  fprintf(tf,"\n");
+
+  fprintf(tf,"\nTotal storage-manager allocations: %ld (%ld words)\n\t[%ld words lost to speculative heap-checks]\n", ALLOC_HEAP_ctr, ALLOC_HEAP_tot, ALLOC_HEAP_tot - tot_wds);
+
+  fprintf(tf,"\nSTACK USAGE:\n"); /* NB: some bits are direction sensitive */
+  fprintf(tf,"\tA stack slots stubbed: %ld\n", A_STK_STUB_ctr);
+/* not used at all
+  fprintf(tf,"\tA stack slots re-used: %ld\n", A_STK_REUSE_ctr);
+  fprintf(tf,"\tB stack slots re-used: %ld\n", B_STK_REUSE_ctr);
+*/
+#ifndef CONCURRENT
+  fprintf(tf,"\tA stack max. depth: %ld words\n",
+               (I_) (stackInfo.botA - max_SpA));
+  fprintf(tf,"\tB stack max. depth: %ld words\n",
+               (I_) (max_SpB - stackInfo.botB));       /* And cheating, too (ToDo) */
+#endif
+
+  fprintf(tf,"\nENTERS: %ld  of which %ld (%.1f%%) direct to the entry code\n\t\t  [the rest indirected via Node's info ptr]\n",
+       tot_enters,
+       jump_direct_enters,
+       PC(INTAVG(jump_direct_enters,tot_enters)));
+  fprintf(tf,"%7ld (%5.1f%%) thunks\n",
+       ENT_THK_ctr,
+       PC(INTAVG(ENT_THK_ctr,tot_enters)));
+  fprintf(tf,"%7ld (%5.1f%%) data values\n",
+       ENT_CON_ctr,
+       PC(INTAVG(ENT_CON_ctr,tot_enters)));
+  fprintf(tf,"%7ld (%5.1f%%) function values\n\t\t  [of which %ld (%.1f%%) bypassed arg-satisfaction chk]\n",
+       ENT_FUN_DIRECT_ctr,
+       PC(INTAVG(ENT_FUN_DIRECT_ctr,tot_enters)),
+       bypass_enters,
+       PC(INTAVG(bypass_enters,ENT_FUN_DIRECT_ctr)));
+  fprintf(tf,"%7ld (%5.1f%%) partial applications\n",
+       ENT_PAP_ctr,
+       PC(INTAVG(ENT_PAP_ctr,tot_enters)));
+  fprintf(tf,"%7ld (%5.1f%%) indirections\n",
+       ENT_IND_ctr,
+       PC(INTAVG(ENT_IND_ctr,tot_enters)));
+
+  fprintf(tf,"\nRETURNS: %ld\n", tot_returns);
+  fprintf(tf,"%7ld (%5.1f%%) in registers [the rest in the heap]\n",
+       tot_returns_in_regs,
+       PC(INTAVG(tot_returns_in_regs,tot_returns)));
+  fprintf(tf,"%7ld (%5.1f%%) from entering a new constructor\n\t\t  [the rest from entering an existing constructor]\n",
+       tot_returns_of_new,
+       PC(INTAVG(tot_returns_of_new,tot_returns)));
+  fprintf(tf,"%7ld (%5.1f%%) vectored [the rest unvectored]\n",
+       VEC_RETURN_ctr,
+       PC(INTAVG(VEC_RETURN_ctr,tot_returns)));
+
+/*
+  fprintf(tf, "RET_xxx: %7ld: ", RET_xxx_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
+                               PC(INTAVG(RET_xxx_hst[i],RET_xxx_ctr))); }
+  fprintf(tf, "\n");
+*/
+  fprintf(tf, "\nRET_OLD_IN_REGS: %7ld: ", RET_OLD_IN_REGS_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
+                               PC(INTAVG(RET_OLD_IN_REGS_hst[i],RET_OLD_IN_REGS_ctr))); }
+  fprintf(tf, "\n");
+  fprintf(tf, "RET_NEW_IN_REGS: %7ld: ", RET_NEW_IN_REGS_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
+                           PC(INTAVG(RET_NEW_IN_REGS_hst[i],RET_NEW_IN_REGS_ctr))); }
+  fprintf(tf, "\n");
+  fprintf(tf, "RET_OLD_IN_HEAP: %7ld: ", RET_OLD_IN_HEAP_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
+                               PC(INTAVG(RET_OLD_IN_HEAP_hst[i],RET_OLD_IN_HEAP_ctr))); }
+  fprintf(tf, "\n");
+  fprintf(tf, "RET_NEW_IN_HEAP: %7ld: ", RET_NEW_IN_HEAP_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
+                               PC(INTAVG(RET_NEW_IN_HEAP_hst[i],RET_NEW_IN_HEAP_ctr))); }
+  fprintf(tf, "\n");
+  fprintf(tf, "\nRET_VEC_RETURN : %7ld: ", VEC_RETURN_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
+                               PC(INTAVG(RET_VEC_RETURN_hst[i],VEC_RETURN_ctr))); }
+  fprintf(tf, "\n");
+
+  fprintf(tf,"\nUPDATE FRAMES: %ld (%ld omitted from thunks)\n",
+       tot_upd_frames,
+       UPDF_OMITTED_ctr);
+  fprintf(tf,"%7ld (%5.1f%%) standard frames\n",
+       UPDF_STD_PUSHED_ctr,
+       PC(INTAVG(UPDF_STD_PUSHED_ctr,tot_upd_frames)));
+  fprintf(tf,"%7ld (%5.1f%%) constructor frames\n",
+       UPDF_CON_PUSHED_ctr,
+       PC(INTAVG(UPDF_CON_PUSHED_ctr,tot_upd_frames)));
+  fprintf(tf,"\t\t  [of which %ld (%.1f%%) were for black-holes]\n",
+       UPDF_HOLE_PUSHED_ctr,
+       PC(INTAVG(UPDF_HOLE_PUSHED_ctr,UPDF_CON_PUSHED_ctr)));  /*DBH*/
+
+  if (UPDF_RCC_PUSHED_ctr != 0)
+     fprintf(tf,"%7ld restore cost centre frames (%ld omitted)\n",
+       UPDF_RCC_PUSHED_ctr,
+       UPDF_RCC_OMITTED_ctr);
+
+  fprintf(tf,"\nUPDATES: %ld\n", tot_updates);
+  fprintf(tf,"%7ld (%5.1f%%) data values\n\t\t  [%ld in place, %ld allocated new space, %ld with Node]\n",
+       con_updates,
+       PC(INTAVG(con_updates,tot_updates)),
+       UPD_CON_IN_PLACE_ctr, UPD_CON_IN_NEW_ctr, UPD_CON_W_NODE_ctr);
+  fprintf(tf,"%7ld (%5.1f%%) partial applications\n\t\t  [%ld in place, %ld allocated new space]\n",
+       pap_updates,
+       PC(INTAVG(pap_updates,tot_updates)),
+       UPD_PAP_IN_PLACE_ctr, UPD_PAP_IN_NEW_ctr);
+  fprintf(tf,"%7ld (%5.1f%%) updates to existing heap objects (%ld by squeezing)\n",
+       UPD_EXISTING_ctr + UPD_SQUEEZED_ctr,
+       PC(INTAVG(UPD_EXISTING_ctr + UPD_SQUEEZED_ctr, tot_updates)),
+       UPD_SQUEEZED_ctr);
+  fprintf(tf,"%7ld (%5.1f%%) in-place updates copied\n",
+       UPD_IN_PLACE_COPY_ctr,
+       PC(INTAVG(UPD_IN_PLACE_COPY_ctr,tot_in_place_updates)));
+#if 0
+  if (UPD_ENTERED_ctr != 0) {
+      fprintf(tf,"%7ld (%5.1f%%) subsequently entered\n",
+             UPD_ENTERED_ctr,
+             PC(INTAVG(UPD_ENTERED_ctr,tot_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) subsequently entered more than once\n",
+             UPD_ENTERED_AGAIN_ctr,
+             PC(INTAVG(UPD_ENTERED_AGAIN_ctr,tot_updates)));
+  }
+#endif
+/*
+  fprintf(tf, "UPD_xxx: %7ld: ", UPD_xxx_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_xxx_hst[i]); }
+  fprintf(tf, "\n");
+*/
+  fprintf(tf, "UPD_CON_IN_PLACE: %7ld: ", UPD_CON_IN_PLACE_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_PLACE_hst[i]); }
+  fprintf(tf, "\n");
+  fprintf(tf, "UPD_CON_IN_NEW:   %7ld: ", UPD_CON_IN_NEW_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_NEW_hst[i]); }
+  fprintf(tf, "\n");
+  fprintf(tf, "UPD_PAP_IN_NEW:   %7ld: ", UPD_PAP_IN_NEW_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_PAP_IN_NEW_hst[i]); }
+  fprintf(tf, "\n");
+
+  if (tot_gengc_updates != 0) {
+      fprintf(tf,"\nNEW GEN UPDATES: %ld (%5.1f%%)\n",
+             tot_new_updates,
+             PC(INTAVG(tot_new_updates,tot_gengc_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) indirections\n",
+             UPD_NEW_IND_ctr,
+             PC(INTAVG(UPD_NEW_IND_ctr,tot_gengc_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) inplace with ptrs\n",
+             UPD_NEW_IN_PLACE_PTRS_ctr,
+             PC(INTAVG(UPD_NEW_IN_PLACE_PTRS_ctr,tot_gengc_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) inplace without ptrs\n",
+             UPD_NEW_IN_PLACE_NOPTRS_ctr,
+             PC(INTAVG(UPD_NEW_IN_PLACE_NOPTRS_ctr,tot_gengc_updates)));
+      fprintf(tf,"\nOLD GEN UPDATES: %ld (%5.1f%%)\n",
+             tot_old_updates,
+             PC(INTAVG(tot_old_updates,tot_gengc_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) indirections\n",
+             UPD_OLD_IND_ctr,
+             PC(INTAVG(UPD_OLD_IND_ctr,tot_gengc_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) inplace with ptrs\n",
+             UPD_OLD_IN_PLACE_PTRS_ctr,
+             PC(INTAVG(UPD_OLD_IN_PLACE_PTRS_ctr,tot_gengc_updates)));
+      fprintf(tf,"%7ld (%5.1f%%) inplace without ptrs\n",
+             UPD_OLD_IN_PLACE_NOPTRS_ctr,
+             PC(INTAVG(UPD_OLD_IN_PLACE_NOPTRS_ctr,tot_gengc_updates)));
+  }
+
+  printRegisteredCounterInfo(tf);
+
+  fprintf(tf,"\n**************************************************\n");
+
+  /* here, we print out all the raw numbers; these are really
+    more useful when we want to snag them for subsequent
+    rdb-etc processing. WDP 95/11
+  */
+
+#define PR_CTR(ctr) \
+  do { fprintf(tf,"%7ld " #ctr "\n", ctr); } while(0)
+#define PR_HST(hst,i) \
+  do { fprintf(tf,"%7ld " #hst "_" #i "\n", hst[i]); } while(0)
+
+  PR_CTR(ALLOC_HEAP_ctr);
+  PR_CTR(ALLOC_HEAP_tot);
+
+#ifndef CONCURRENT
+  fprintf(tf,"%7ld HWM_SpA\n", (I_) (stackInfo.botA - max_SpA));
+  fprintf(tf,"%7ld HWM_SpB\n", (I_) (max_SpB - stackInfo.botB));
+#endif
+
+  PR_CTR(A_STK_STUB_ctr);
+
+  PR_CTR(ALLOC_FUN_ctr);
+  PR_CTR(ALLOC_FUN_adm);
+  PR_CTR(ALLOC_FUN_gds);
+  PR_CTR(ALLOC_FUN_slp);
+  PR_HST(ALLOC_FUN_hst,0);
+  PR_HST(ALLOC_FUN_hst,1);
+  PR_HST(ALLOC_FUN_hst,2);
+  PR_HST(ALLOC_FUN_hst,3);
+  PR_HST(ALLOC_FUN_hst,4);
+  PR_CTR(ALLOC_THK_ctr);
+  PR_CTR(ALLOC_THK_adm);
+  PR_CTR(ALLOC_THK_gds);
+  PR_CTR(ALLOC_THK_slp);
+  PR_HST(ALLOC_THK_hst,0);
+  PR_HST(ALLOC_THK_hst,1);
+  PR_HST(ALLOC_THK_hst,2);
+  PR_HST(ALLOC_THK_hst,3);
+  PR_HST(ALLOC_THK_hst,4);
+  PR_CTR(ALLOC_CON_ctr);
+  PR_CTR(ALLOC_CON_adm);
+  PR_CTR(ALLOC_CON_gds);
+  PR_CTR(ALLOC_CON_slp);
+  PR_HST(ALLOC_CON_hst,0);
+  PR_HST(ALLOC_CON_hst,1);
+  PR_HST(ALLOC_CON_hst,2);
+  PR_HST(ALLOC_CON_hst,3);
+  PR_HST(ALLOC_CON_hst,4);
+  PR_CTR(ALLOC_TUP_ctr);
+  PR_CTR(ALLOC_TUP_adm);
+  PR_CTR(ALLOC_TUP_gds);
+  PR_CTR(ALLOC_TUP_slp);
+  PR_HST(ALLOC_TUP_hst,0);
+  PR_HST(ALLOC_TUP_hst,1);
+  PR_HST(ALLOC_TUP_hst,2);
+  PR_HST(ALLOC_TUP_hst,3);
+  PR_HST(ALLOC_TUP_hst,4);
+  PR_CTR(ALLOC_BH_ctr);
+  PR_CTR(ALLOC_BH_adm);
+  PR_CTR(ALLOC_BH_gds);
+  PR_CTR(ALLOC_BH_slp);
+  PR_HST(ALLOC_BH_hst,0);
+  PR_HST(ALLOC_BH_hst,1);
+  PR_HST(ALLOC_BH_hst,2);
+  PR_HST(ALLOC_BH_hst,3);
+  PR_HST(ALLOC_BH_hst,4);
+  PR_CTR(ALLOC_PRIM_ctr);
+  PR_CTR(ALLOC_PRIM_adm);
+  PR_CTR(ALLOC_PRIM_gds);
+  PR_CTR(ALLOC_PRIM_slp);
+  PR_HST(ALLOC_PRIM_hst,0);
+  PR_HST(ALLOC_PRIM_hst,1);
+  PR_HST(ALLOC_PRIM_hst,2);
+  PR_HST(ALLOC_PRIM_hst,3);
+  PR_HST(ALLOC_PRIM_hst,4);
+  PR_CTR(ALLOC_UPD_PAP_ctr);
+  PR_CTR(ALLOC_UPD_PAP_adm);
+  PR_CTR(ALLOC_UPD_PAP_gds);
+  PR_CTR(ALLOC_UPD_PAP_slp);
+  PR_HST(ALLOC_UPD_PAP_hst,0);
+  PR_HST(ALLOC_UPD_PAP_hst,1);
+  PR_HST(ALLOC_UPD_PAP_hst,2);
+  PR_HST(ALLOC_UPD_PAP_hst,3);
+  PR_HST(ALLOC_UPD_PAP_hst,4);
+
+#ifdef CONCURRENT
+  PR_CTR(ALLOC_STK_ctr);
+  PR_CTR(ALLOC_STK_adm);
+  PR_CTR(ALLOC_STK_gds);
+  PR_CTR(ALLOC_STK_slp);
+  PR_HST(ALLOC_STK_hst,0);
+  PR_HST(ALLOC_STK_hst,1);
+  PR_HST(ALLOC_STK_hst,2);
+  PR_HST(ALLOC_STK_hst,3);
+  PR_HST(ALLOC_STK_hst,4);
+  PR_CTR(ALLOC_TSO_ctr);
+  PR_CTR(ALLOC_TSO_adm);
+  PR_CTR(ALLOC_TSO_gds);
+  PR_CTR(ALLOC_TSO_slp);
+  PR_HST(ALLOC_TSO_hst,0);
+  PR_HST(ALLOC_TSO_hst,1);
+  PR_HST(ALLOC_TSO_hst,2);
+  PR_HST(ALLOC_TSO_hst,3);
+  PR_HST(ALLOC_TSO_hst,4);
+
+# ifdef PAR
+  PR_CTR(ALLOC_FMBQ_ctr);
+  PR_CTR(ALLOC_FMBQ_adm);
+  PR_CTR(ALLOC_FMBQ_gds);
+  PR_CTR(ALLOC_FMBQ_slp);
+  PR_HST(ALLOC_FMBQ_hst,0);
+  PR_HST(ALLOC_FMBQ_hst,1);
+  PR_HST(ALLOC_FMBQ_hst,2);
+  PR_HST(ALLOC_FMBQ_hst,3);
+  PR_HST(ALLOC_FMBQ_hst,4);
+  PR_CTR(ALLOC_FME_ctr);
+  PR_CTR(ALLOC_FME_adm);
+  PR_CTR(ALLOC_FME_gds);
+  PR_CTR(ALLOC_FME_slp);
+  PR_HST(ALLOC_FME_hst,0);
+  PR_HST(ALLOC_FME_hst,1);
+  PR_HST(ALLOC_FME_hst,2);
+  PR_HST(ALLOC_FME_hst,3);
+  PR_HST(ALLOC_FME_hst,4);
+  PR_CTR(ALLOC_BF_ctr);
+  PR_CTR(ALLOC_BF_adm);
+  PR_CTR(ALLOC_BF_gds);
+  PR_CTR(ALLOC_BF_slp);
+  PR_HST(ALLOC_BF_hst,0);
+  PR_HST(ALLOC_BF_hst,1);
+  PR_HST(ALLOC_BF_hst,2);
+  PR_HST(ALLOC_BF_hst,3);
+  PR_HST(ALLOC_BF_hst,4);
+# endif
+#endif
+
+  PR_CTR(ENT_VIA_NODE_ctr);
+  PR_CTR(ENT_CON_ctr);
+  PR_CTR(ENT_FUN_STD_ctr);
+  PR_CTR(ENT_FUN_DIRECT_ctr);
+  PR_CTR(ENT_IND_ctr);
+  PR_CTR(ENT_PAP_ctr);
+  PR_CTR(ENT_THK_ctr);
+
+  PR_CTR(RET_NEW_IN_HEAP_ctr);
+  PR_CTR(RET_NEW_IN_REGS_ctr);
+  PR_CTR(RET_OLD_IN_HEAP_ctr);
+  PR_CTR(RET_OLD_IN_REGS_ctr);
+  PR_CTR(RET_SEMI_BY_DEFAULT_ctr);
+  PR_CTR(RET_SEMI_IN_HEAP_ctr);
+  PR_CTR(RET_SEMI_IN_REGS_ctr);
+  PR_CTR(RET_SEMI_FAILED_IND_ctr);
+  PR_CTR(RET_SEMI_FAILED_UNEVAL_ctr);
+  PR_CTR(VEC_RETURN_ctr);
+
+  PR_HST(RET_NEW_IN_HEAP_hst,0);
+  PR_HST(RET_NEW_IN_HEAP_hst,1);
+  PR_HST(RET_NEW_IN_HEAP_hst,2);
+  PR_HST(RET_NEW_IN_HEAP_hst,3);
+  PR_HST(RET_NEW_IN_HEAP_hst,4);
+  PR_HST(RET_NEW_IN_HEAP_hst,5);
+  PR_HST(RET_NEW_IN_HEAP_hst,6);
+  PR_HST(RET_NEW_IN_HEAP_hst,7);
+  PR_HST(RET_NEW_IN_HEAP_hst,8);
+  PR_HST(RET_NEW_IN_REGS_hst,0);
+  PR_HST(RET_NEW_IN_REGS_hst,1);
+  PR_HST(RET_NEW_IN_REGS_hst,2);
+  PR_HST(RET_NEW_IN_REGS_hst,3);
+  PR_HST(RET_NEW_IN_REGS_hst,4);
+  PR_HST(RET_NEW_IN_REGS_hst,5);
+  PR_HST(RET_NEW_IN_REGS_hst,6);
+  PR_HST(RET_NEW_IN_REGS_hst,7);
+  PR_HST(RET_NEW_IN_REGS_hst,8);
+  PR_HST(RET_OLD_IN_HEAP_hst,0);
+  PR_HST(RET_OLD_IN_HEAP_hst,1);
+  PR_HST(RET_OLD_IN_HEAP_hst,2);
+  PR_HST(RET_OLD_IN_HEAP_hst,3);
+  PR_HST(RET_OLD_IN_HEAP_hst,4);
+  PR_HST(RET_OLD_IN_HEAP_hst,5);
+  PR_HST(RET_OLD_IN_HEAP_hst,6);
+  PR_HST(RET_OLD_IN_HEAP_hst,7);
+  PR_HST(RET_OLD_IN_HEAP_hst,8);
+  PR_HST(RET_OLD_IN_REGS_hst,0);
+  PR_HST(RET_OLD_IN_REGS_hst,1);
+  PR_HST(RET_OLD_IN_REGS_hst,2);
+  PR_HST(RET_OLD_IN_REGS_hst,3);
+  PR_HST(RET_OLD_IN_REGS_hst,4);
+  PR_HST(RET_OLD_IN_REGS_hst,5);
+  PR_HST(RET_OLD_IN_REGS_hst,6);
+  PR_HST(RET_OLD_IN_REGS_hst,7);
+  PR_HST(RET_OLD_IN_REGS_hst,8);
+  PR_HST(RET_SEMI_IN_HEAP_hst,0);
+  PR_HST(RET_SEMI_IN_HEAP_hst,1);
+  PR_HST(RET_SEMI_IN_HEAP_hst,2);
+  PR_HST(RET_SEMI_IN_HEAP_hst,3);
+  PR_HST(RET_SEMI_IN_HEAP_hst,4);
+  PR_HST(RET_SEMI_IN_HEAP_hst,5);
+  PR_HST(RET_SEMI_IN_HEAP_hst,6);
+  PR_HST(RET_SEMI_IN_HEAP_hst,7);
+  PR_HST(RET_SEMI_IN_HEAP_hst,8);
+  PR_HST(RET_SEMI_IN_REGS_hst,0);
+  PR_HST(RET_SEMI_IN_REGS_hst,1);
+  PR_HST(RET_SEMI_IN_REGS_hst,2);
+  PR_HST(RET_SEMI_IN_REGS_hst,3);
+  PR_HST(RET_SEMI_IN_REGS_hst,4);
+  PR_HST(RET_SEMI_IN_REGS_hst,5);
+  PR_HST(RET_SEMI_IN_REGS_hst,6);
+  PR_HST(RET_SEMI_IN_REGS_hst,7);
+  PR_HST(RET_SEMI_IN_REGS_hst,8);
+  PR_HST(RET_VEC_RETURN_hst,0);
+  PR_HST(RET_VEC_RETURN_hst,1);
+  PR_HST(RET_VEC_RETURN_hst,2);
+  PR_HST(RET_VEC_RETURN_hst,3);
+  PR_HST(RET_VEC_RETURN_hst,4);
+  PR_HST(RET_VEC_RETURN_hst,5);
+  PR_HST(RET_VEC_RETURN_hst,6);
+  PR_HST(RET_VEC_RETURN_hst,7);
+  PR_HST(RET_VEC_RETURN_hst,8);
+
+  PR_CTR(RET_SEMI_loads_avoided);
+
+  PR_CTR(UPDF_OMITTED_ctr);
+  PR_CTR(UPDF_STD_PUSHED_ctr);
+  PR_CTR(UPDF_CON_PUSHED_ctr);
+  PR_CTR(UPDF_HOLE_PUSHED_ctr);
+
+  PR_CTR(UPDF_RCC_PUSHED_ctr);
+  PR_CTR(UPDF_RCC_OMITTED_ctr);
+
+  PR_CTR(UPD_EXISTING_ctr);
+  PR_CTR(UPD_SQUEEZED_ctr);
+  PR_CTR(UPD_CON_W_NODE_ctr);
+  PR_CTR(UPD_CON_IN_PLACE_ctr);
+  PR_CTR(UPD_CON_IN_NEW_ctr);
+  PR_CTR(UPD_PAP_IN_PLACE_ctr);
+  PR_CTR(UPD_PAP_IN_NEW_ctr);
+
+  PR_HST(UPD_CON_IN_PLACE_hst,0);
+  PR_HST(UPD_CON_IN_PLACE_hst,1);
+  PR_HST(UPD_CON_IN_PLACE_hst,2);
+  PR_HST(UPD_CON_IN_PLACE_hst,3);
+  PR_HST(UPD_CON_IN_PLACE_hst,4);
+  PR_HST(UPD_CON_IN_PLACE_hst,5);
+  PR_HST(UPD_CON_IN_PLACE_hst,6);
+  PR_HST(UPD_CON_IN_PLACE_hst,7);
+  PR_HST(UPD_CON_IN_PLACE_hst,8);
+  PR_HST(UPD_CON_IN_NEW_hst,0);
+  PR_HST(UPD_CON_IN_NEW_hst,1);
+  PR_HST(UPD_CON_IN_NEW_hst,2);
+  PR_HST(UPD_CON_IN_NEW_hst,3);
+  PR_HST(UPD_CON_IN_NEW_hst,4);
+  PR_HST(UPD_CON_IN_NEW_hst,5);
+  PR_HST(UPD_CON_IN_NEW_hst,6);
+  PR_HST(UPD_CON_IN_NEW_hst,7);
+  PR_HST(UPD_CON_IN_NEW_hst,8);
+  PR_HST(UPD_PAP_IN_NEW_hst,0);
+  PR_HST(UPD_PAP_IN_NEW_hst,1);
+  PR_HST(UPD_PAP_IN_NEW_hst,2);
+  PR_HST(UPD_PAP_IN_NEW_hst,3);
+  PR_HST(UPD_PAP_IN_NEW_hst,4);
+  PR_HST(UPD_PAP_IN_NEW_hst,5);
+  PR_HST(UPD_PAP_IN_NEW_hst,6);
+  PR_HST(UPD_PAP_IN_NEW_hst,7);
+  PR_HST(UPD_PAP_IN_NEW_hst,8);
+
+  PR_HST(UPD_ENTERED_hst,0);
+  PR_HST(UPD_ENTERED_hst,1);
+  PR_HST(UPD_ENTERED_hst,2);
+  PR_HST(UPD_ENTERED_hst,3);
+  PR_HST(UPD_ENTERED_hst,4);
+  PR_HST(UPD_ENTERED_hst,5);
+  PR_HST(UPD_ENTERED_hst,6);
+  PR_HST(UPD_ENTERED_hst,7);
+  PR_HST(UPD_ENTERED_hst,8);
+
+  PR_CTR(UPD_NEW_IND_ctr);
+  PR_CTR(UPD_NEW_IN_PLACE_PTRS_ctr);
+  PR_CTR(UPD_NEW_IN_PLACE_NOPTRS_ctr);
+  PR_CTR(UPD_OLD_IND_ctr);
+  PR_CTR(UPD_OLD_IN_PLACE_PTRS_ctr);
+  PR_CTR(UPD_OLD_IN_PLACE_NOPTRS_ctr);
+
+  PR_CTR(UPD_IN_PLACE_COPY_ctr);
+
+  PR_CTR(GC_SEL_ABANDONED_ctr);
+  PR_CTR(GC_SEL_MINOR_ctr);
+  PR_CTR(GC_SEL_MAJOR_ctr);
+  PR_CTR(GC_SHORT_IND_ctr);
+  PR_CTR(GC_SHORT_CAF_ctr);
+  PR_CTR(GC_COMMON_CHARLIKE_ctr);
+  PR_CTR(GC_COMMON_INTLIKE_ctr);
+  PR_CTR(GC_COMMON_INTLIKE_FAIL_ctr);
+  PR_CTR(GC_COMMON_CONST_ctr);
+}
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[Ticky-ent-counters]{Handle named entry counters}
+%*                                                                     *
+%************************************************************************
+
+Data structure used in ``registering'' one of these counters.
+\begin{code}
+struct ent_counter *ListOfEntryCtrs = NULL; /* root of list of them */
+\end{code}
+
+To print out all the registered-counter info:
+\begin{code}
+static void
+printRegisteredCounterInfo (FILE *tf)
+{
+    struct ent_counter *p;
+
+    if ( ListOfEntryCtrs != NULL ) {
+       fprintf(tf,"\n**************************************************\n");
+    }
+
+    for (p = ListOfEntryCtrs; p != NULL; p = p->link) {
+       /* common stuff first; then the wrapper info if avail */
+       fprintf(tf, "%-40s%u\t%u\t%u\t%-16s%ld",
+               p->f_str,
+               p->arity,
+               p->Astk_args,
+               p->Bstk_args,
+               p->f_arg_kinds,
+               p->ctr);
+
+       if ( p->wrap_str == NULL ) {
+           fprintf(tf, "\n");
+
+       } else {
+           fprintf(tf, "\t%s\t%s\n",
+               p->wrap_str,
+               p->wrap_arg_kinds);
+       }
+    }
+}
+\end{code}
+
+That's all, folks.
+\begin{code}
+#endif /* TICKY_TICKY */
+\end{code}
index 75a1bb3..fd70cd6 100644 (file)
@@ -5,7 +5,7 @@
 %****************************************************************/
 
 \begin{code}
 %****************************************************************/
 
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(GUM) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(PAR) || defined(CONCURRENT)
 #define NON_POSIX_SOURCE /* time things on Solaris -- sigh */
 #endif
 
 #define NON_POSIX_SOURCE /* time things on Solaris -- sigh */
 #endif
 
 # if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H)
 #  include <memory.h>
 # endif /* not STDC_HEADERS and HAVE_MEMORY_H */
 # if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H)
 #  include <memory.h>
 # endif /* not STDC_HEADERS and HAVE_MEMORY_H */
-# define index strchr
-# define rindex strrchr
-# define bcopy(s, d, n) memcpy ((d), (s), (n))
-# define bcmp(s1, s2, n) memcmp ((s1), (s2), (n))
-# define bzero(s, n) memset ((s), 0, (n))
+
 #else /* not STDC_HEADERS and not HAVE_STRING_H */
 # include <strings.h>
 /* memory.h and strings.h conflict on some systems.  */
 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
 
 #else /* not STDC_HEADERS and not HAVE_STRING_H */
 # include <strings.h>
 /* memory.h and strings.h conflict on some systems.  */
 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
 
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
 /* need some "time" things */
 
 /* ToDo: This is a mess! Improve ? */
 /* need some "time" things */
 
 /* ToDo: This is a mess! Improve ? */
 # ifdef HAVE_SYS_TIME_H
 #  include <sys/time.h>
 # endif
 # ifdef HAVE_SYS_TIME_H
 #  include <sys/time.h>
 # endif
-#endif /* USE_COST_CENTRES || GUM */
+#endif /* PROFILING || PAR */
 
 #ifndef PAR
 STGRegisterTable MainRegTable;
 #endif
 
 /* fwd decls */
 
 #ifndef PAR
 STGRegisterTable MainRegTable;
 #endif
 
 /* fwd decls */
-void setupRtsFlags PROTO((int *argc, char *argv[], I_ *rtsc, char *rtsv[]));
 void shutdownHaskell(STG_NO_ARGS);
 
 EXTFUN(startStgWorld);
 void shutdownHaskell(STG_NO_ARGS);
 
 EXTFUN(startStgWorld);
-extern void PrintRednCountInfo(STG_NO_ARGS);
+extern void PrintTickyInfo(STG_NO_ARGS);
 extern void checkAStack(STG_NO_ARGS);
 
 /* a real nasty Global Variable */
 extern void checkAStack(STG_NO_ARGS);
 
 /* a real nasty Global Variable */
@@ -66,22 +61,10 @@ P_ TopClosure = Main_mainPrimIO_closure;
 /* structure to carry around info about the storage manager */
 smInfo StorageMgrInfo;
 
 /* structure to carry around info about the storage manager */
 smInfo StorageMgrInfo;
 
-FILE *main_statsfile = NULL;
-#if defined(DO_REDN_COUNTING)
-FILE *tickyfile = NULL;
-#endif
-#if defined(SM_DO_BH_UPDATE)
-I_ noBlackHoles = 0;
-#endif
-I_ doSanityChks = 0;
-I_ showRednCountStats = 0;
-I_ traceUpdates = 0;
-extern I_ squeeze_upd_frames;
-
 #ifdef PAR
 #ifdef PAR
-extern I_      OkToGC, buckets, average_stats();
-extern rtsBool TraceSparks, OutputDisabled, DelaySparks,
-               DeferGlobalUpdates, ParallelStats;
+extern I_      OkToGC, buckets;
+extern rtsBool TraceSparks, DelaySparks,
+               DeferGlobalUpdates;
 
 extern void RunParallelSystem PROTO((P_));
 extern void initParallelSystem(STG_NO_ARGS);
 
 extern void RunParallelSystem PROTO((P_));
 extern void initParallelSystem(STG_NO_ARGS);
@@ -100,11 +83,6 @@ extern void *stgAllocForGMP   PROTO((size_t));
 extern void *stgReallocForGMP PROTO ((void *, size_t, size_t));
 extern void  stgDeallocForGMP PROTO ((void *, size_t));
 
 extern void *stgReallocForGMP PROTO ((void *, size_t, size_t));
 extern void  stgDeallocForGMP PROTO ((void *, size_t));
 
-#if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH
-    /* NOTE: I, WDP, do not use this in my SPAT profiling */
-W_ KHHP, KHHPLIM, KHSPA, KHSPB;
-#endif
-
 /* NeXTs can't just reach out and touch "end", to use in
    distinguishing things in static vs dynamic (malloc'd) memory.
 */
 /* NeXTs can't just reach out and touch "end", to use in
    distinguishing things in static vs dynamic (malloc'd) memory.
 */
@@ -112,9 +90,9 @@ W_ KHHP, KHHPLIM, KHSPA, KHSPB;
 void *get_end_result;
 #endif
 
 void *get_end_result;
 #endif
 
-I_    prog_argc;
+int   prog_argc; /* an "int" so as to match normal "argc" */
 char  **prog_argv;
 char  **prog_argv;
-I_    rts_argc;
+int   rts_argc;  /* ditto */
 char *rts_argv[MAX_RTS_ARGS];
 
 #ifndef PAR
 char *rts_argv[MAX_RTS_ARGS];
 
 #ifndef PAR
@@ -125,14 +103,12 @@ jmp_buf restart_main;         /* For restarting after a signal */
 unsigned nPEs = 0, nIMUs = 0;
 #endif
 
 unsigned nPEs = 0, nIMUs = 0;
 #endif
 
-#if defined(GUM)
+#if defined(PAR)
 int nPEs = 0;
 #endif
 
 int /* return type of "main" is defined by the C standard */
 int nPEs = 0;
 #endif
 
 int /* return type of "main" is defined by the C standard */
-main(argc, argv)
-    int argc;
-    char *argv[];
+main(int argc, char *argv[])
 {
 \end{code}
 
 {
 \end{code}
 
@@ -140,9 +116,7 @@ The very first thing we do is grab the start time...just in case we're
 collecting timing statistics.
 
 \begin{code}
 collecting timing statistics.
 
 \begin{code}
-
     start_time();
     start_time();
-
 \end{code}
 
 The parallel system needs to be initialised and synchronised before
 \end{code}
 
 The parallel system needs to be initialised and synchronised before
@@ -153,19 +127,18 @@ Manager's requirements.
 \begin{code}
 #ifdef PAR
     /* 
 \begin{code}
 #ifdef PAR
     /* 
-     * Grab the number of PEs out of the argument vector, and eliminate it
-     * from further argument processing
+     * Grab the number of PEs out of the argument vector, and
+     * eliminate it from further argument processing.
      */
     nPEs = atoi(argv[1]);
     argv[1] = argv[0];
     argv++;
     argc--;
 
      */
     nPEs = atoi(argv[1]);
     argv[1] = argv[0];
     argv++;
     argc--;
 
-/*    fprintf(stderr, "I'm alive, nPEs = %d \n", nPEs);    */
     SynchroniseSystem();
 #endif
 
     SynchroniseSystem();
 #endif
 
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
     /* setup string indicating time of run -- only used for profiling */
     (void) time_str();
 #endif
     /* setup string indicating time of run -- only used for profiling */
     (void) time_str();
 #endif
@@ -175,12 +148,17 @@ Manager's requirements.
 #endif
 
     /* 
 #endif
 
     /* 
-       divide the command-line args between pgm and RTS;
-       figure out what statsfile to use (if any);
-       [if so, write the whole cmd-line into it]
+       divide the command-line args between pgm and RTS; figure out
+       what statsfile to use (if any); [if so, write the whole
+       cmd-line into it]
        
        This is unlikely to work well in parallel!  KH.
     */
        
        This is unlikely to work well in parallel!  KH.
     */
+    initRtsFlagsDefaults();
+    defaultsHook(); /* the one supplied does nothing;
+                      the user may have supplied a more interesting one.
+                   */
+
     setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
     prog_argc = argc;
     prog_argv = argv;
     setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
     prog_argc = argc;
     prog_argv = argv;
@@ -190,15 +168,7 @@ Manager's requirements.
    initParallelSystem();
 #endif /* PAR */
 
    initParallelSystem();
 #endif /* PAR */
 
-#if defined(LIFE_PROFILE)
-    if (life_profile_init(rts_argv, prog_argv) != 0) {
-        fflush(stdout);
-       fprintf(stderr, "life_profile_init failed!\n");
-       EXIT(EXIT_FAILURE);
-    }
-#endif
-
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
     if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
         fflush(stdout);
        fprintf(stderr, "init_cc_profiling failed!\n");
     if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
         fflush(stdout);
        fprintf(stderr, "init_cc_profiling failed!\n");
@@ -214,64 +184,41 @@ Manager's requirements.
 #endif
 
 #ifdef PAR
 #endif
 
 #ifdef PAR
-    if (do_gr_profile)
+    if (RTSflags.ParFlags.granSimStats)
        init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
 #endif
 
        init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
 #endif
 
-    /* 
-       initialize the storage manager
-    */
-    if ( initSM(rts_argc, rts_argv, main_statsfile) != 0) {
-        fflush(stdout);
-       fprintf(stderr, "initSM failed!\n");
-       EXIT(EXIT_FAILURE);
-    }
+    /* initialize the storage manager */
+    initSM();
 
 #ifndef PAR
 
 #ifndef PAR
-    if ( initStacks( &StorageMgrInfo ) != 0) {
+    if (! initStacks( &StorageMgrInfo )) {
         fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
        EXIT(EXIT_FAILURE);
     }
 #endif
 
         fflush(stdout);
        fprintf(stderr, "initStacks failed!\n");
        EXIT(EXIT_FAILURE);
     }
 #endif
 
-    if ( initHeap( &StorageMgrInfo ) != 0) {
+    if (! initHeap( &StorageMgrInfo )) {
         fflush(stdout);
         fflush(stdout);
-       fprintf(stderr, "initHeap failed!\n"); EXIT(EXIT_FAILURE);
+       fprintf(stderr, "initHeap failed!\n");
+       EXIT(EXIT_FAILURE);
     }
 
 #if defined(CONCURRENT) && !defined(GRAN)
     }
 
 #if defined(CONCURRENT) && !defined(GRAN)
-    if (!initThreadPools(MaxLocalSparks)) {
+    if (!initThreadPools()) {
         fflush(stdout);
        fprintf(stderr, "initThreadPools failed!\n"); 
         EXIT(EXIT_FAILURE);
     }
 #endif
 
         fflush(stdout);
        fprintf(stderr, "initThreadPools failed!\n"); 
         EXIT(EXIT_FAILURE);
     }
 #endif
 
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
     /* call cost centre registering routine (after heap allocated) */
     cc_register();
 #endif
 
     /* call cost centre registering routine (after heap allocated) */
     cc_register();
 #endif
 
-/* Information needed by runtime trace analysers -- don't even ask what it does! */
-  /* NOTE: I, WDP, do not use this in my SPAT profiling */
-#if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH
-   KHHPLIM = (W_) StorageMgrInfo.hplim;
-   KHHP =    (W_) StorageMgrInfo.hp;
-   KHSPA =   (W_) SAVE_SpA,
-   KHSPB =   (W_) SAVE_SpB;
-
-/*  fprintf(stderr,"Hp = %lx, HpLim = %lx, SpA = %lx, SpB = %lx\n",KHHP,KHHPLIM,KHSPA,KHSPB); */
-
-/* NOT ME:
-  __asm__("sethi %%hi(_KHHP),%%o0\n\tld [%%o0+%%lo(_KHHP)],%%g0" : : : "%%o0");
-  __asm__("sethi %%hi(_KHHPLIM),%%o0\n\tld [%%o0+%%lo(_KHHPLIM)],%%g0" : : : "%%o0");
-  __asm__("sethi %%hi(_KHSPA),%%o0\n\tld [%%o0+%%lo(_KHSPA)],%%g0" : : : "%%o0");
-  __asm__("sethi %%hi(_KHSPB),%%o0\n\tld [%%o0+%%lo(_KHSPB)],%%g0" : : : "%%o0");
-*/
-#endif
-
-#if defined(DO_REDN_COUNTING)
+#if defined(TICKY_TICKY)
     max_SpA = MAIN_SpA; /* initial high-water marks */
     max_SpB = MAIN_SpB;
 #endif
     max_SpA = MAIN_SpA; /* initial high-water marks */
     max_SpB = MAIN_SpB;
 #endif
@@ -282,7 +229,7 @@ Manager's requirements.
     /* Record initialization times */
     end_init();
 
     /* Record initialization times */
     end_init();
 
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
     /* 
      * Both the context-switcher and the cost-center profiler use 
      * a virtual timer.
     /* 
      * Both the context-switcher and the cost-center profiler use 
      * a virtual timer.
@@ -292,24 +239,25 @@ Manager's requirements.
        fprintf(stderr, "Can't install VTALRM handler.\n");
        EXIT(EXIT_FAILURE);
     }
        fprintf(stderr, "Can't install VTALRM handler.\n");
        EXIT(EXIT_FAILURE);
     }
-#if (defined(CONCURRENT) && defined(USE_COST_CENTRES)) || defined(GUM)
-    if (time_profiling) {
-       if (contextSwitchTime % (1000/TICK_FREQUENCY) == 0)
-           tick_millisecs = TICK_MILLISECS;
+#if (defined(CONCURRENT) && defined(PROFILING)) || defined(PAR)
+    if (! time_profiling)
+       RTSflags.CcFlags.msecsPerTick = RTSflags.ConcFlags.ctxtSwitchTime;
+    else {
+       if (RTSflags.ConcFlags.ctxtSwitchTime % (1000/TICK_FREQUENCY) == 0)
+           RTSflags.CcFlags.msecsPerTick = TICK_MILLISECS;
        else
        else
-           tick_millisecs = CS_MIN_MILLISECS;
+           RTSflags.CcFlags.msecsPerTick = CS_MIN_MILLISECS;
 
 
-       contextSwitchTicks = contextSwitchTime / tick_millisecs;
-       profilerTicks = TICK_MILLISECS / tick_millisecs;
-    } else
-       tick_millisecs = contextSwitchTime;
+       RTSflags.CcFlags.ctxtSwitchTicks = RTSflags.ConcFlags.ctxtSwitchTime / RTSflags.CcFlags.msecsPerTick;
+       RTSflags.CcFlags.profilerTicks = TICK_MILLISECS / RTSflags.CcFlags.msecsPerTick;
+    }
 #endif
 
 #ifndef CONCURRENT
     START_TIME_PROFILER;
 #endif
 
 #endif
 
 #ifndef CONCURRENT
     START_TIME_PROFILER;
 #endif
 
-#endif /* USE_COST_CENTRES || CONCURRENT */
+#endif /* PROFILING || CONCURRENT */
 
 #ifndef PAR
     setjmp(restart_main);
 
 #ifndef PAR
     setjmp(restart_main);
@@ -345,14 +293,8 @@ Manager's requirements.
 
 #else  /* not threaded (sequential) */
 
 
 #else  /* not threaded (sequential) */
 
-# if defined(__STG_TAILJUMPS__)
     miniInterpret((StgFunPtr)startStgWorld);
     miniInterpret((StgFunPtr)startStgWorld);
-# else
-    if (doSanityChks)
-       miniInterpret_debug((StgFunPtr)startStgWorld, checkAStack);
-    else
-       miniInterpret((StgFunPtr)startStgWorld);
-# endif /* not tail-jumping */
+
 #endif /* !CONCURRENT */
 
     shutdownHaskell();
 #endif /* !CONCURRENT */
 
     shutdownHaskell();
@@ -373,29 +315,21 @@ shutdownHaskell(STG_NO_ARGS)
 {
     STOP_TIME_PROFILER;
 
 {
     STOP_TIME_PROFILER;
 
-    if (exitSM(&StorageMgrInfo) != 0) {
+    if (! exitSM(&StorageMgrInfo)) {
        fflush(stdout);
        fprintf(stderr, "exitSM failed!\n");
        EXIT(EXIT_FAILURE);
     }
        fflush(stdout);
        fprintf(stderr, "exitSM failed!\n");
        EXIT(EXIT_FAILURE);
     }
-#if defined(LIFE_PROFILE)
-    {
-       extern P_ hp_start;     /* from the SM -- Hack! */
-       life_profile_finish(StorageMgrInfo.hp - hp_start, prog_argv);
-    }
-#endif
 
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     heap_profile_finish();
 #endif
     heap_profile_finish();
 #endif
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
     report_cc_profiling(1 /* final */ );
 #endif
 
     report_cc_profiling(1 /* final */ );
 #endif
 
-#if defined(DO_REDN_COUNTING)
-    if (showRednCountStats) {
-       PrintRednCountInfo();
-    }
+#if defined(TICKY_TICKY)
+    if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
 
 #if defined(GRAN_CHECK) && defined(GRAN)
 #endif
 
 #if defined(GRAN_CHECK) && defined(GRAN)
@@ -430,861 +364,13 @@ shutdownHaskell(STG_NO_ARGS)
 }
 \end{code}
 
 }
 \end{code}
 
-%/****************************************************************
-%*                                                             *
-%*         Getting default settings for RTS parameters         *
-%*                                                             *
-%* +RTS indicates following arguments destined for RTS          *
-%* -RTS indicates following arguments destined for program      *
-%*                                                              *
-%****************************************************************/
-\begin{code}
-
-char *flagtext[] = {
-"",
-"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
-"",
-"   +RTS    Indicates run time system options follow",
-"   -RTS    Indicates program arguments follow",
-"  --RTS    Indicates that ALL subsequent arguments will be given to the",
-"           program (including any of these RTS flags)",
-"",
-"The following run time system options are available:",
-"",
-"  -? -f    Prints this message and exits; the program is not executed",
-"",
-"  -K<size> Sets the stack size (default 64k)    Egs: -K32k   -K512k",
-"  -H<size> Sets the heap size  (default 4M)          -H512k  -H16M",
-"  -s<file> Summary GC statistics   (default file: <program>.stat)",
-"  -S<file> Detailed GC statistics  (with -Sstderr going to stderr)",
-"",
-#if defined(GCap)
-"  -M<n>%   Sets minimum size of alloc area as % of heap (default 3%)",
-"  -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)",
-"  -G<size> Fixes size of major generation (default is dynamic threshold)",
-"  -F2s     Forces program compiled for Appel gc to use 2s collection",
-#else
-# if defined(GCgn)
-"  -A<size> Specifies size of alloc area (default 64k)",
-"  -G<size> Fixes size of major generation (default is available heap)",
-"  -F2s     Forces program compiled for Gen gc to use 2s collection",
-# else
-"  -M<n>%   Minimum % of heap which must be available (default 3%)",
-"  -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)",
-# endif
-#endif
-#if defined(FORCE_GC)
-"  -j<size>  Forces major GC at every <size> bytes allocated",
-#endif /* FORCE_GC */
-#if defined(GCdu)
-"  -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
-#endif
-"",
-#if defined(SM_DO_BH_UPDATE)
-"  -N       No black-holing (for use when a signal handler is present)",
-#endif
-"  -Z       Don't squeeze out update frames on stack overflow",
-"  -B      Sound the bell at the start of each (major) garbage collection",
-#if defined(USE_COST_CENTRES) || defined(GUM)
-"",
-"  -p<sort> Produce cost centre time profile  (output file <program>.prof)",
-"             sort: T = time (default), A = alloc, C = cost centre label",
-"  -P<sort> Produce serial time profile (output file <program>.time)",
-"             and a -p profile with detailed caf/enter/tick/alloc info",
-#if defined(USE_COST_CENTRES)
-"",
-"  -h<break-down> Heap residency profile      (output file <program>.hp)",
-"     break-down: C = cost centre (default), M = module, G = group",
-"                 D = closure description, Y = type description",
-"                 T<ints>,<start> = time closure created",
-"                    ints:  no. of interval bands plotted (default 18)",
-"                    start: seconds after which intervals start (default 0.0)",
-"  A subset of closures may be selected by the attached cost centre using:",
-"    -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
-"    -m{mod,mod...} all cost centres from the specified modules(s)",
-"    -g{grp,grp...} all cost centres from the specified group(s)",
-"  Selections can also be made by description, type, kind and age:",
-"    -d{des,des...} closures with specified closure descriptions",
-"    -y{typ,typ...} closures with specified type descriptions",
-"    -k{knd,knd...} closures of the specified kinds",
-"    -a<age>        closures which survived <age> complete intervals",
-"  The selection logic used is summarised as follows:",
-"    ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
-"    where an option is true if not specified",
-#endif
-"",
-"  -z<tbl><size>  set hash table <size> for <tbl> (C, M, G, D or Y)",
-"",
-"  -i<secs> Number of seconds in a profiling interval (default 1.0):",
-"           heap profile (-h) and/or serial time profile (-P) frequency",
-#endif /* USE_COST_CENTRES */
-#if defined(LIFE_PROFILE)
-"",
-"  -l<res>  Produce liftime and update profile (output file <program>.life)",
-"              res: the age resolution in bytes allocated   (default 10,000)",
-#endif /* LIFE_PROFILE */
-"",
-#if defined(DO_REDN_COUNTING)
-"  -r<file>  Produce reduction profiling statistics (with -rstderr for stderr)",
-"",
-#endif
-"  -I       Use debugging miniInterpret with stack and heap sanity-checking.",
-"  -T<level> Trace garbage collection execution (debugging)",
-#ifdef CONCURRENT
-"",
-# ifdef PAR
-"  -N<n>     Use <n> PVMish processors in parallel (default: 2)",
-/* NB: the -N<n> is implemented by the driver!! */
-# endif
-"  -C<secs>  Context-switch interval in seconds",
-"                (0 or no argument means switch as often as possible)",
-"                the default is .01 sec; resolution is .01 sec",
-"  -e<size>        Size of spark pools (default 100)",
-# ifdef PAR
-"  -q        Enable activity profile (output files in ~/<program>*.gr)",
-"  -qb       Enable binary activity profile (output file /tmp/<program>.gb)",
-#else
-"  -q[v]     Enable quasi-parallel profile (output file <program>.qp)",
-# endif
-"  -t<num>   Set maximum number of advisory threads per PE (default 32)",
-"  -o<num>   Set stack chunk size (default 1024)",
-# ifdef PAR
-"  -d        Turn on PVM-ish debugging",
-"  -O        Disable output for performance measurement",
-# endif /* PAR */
-#endif /* CONCURRENT */
-"",
-"Other RTS options may be available for programs compiled a different way.",
-"The GHC User's Guide has full details.",
-"",
-0
-};
-
-#define RTS 1
-#define PGM 0
-
-#ifndef atof
-extern double atof();
-/* no proto because some machines use const and some do not */
-#endif
-
-void
-setupRtsFlags(argc, argv, rts_argc, rts_argv)
-int *argc;
-I_ *rts_argc;
-char *argv[], *rts_argv[];
-{
-    I_ error = 0;
-    I_ mode;
-    I_ arg, total_arg;
-    char *last_slash;
-
-    /* Remove directory from argv[0] -- default files in current directory */
-
-    if ((last_slash = (char *) rindex(argv[0], '/')) != NULL)
-       strcpy(argv[0], last_slash+1);
-
-    /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
-    /*   argv[0] must be PGM argument -- leave in argv                 */
-
-    total_arg = *argc;
-    arg = 1;
-
-    *argc = 1;
-    *rts_argc = 0;
-
-    for (mode = PGM; arg < total_arg && strcmp("--RTS", argv[arg]) != 0; arg++) {
-       if (strcmp("+RTS", argv[arg]) == 0) {
-           mode = RTS;
-       }
-       else if (strcmp("-RTS", argv[arg]) == 0) {
-           mode = PGM;
-       }
-       else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
-           rts_argv[(*rts_argc)++] = argv[arg];
-       }
-       else if (mode == PGM) {
-           argv[(*argc)++] = argv[arg];
-       }
-       else {
-           fflush(stdout);
-           fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
-                   MAX_RTS_ARGS-1);
-           EXIT(EXIT_FAILURE);
-       }
-    }
-    if (arg < total_arg) {
-       /* arg must be --RTS; process remaining program arguments */
-       while (++arg < total_arg) {
-           argv[(*argc)++] = argv[arg];
-       }
-    }
-    argv[*argc] = (char *) 0;
-    rts_argv[*rts_argc] = (char *) 0;
-
-    /* Process RTS (rts_argv) part: mainly to determine statsfile */
-
-    for (arg = 0; arg < *rts_argc; arg++) {
-       if (rts_argv[arg][0] == '-') {
-           switch(rts_argv[arg][1]) {
-             case '?':
-             case 'f':
-               error = 1;
-               break;
-
-             case 'Z': /* Don't squeeze out update frames */
-                   squeeze_upd_frames = 0;
-               break;
-
-#if defined(SM_DO_BH_UPDATE)
-             case 'N':
-               noBlackHoles++;
-               break;
-#endif
-
-             case 'I':
-               doSanityChks++;
-#if defined(__STG_TAILJUMPS__)
-               /* Blech -- too many errors if run in parallel -- KH */
-               fprintf(stderr, "setupRtsFlags: Using Tail Jumps: Sanity checks not possible: %s\n", rts_argv[arg]);
-               error = 1;
-#endif
-               break;
-
-             case 'U':
-               traceUpdates++;
-#if ! defined(DO_RUNTIME_TRACE_UPDATES)
-               fprintf(stderr, "setupRtsFlags: Update Tracing not compiled in: %s\n", rts_argv[arg]);
-               error = 1;
-#endif
-               break;
-
-             case 'r': /* Basic profiling stats */
-               showRednCountStats++;
-#if ! defined(DO_REDN_COUNTING)
-               fprintf(stderr, "setupRtsFlags: Reduction counting not compiled in: %s\n", rts_argv[arg]);
-               error = 1;
-
-#else /* ticky-ticky! */
-               if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */
-                   tickyfile = stderr;
-               else if (rts_argv[arg][2] != '\0')          /* ticky file specified */
-                   tickyfile = fopen(rts_argv[arg]+2,"w");
-               else {
-                   char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.ticky */
-                   sprintf(stats_filename, TICKY_FILENAME_FMT, argv[0]);
-                   tickyfile = fopen(stats_filename,"w");
-               }
-               if (tickyfile == NULL) {
-                   fprintf(stderr, "Can't open tickyfile %s\n",
-                               rts_argv[arg]+2);
-                   error = 1;
-               } else {
-                   /* Write argv and rtsv into start of ticky file */
-                   I_ count;
-                   for(count = 0; count < *argc; count++)
-                       fprintf(tickyfile, "%s ", argv[count]);
-                   fprintf(tickyfile, "+RTS ");
-                   for(count = 0; count < *rts_argc; count++)
-                       fprintf(tickyfile, "%s ", rts_argv[count]);
-                   fprintf(tickyfile, "\n");
-               }
-#endif /* ticky-ticky! */
-               break;
-
-             case 's': /* Also used by GC -- open file here */
-             case 'S':
-#ifdef PAR
-               /* Opening all those files would almost certainly fail... */
-               ParallelStats = rtsTrue;
-               main_statsfile = stderr; /* temporary; ToDo: rm */
-#else
-               if (strcmp(rts_argv[arg]+2, "stderr") == 0)       /* use real stderr */
-                   main_statsfile = stderr;
-               else if (rts_argv[arg][2] != '\0')                /* stats file specified */
-                   main_statsfile = fopen(rts_argv[arg]+2,"w");
-               else {
-                   char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.stat */
-                   sprintf(stats_filename, STAT_FILENAME_FMT, argv[0]);
-                   main_statsfile = fopen(stats_filename,"w");
-               }
-               if (main_statsfile == NULL) {
-                   fprintf(stderr, "Can't open statsfile %s\n", rts_argv[arg]+2);
-                   error = 1;
-               } else {
-                   /* Write argv and rtsv into start of stats file */
-                   I_ count;
-                   for(count = 0; count < *argc; count++)
-                       fprintf(main_statsfile, "%s ", argv[count]);
-                   fprintf(main_statsfile, "+RTS ");
-                   for(count = 0; count < *rts_argc; count++)
-                       fprintf(main_statsfile, "%s ", rts_argv[count]);
-                   fprintf(main_statsfile, "\n");
-               }
-#endif
-               break;
-
-             case 'P': /* detailed cost centre profiling (time/alloc) */
-             case 'p': /* cost centre profiling (time/alloc) */
-             case 'i': /* serial profiling -- initial timer interval */
-#if ! (defined(USE_COST_CENTRES) || defined(GUM))
-               fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]);
-               error = 1;
-#endif /* ! (USE_COST_CENTRES || GUM) */
-               break;
-             case 'h': /* serial heap profile */
-             case 'z': /* size of index tables */
-             case 'c': /* cost centre label select */
-             case 'm': /* cost centre module select */
-             case 'g': /* cost centre group select */
-             case 'd': /* closure descr select */
-             case 'y': /* closure type select */
-             case 'k': /* closure kind select */
-             case 'a': /* closure age select */
-#if ! defined(USE_COST_CENTRES)
-               fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]);
-               error = 1;
-#endif /* ! USE_COST_CENTRES */
-               break;
-
-             case 'j': /* force GC option */
-#if defined(FORCE_GC)
-               force_GC++;
-               if (rts_argv[arg][2]) {
-                   GCInterval = decode(rts_argv[arg]+2) / sizeof(W_);
-               }
-#else  /* ! FORCE_GC */
-               fprintf(stderr, "setupRtsFlags: Not built for forcing GC: %s\n", rts_argv[arg]);
-               error = 1;
-#endif /* ! FORCE_GC */
-               break;
-
-             case 'l': /* life profile option */
-#if defined(LIFE_PROFILE)
-               do_life_prof++;
-               if (rts_argv[arg][2]) {
-                   LifeInterval = decode(rts_argv[arg]+2) / sizeof(W_);
-               }
-#else  /* ! LIFE_PROFILE */
-               fprintf(stderr, "setupRtsFlags: Not built for lifetime profiling: %s\n", rts_argv[arg]);
-               error = 1;
-#endif /* ! LIFE_PROFILE */
-               break;
-
-             /* Flags for the threaded RTS */
-
-#ifdef CONCURRENT
-             case 'C': /* context switch interval */
-               if (rts_argv[arg][2] != '\0') {
-                   /* Convert to milliseconds */
-                   contextSwitchTime = (I_) ((atof(rts_argv[arg]+2) * 1000));
-                   contextSwitchTime = (contextSwitchTime / CS_MIN_MILLISECS)
-                                       * CS_MIN_MILLISECS;
-                   if (contextSwitchTime < CS_MIN_MILLISECS)
-                       contextSwitchTime = CS_MIN_MILLISECS;
-               } else
-                   contextSwitchTime = 0;
-               break;
-#if !defined(GRAN)
-             case 'e':
-               if (rts_argv[arg][2] != '\0') {
-                   MaxLocalSparks = strtol(rts_argv[arg]+2, (char **) NULL, 10);
-                   if (MaxLocalSparks <= 0) {
-                       fprintf(stderr, "setupRtsFlags: bad value for -e\n");
-                       error = 1;
-                   }
-               } else
-                   MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS;
-               break;
-#endif
-#ifdef PAR
-             case 'q': /* activity profile option */
-               if (rts_argv[arg][2] == 'b')
-                   do_gr_binary++;
-               else
-                   do_gr_profile++;
-               break;
-#else
-             case 'q': /* quasi-parallel profile option */
-               if (rts_argv[arg][2] == 'v')
-                   do_qp_prof = 2;
-               else
-                   do_qp_prof++;
-               break;
-#endif
-             case 't':
-               if (rts_argv[arg][2] != '\0') {
-                   MaxThreads = strtol(rts_argv[arg]+2, (char **) NULL, 10);
-               } else {
-                   fprintf(stderr, "setupRtsFlags: missing size for -t\n");
-                   error = 1;
-               }
-               break;
-
-             case 'o':
-               if (rts_argv[arg][2] != '\0') {
-                   StkOChunkSize = decode(rts_argv[arg]+2);
-                   if (StkOChunkSize < MIN_STKO_CHUNK_SIZE)
-                       StkOChunkSize = MIN_STKO_CHUNK_SIZE;
-               } else {
-                   fprintf(stderr, "setupRtsFlags: missing size for -o\n");
-                   error = 1;
-               }
-               break;
-
-# ifdef PAR
-             case 'O':
-               OutputDisabled = rtsTrue;
-               break;
-
-# else /* PAR */
-
-#  if !defined(GRAN)
-             case 'b': /* will fall through to disaster */
-#  else
-             case 'b':
-               if (rts_argv[arg][2] != '\0') {
-
-                 /* Should we emulate hbcpp */
-                 if(strcmp((rts_argv[arg]+2),"roken")==0) {
-                   ++DoAlwaysCreateThreads;
-                   strcpy(rts_argv[arg]+2,"oring");
-                 }
-
-                 /* or a ridiculously idealised simulator */
-                 if(strcmp((rts_argv[arg]+2),"oring")==0) {
-                   gran_latency = gran_fetchtime = gran_additional_latency =
-                     gran_gunblocktime = gran_lunblocktime
-                       = gran_threadcreatetime = gran_threadqueuetime
-                         = gran_threadscheduletime = gran_threaddescheduletime
-                           = gran_threadcontextswitchtime
-                             = 0;
-
-                   gran_mpacktime = gran_munpacktime = 0;
-
-                   gran_arith_cost = gran_float_cost = gran_load_cost
-                     = gran_store_cost = gran_branch_cost = 0;
-
-                   gran_heapalloc_cost = 1;
-
-                   /* ++DoFairSchedule; */
-                   ++DoStealThreadsFirst;
-                   ++DoThreadMigration;
-                   ++do_gr_profile;
-                 }
-
-                 /* or a ridiculously idealised simulator */
-                 if(strcmp((rts_argv[arg]+2),"onzo")==0) {
-                   gran_latency = gran_fetchtime = gran_additional_latency =
-                     gran_gunblocktime = gran_lunblocktime
-                       = gran_threadcreatetime = gran_threadqueuetime
-                         = gran_threadscheduletime = gran_threaddescheduletime
-                           = gran_threadcontextswitchtime
-                             = 0;
-
-                   gran_mpacktime = gran_munpacktime = 0;
-
-                   /* Keep default values for these
-                   gran_arith_cost = gran_float_cost = gran_load_cost
-                     = gran_store_cost = gran_branch_cost = 0;
-                     */
-
-                   gran_heapalloc_cost = 1;
-
-                   /* ++DoFairSchedule; */       /* -b-R */
-                   /* ++DoStealThreadsFirst; */  /* -b-T */
-                   ++DoReScheduleOnFetch;        /* -bZ */
-                   ++DoThreadMigration;          /* -bM */
-                   ++do_gr_profile;              /* -bP */
-#   if defined(GRAN_CHECK) && defined(GRAN)
-                   debug = 0x20;       /* print event statistics   */
-#   endif
-                 }
-
-                 /* Communication and task creation cost parameters */
-                 else switch(rts_argv[arg][2]) {
-                   case 'l':
-                     if (rts_argv[arg][3] != '\0')
-                       {
-                         gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
-                         gran_fetchtime = 2* gran_latency;
-                       }
-                     else
-                       gran_latency = LATENCY;
-                     break;
-
-                   case 'a':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_additional_latency = decode(rts_argv[arg]+3);
-                     else
-                       gran_additional_latency = ADDITIONAL_LATENCY;
-                     break;
-
-                   case 'm':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_mpacktime = decode(rts_argv[arg]+3);
-                     else
-                       gran_mpacktime = MSGPACKTIME;
-                     break;
-
-                   case 'x':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_mtidytime = decode(rts_argv[arg]+3);
-                     else
-                       gran_mtidytime = 0;
-                     break;
-
-                   case 'r':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_munpacktime = decode(rts_argv[arg]+3);
-                     else
-                       gran_munpacktime = MSGUNPACKTIME;
-                     break;
-
-                   case 'f':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_fetchtime = decode(rts_argv[arg]+3);
-                     else
-                       gran_fetchtime = FETCHTIME;
-                     break;
-
-                   case 'n':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_gunblocktime = decode(rts_argv[arg]+3);
-                     else
-                       gran_gunblocktime = GLOBALUNBLOCKTIME;
-                     break;
-
-                   case 'u':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_lunblocktime = decode(rts_argv[arg]+3);
-                     else
-                       gran_lunblocktime = LOCALUNBLOCKTIME;
-                     break;
-
-                   /* Thread-related metrics */
-                   case 't':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_threadcreatetime = decode(rts_argv[arg]+3);
-                     else
-                       gran_threadcreatetime = THREADCREATETIME;
-                     break;
-
-                   case 'q':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_threadqueuetime = decode(rts_argv[arg]+3);
-                     else
-                       gran_threadqueuetime = THREADQUEUETIME;
-                     break;
-
-                   case 'c':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_threadscheduletime = decode(rts_argv[arg]+3);
-                     else
-                       gran_threadscheduletime = THREADSCHEDULETIME;
-
-                     gran_threadcontextswitchtime = gran_threadscheduletime
-                                                  + gran_threaddescheduletime;
-                     break;
-
-                   case 'd':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_threaddescheduletime = decode(rts_argv[arg]+3);
-                     else
-                       gran_threaddescheduletime = THREADDESCHEDULETIME;
-
-                     gran_threadcontextswitchtime = gran_threadscheduletime
-                                                  + gran_threaddescheduletime;
-                     break;
-
-                   /* Instruction Cost Metrics */
-                   case 'A':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_arith_cost = decode(rts_argv[arg]+3);
-                     else
-                       gran_arith_cost = ARITH_COST;
-                     break;
-
-                   case 'F':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_float_cost = decode(rts_argv[arg]+3);
-                     else
-                       gran_float_cost = FLOAT_COST;
-                     break;
-                     
-                   case 'B':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_branch_cost = decode(rts_argv[arg]+3);
-                     else
-                       gran_branch_cost = BRANCH_COST;
-                     break;
-
-                   case 'L':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_load_cost = decode(rts_argv[arg]+3);
-                     else
-                       gran_load_cost = LOAD_COST;
-                     break;
-
-                   case 'S':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_store_cost = decode(rts_argv[arg]+3);
-                     else
-                       gran_store_cost = STORE_COST;
-                     break;
-
-                   case 'H':
-                     if (rts_argv[arg][3] != '\0')
-                       gran_heapalloc_cost = decode(rts_argv[arg]+3);
-                     else
-                       gran_heapalloc_cost = 0;
-                     break;
-
-                   case 'y':
-                     if (rts_argv[arg][3] != '\0')
-                       FetchStrategy = decode(rts_argv[arg]+3);
-                     else
-                       FetchStrategy = 4; /* default: fetch everything */
-                     break;
-
-                   /* General Parameters */
-                   case 'p':
-                     if (rts_argv[arg][3] != '\0')
-                       {
-                         max_proc = decode(rts_argv[arg]+3);
-                         if(max_proc > MAX_PROC || max_proc < 1)
-                           {
-                             fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
-                             error = 1;
-                           }
-                       }
-                     else
-                       max_proc = MAX_PROC;
-                     break;
-
-                   case 'C':
-                     ++DoAlwaysCreateThreads;
-                     ++DoThreadMigration;
-                     break;
-
-                   case 'G':
-                     ++DoGUMMFetching;
-                     break;
-
-                   case 'M':
-                     ++DoThreadMigration;
-                     break;
-
-                   case 'R':
-                     ++DoFairSchedule;
-                     break;
-
-                   case 'T':
-                     ++DoStealThreadsFirst;
-                     ++DoThreadMigration;
-                     break;
-
-                   case 'Z':
-                     ++DoReScheduleOnFetch;
-                     break;
-
-                   case 'z':
-                     ++SimplifiedFetch;
-                     break;
-
-                   case 'N':
-                     ++PreferSparksOfLocalNodes;
-                     break;
-
-                   case 'b':
-                     ++do_gr_binary;
-                     break;
-
-                   case 'P':
-                     ++do_gr_profile;
-                     break;
-
-                   case 's':
-                     ++do_sp_profile;
-                     break;
-
-                   case '-':
-                     switch(rts_argv[arg][3]) {
-
-                      case 'C':
-                        DoAlwaysCreateThreads=0;
-                        DoThreadMigration=0;
-                        break;
-
-                      case 'G':
-                        DoGUMMFetching=0;
-                        break;
-
-                      case 'M':
-                        DoThreadMigration=0;
-                        break;
-
-                       case 'R':
-                        DoFairSchedule=0;
-                        break;
-
-                      case 'T':
-                        DoStealThreadsFirst=0;
-                        DoThreadMigration=0;
-                        break;
-
-                      case 'Z':
-                        DoReScheduleOnFetch=0;
-                        break;
-
-                      case 'N':
-                        PreferSparksOfLocalNodes=0;
-                        break;
-
-                      case 'P':
-                        do_gr_profile=0;
-                        no_gr_profile=1;
-                        break;
-
-                      case 's':
-                        do_sp_profile=0;
-                        break;
-
-                      case 'b':
-                        do_gr_binary=0;
-                        break;
-
-                      default:
-                        badoption( rts_argv[arg] );
-                        break;
-                      }
-                     break;
-
-#   if defined(GRAN_CHECK) && defined(GRAN)
-                   case 'D':
-                     switch(rts_argv[arg][3]) {
-                         case 'e':       /* event trace */
-                           fprintf(stderr,"Printing event trace.\n");
-                           ++event_trace;
-                           break;
-
-                         case 'f':
-                           fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
-                           debug |= 0x2; /* print fwd messages */
-                           break;
-
-                         case 'z':
-                           fprintf(stderr,"Check for blocked on fetch.\n");
-                           debug |= 0x4; /* debug non-reschedule-on-fetch */
-                           break;
-
-                         case 't':
-                           fprintf(stderr,"Check for TSO asleep on fetch.\n");
-                           debug |= 0x10; /* debug TSO asleep for fetch  */
-                           break;
-
-                         case 'E':
-                           fprintf(stderr,"Printing event statistics.\n");
-                           debug |= 0x20; /* print event statistics   */
-                           break;
-
-                         case 'F':
-                           fprintf(stderr,"Prohibiting forward.\n");
-                           NoForward = 1; /* prohibit forwarding   */
-                           break;
-
-                         case 'm':
-                           fprintf(stderr,"Printing fetch misses.\n");
-                           PrintFetchMisses = 1; /* prohibit forwarding   */
-                           break;
-
-                         case 'd':
-                           fprintf(stderr,"Debug mode.\n");
-                           debug |= 0x40; 
-                           break;
-
-                         case 'D':
-                           fprintf(stderr,"Severe debug mode.\n");
-                           debug |= 0x80; 
-                           break;
-
-                         case '\0':
-                           debug = 1;
-                           break;
-
-                         default:
-                           badoption( rts_argv[arg] );
-                           break;
-                         }
-                     break;
-#   endif
-                   default:
-                     badoption( rts_argv[arg] );
-                     break;
-                   }
-               }
-               do_gr_sim++;
-               contextSwitchTime = 0;
-               break;
-#  endif
-             case 'J':
-             case 'Q':
-             case 'D':
-             case 'R':
-             case 'L':
-             case 'O':
-               fprintf(stderr, "setupRtsFlags: Not built for parallel execution: %s\n", rts_argv[arg]);
-               error = 1;
-# endif        /* PAR */
-#else  /* CONCURRENT */
-             case 't':
-               fprintf(stderr, "setupRtsFlags: Not built for threaded execution: %s\n", rts_argv[arg]);
-               error = 1;
-
-#endif /* CONCURRENT */
-             case 'H': /* SM options -- ignore */
-             case 'A':
-             case 'G':
-             case 'F':
-             case 'K':
-             case 'M':
-             case 'B':
-             case 'T':
-#ifdef GCdu
-             case 'u': /* set dual mode threshold */
-#endif
-               break;
-
-             default: /* Unknown option ! */
-               fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n", rts_argv[arg]);
-               error = 1;
-               break;
-           }
-         }
-       else {
-           fflush(stdout);
-           fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
-                   rts_argv[arg]);
-           error = 1;
-       }
-    }
-    if (error == 1) {
-       char  **p;
-        fflush(stdout);
-       for (p = flagtext; *p; p++)
-           fprintf(stderr, "%s\n", *p);
-       EXIT(EXIT_FAILURE);
-    }
-}
-\end{code}
-
 Sets up and returns a string indicating the date/time of the run.
 Successive calls simply return the same string again. Initially
 called by @main.lc@ to initialise the string at the start of the run.
 Only used for profiling.
 
 \begin{code}
 Sets up and returns a string indicating the date/time of the run.
 Successive calls simply return the same string again. Initially
 called by @main.lc@ to initialise the string at the start of the run.
 Only used for profiling.
 
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
 # include <time.h>
 
 char *
 # include <time.h>
 
 char *
@@ -1307,20 +393,23 @@ time_str(STG_NO_ARGS)
 ToDo: Will this work under threads?
 
 \begin{code}
 ToDo: Will this work under threads?
 
 \begin{code}
-StgStablePtr errorHandler = -1;
+StgStablePtr errorHandler = -1; /* NB: prone to magic-value-ery (WDP 95/12) */
 
 
-StgInt getErrorHandler()
+StgInt
+getErrorHandler(STG_NO_ARGS)
 {
   return (StgInt) errorHandler;
 }
 
 #ifndef PAR
 
 {
   return (StgInt) errorHandler;
 }
 
 #ifndef PAR
 
-void raiseError( handler )
-StgStablePtr handler;
+void
+raiseError( handler )
+  StgStablePtr handler;
 {
 {
-  if (handler == -1) {
+  if (handler == -1) { /* beautiful magic value... (WDP 95/12) */
     shutdownHaskell();
     shutdownHaskell();
+    EXIT(EXIT_FAILURE);
   } else {
     TopClosure = deRefStablePointer( handler );
     longjmp(restart_main,1);
   } else {
     TopClosure = deRefStablePointer( handler );
     longjmp(restart_main,1);
@@ -1331,7 +420,7 @@ StgStablePtr handler;
 \begin{code}
 StgInt
 catchError( newErrorHandler )
 \begin{code}
 StgInt
 catchError( newErrorHandler )
-StgStablePtr newErrorHandler;
+  StgStablePtr newErrorHandler;
 {
   StgStablePtr oldErrorHandler = errorHandler;
   errorHandler = newErrorHandler;
 {
   StgStablePtr oldErrorHandler = errorHandler;
   errorHandler = newErrorHandler;
index d923511..85d949b 100644 (file)
@@ -67,9 +67,7 @@ X2BYTES(double)
     
 #define BYTES2X(ctype,htype)                   \
 I_                                             \
     
 #define BYTES2X(ctype,htype)                   \
 I_                                             \
-CAT3(bytes2,ctype,__)(in, out)                 \
-  P_ in;                                       \
-  htype *out;                                  \
+CAT3(bytes2,ctype,__)(P_ in, htype *out)       \
 {                                              \
     union {                                    \
        ctype i;                                \
 {                                              \
     union {                                    \
        ctype i;                                \
@@ -88,9 +86,7 @@ CAT3(bytes2,ctype,__)(in, out)                        \
     
 static STG_INLINE
 void
     
 static STG_INLINE
 void
-assign_flt(p_dest, src)
-  W_ p_dest[];
-  StgFloat src;
+assign_flt(W_ p_dest[], StgFloat src)
 { 
     float_thing y;
     y.f = src;
 { 
     float_thing y;
     y.f = src;
@@ -100,9 +96,7 @@ assign_flt(p_dest, src)
 
 static STG_INLINE
 void
 
 static STG_INLINE
 void
-assign_dbl(p_dest, src)
-  W_ p_dest[];
-  StgDouble src;
+assign_dbl(W_ p_dest[], StgDouble src)
 {
     double_thing y;
     y.d = src;
 {
     double_thing y;
     y.d = src;
@@ -112,9 +106,7 @@ assign_dbl(p_dest, src)
 
 #define BYTES2FX(ctype,htype,assign_fx)                \
 I_                                             \
 
 #define BYTES2FX(ctype,htype,assign_fx)                \
 I_                                             \
-CAT3(bytes2,ctype,__)(in, out)                 \
-  P_ in;                                       \
-  htype *out;                                  \
+CAT3(bytes2,ctype,__)(P_ in, htype *out)       \
 {                                              \
     union {                                    \
        ctype i;                                \
 {                                              \
     union {                                    \
        ctype i;                                \
index cb76252..7683ed8 100644 (file)
@@ -54,12 +54,7 @@ See \tr{imports/StgMacros.h} for more about these things.
 
 STG_INLINE
 void
 
 STG_INLINE
 void
-#ifdef __STDC__
 ASSIGN_DBL(W_ p_dest[], StgDouble src)
 ASSIGN_DBL(W_ p_dest[], StgDouble src)
-#else
-ASSIGN_DBL(p_dest, src)
-  W_ p_dest[]; StgDouble src;
-#endif
 {
     double_thing y;
     y.d = src;
 {
     double_thing y;
     y.d = src;
@@ -69,12 +64,7 @@ ASSIGN_DBL(p_dest, src)
 
 STG_INLINE
 StgDouble
 
 STG_INLINE
 StgDouble
-#ifdef __STDC__
 PK_DBL(W_ p_src[])
 PK_DBL(W_ p_src[])
-#else
-PK_DBL(p_src)
-  W_ p_src[];
-#endif
 {
     double_thing y;
     y.du.dhi = p_src[0];
 {
     double_thing y;
     y.du.dhi = p_src[0];
@@ -84,12 +74,7 @@ PK_DBL(p_src)
 
 STG_INLINE
 void
 
 STG_INLINE
 void
-#ifdef __STDC__
 ASSIGN_FLT(W_ p_dest[], StgFloat src)
 ASSIGN_FLT(W_ p_dest[], StgFloat src)
-#else
-ASSIGN_FLT(p_dest, src)
-  W_ p_dest[]; StgFloat src;
-#endif
 { 
     float_thing y;
     y.f = src;
 { 
     float_thing y;
     y.f = src;
@@ -98,12 +83,7 @@ ASSIGN_FLT(p_dest, src)
 
 STG_INLINE
 StgFloat
 
 STG_INLINE
 StgFloat
-#ifdef __STDC__
 PK_FLT(W_ p_src[])
 PK_FLT(W_ p_src[])
-#else
-PK_FLT(p_src)
-  W_ p_src[];
-#endif
 {
     float_thing y;
     y.fu = *p_src;
 {
     float_thing y;
     y.fu = *p_src;
@@ -153,12 +133,7 @@ Encoding and decoding Doubles.  Code based on the HBC code
 
 \begin{code}
 StgDouble
 
 \begin{code}
 StgDouble
-#if __STDC__
 __encodeDouble (MP_INT *s, I_ e) /* result = s * 2^e */
 __encodeDouble (MP_INT *s, I_ e) /* result = s * 2^e */
-#else
-__encodeDouble (s, e)
-  MP_INT *s; I_ e;
-#endif /* ! __STDC__ */
 {
     StgDouble r;
     I_ i;
 {
     StgDouble r;
     I_ i;
@@ -182,7 +157,7 @@ __encodeDouble (s, e)
        r = -r;
 
 /*
        r = -r;
 
 /*
-    temp = xmalloc(mpz_sizeinbase(s,10)+2);
+    temp = stgMallocBytes(mpz_sizeinbase(s,10)+2);
     fprintf(stderr, "__encodeDouble(%s, %ld) => %g\n", mpz_get_str(temp,10,s), e, r);
 */
 
     fprintf(stderr, "__encodeDouble(%s, %ld) => %g\n", mpz_get_str(temp,10,s), e, r);
 */
 
@@ -192,12 +167,7 @@ __encodeDouble (s, e)
 #if ! alpha_TARGET_ARCH
     /* On the alpha, Stg{Floats,Doubles} are the same */
 StgFloat
 #if ! alpha_TARGET_ARCH
     /* On the alpha, Stg{Floats,Doubles} are the same */
 StgFloat
-#if __STDC__
 __encodeFloat (MP_INT *s, I_ e) /* result = s * 2^e */
 __encodeFloat (MP_INT *s, I_ e) /* result = s * 2^e */
-#else
-__encodeFloat (s, e)
-  MP_INT *s; I_ e;
-#endif /* ! __STDC__ */
 {
     StgFloat r;
     I_ i;
 {
     StgFloat r;
     I_ i;
@@ -219,14 +189,7 @@ __encodeFloat (s, e)
 #endif /* alpha */
 
 void
 #endif /* alpha */
 
 void
-#if __STDC__
 __decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl)
 __decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl)
-#else
-__decodeDouble (man, exp, dbl)
-  MP_INT    *man;
-  I_        *exp;
-  StgDouble dbl;
-#endif /* ! __STDC__ */
 {
 #if ! IEEE_FLOATING_POINT
     fprintf(stderr, "__decodeDouble: non-IEEE not yet supported\n");
 {
 #if ! IEEE_FLOATING_POINT
     fprintf(stderr, "__decodeDouble: non-IEEE not yet supported\n");
@@ -287,7 +250,7 @@ __decodeDouble (man, exp, dbl)
     }
 
 /*
     }
 
 /*
-    temp = xmalloc(mpz_sizeinbase(man,10)+2);
+    temp = stgMallocBytes(mpz_sizeinbase(man,10)+2);
     fprintf(stderr, "__decodeDouble(%g) => %s, %ld\n", dbl, mpz_get_str(temp,10,man), *exp);
 */
 
     fprintf(stderr, "__decodeDouble(%g) => %s, %ld\n", dbl, mpz_get_str(temp,10,man), *exp);
 */
 
@@ -297,14 +260,7 @@ __decodeDouble (man, exp, dbl)
 #if ! alpha_TARGET_ARCH
     /* Again, on the alpha we do not have separate "StgFloat" routines */
 void
 #if ! alpha_TARGET_ARCH
     /* Again, on the alpha we do not have separate "StgFloat" routines */
 void
-#if __STDC__
 __decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
 __decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
-#else
-__decodeFloat (man, exp, flt)
-  MP_INT    *man;
-  I_    *exp;
-  StgFloat flt;
-#endif /* ! __STDC__ */
 {
 #if ! IEEE_FLOATING_POINT
     fprintf(stderr, "__decodeFloat: non-IEEE not yet supported\n");
 {
 #if ! IEEE_FLOATING_POINT
     fprintf(stderr, "__decodeFloat: non-IEEE not yet supported\n");
@@ -414,22 +370,15 @@ stgAllocForGMP (size_in_bytes)
     */
     SAVE_Hp += total_size_in_words;
 
     */
     SAVE_Hp += total_size_in_words;
 
-#if ! defined(DO_SPAT_PROFILING)
-    /* Note: ActivityReg is not defined in this .lc file */
-
     ALLOC_HEAP(total_size_in_words); /* ticky-ticky profiling */
 /*  ALLOC_CON(DATA_HS,data_size_in_words,0); */
     ALLOC_PRIM(DATA_HS,data_size_in_words,0,total_size_in_words);
     ALLOC_HEAP(total_size_in_words); /* ticky-ticky profiling */
 /*  ALLOC_CON(DATA_HS,data_size_in_words,0); */
     ALLOC_PRIM(DATA_HS,data_size_in_words,0,total_size_in_words);
-#endif /* ! DO_SPAT_PROFILING */
+
     CC_ALLOC(CCC,total_size_in_words,CON_K); /* cc profiling */
     /* NB: HACK WARNING: The above line will do The WRONG THING 
        if the CurrCostCentre reg is ever put in a Real Machine Register (TM).
     */
 
     CC_ALLOC(CCC,total_size_in_words,CON_K); /* cc profiling */
     /* NB: HACK WARNING: The above line will do The WRONG THING 
        if the CurrCostCentre reg is ever put in a Real Machine Register (TM).
     */
 
-#if defined(LIFE_PROFILE)  /* HACK warning -- Bump HpLim (see also StgMacros.lh)*/
-    SAVE_HpLim += 1;      /* SET_DATA_HDR attempted HpLim++ in wrong window    */
-#endif
-
     /* and return what we said we would */
     return(stuff_ptr);
 }
     /* and return what we said we would */
     return(stuff_ptr);
 }
index c7fe06a..01a801d 100644 (file)
@@ -4,15 +4,15 @@
 #include "rtsdefs.h"
 \end{code}
 
 #include "rtsdefs.h"
 \end{code}
 
-Only have cost centres if @USE_COST_CENTRES@ defined (by the driver),
-or if running CONCURRENT.
+Only have cost centres if @PROFILING@ defined (by the driver),
+or if running PAR.
 
 \begin{code}
 
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(PAR)
 CC_DECLARE(CC_MAIN, "MAIN", "MAIN", "MAIN", CC_IS_BORING,/*not static*/);
 CC_DECLARE(CC_GC,   "GC",   "GC",   "GC",   CC_IS_BORING,/*not static*/);
 
 CC_DECLARE(CC_MAIN, "MAIN", "MAIN", "MAIN", CC_IS_BORING,/*not static*/);
 CC_DECLARE(CC_GC,   "GC",   "GC",   "GC",   CC_IS_BORING,/*not static*/);
 
-# ifdef GUM
+# ifdef PAR
 CC_DECLARE(CC_MSG,  "MSG",  "MSG",  "MSG",  CC_IS_BORING,/*not static*/);
 CC_DECLARE(CC_IDLE, "IDLE", "IDLE", "IDLE", CC_IS_BORING,/*not static*/);
 # endif
 CC_DECLARE(CC_MSG,  "MSG",  "MSG",  "MSG",  CC_IS_BORING,/*not static*/);
 CC_DECLARE(CC_IDLE, "IDLE", "IDLE", "IDLE", CC_IS_BORING,/*not static*/);
 # endif
@@ -25,23 +25,23 @@ would try to increment some @sub_scc_count@ of the @CCC@ (nothing!).
 \begin{code}
 CostCentre CCC; /* _not_ initialised */
 
 \begin{code}
 CostCentre CCC; /* _not_ initialised */
 
-#endif /* defined(USE_COST_CENTRES) || defined(CONCURRENT) */
+#endif /* defined(PROFILING) || defined(PAR) */
 \end{code}
 
 The rest is for real cost centres (not thread activities).
 
 \begin{code}
 \end{code}
 
 The rest is for real cost centres (not thread activities).
 
 \begin{code}
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
 \end{code}
 %************************************************************************
 %*                                                                     *
 \end{code}
 %************************************************************************
 %*                                                                     *
-\subsection[initial-cost-centres]{Initial Cost Centres}
+\subsection{Initial Cost Centres}
 %*                                                                     *
 %************************************************************************
 
 Cost centres which are always required:
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 Cost centres which are always required:
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 
 CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", "MAIN", CC_IS_CAF,/*not static*/);
 CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      "MAIN", CC_IS_SUBSUMED,/*not static*/);
 
 CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", "MAIN", CC_IS_CAF,/*not static*/);
 CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      "MAIN", CC_IS_SUBSUMED,/*not static*/);
@@ -54,18 +54,14 @@ The list of registered cost centres, initially empty:
 CostCentre Registered_CC = REGISTERED_END;
 \end{code}
 
 CostCentre Registered_CC = REGISTERED_END;
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 %************************************************************************
 %*                                                                     *
-\subsection[profiling-arguments]{Profiling RTS Arguments}
+\subsection{Profiling RTS Arguments}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-I_  cc_profiling = 0; /* 0  => not "cc_profiling"
-                        >1 => do serial time profile
-                        (other magic meanings, too, apparently) WDP 94/07
-                     */
-char cc_profiling_sort = SORTCC_TIME;
 I_  dump_intervals = 0;
 
 /* And for the report ... */
 I_  dump_intervals = 0;
 
 /* And for the report ... */
@@ -82,202 +78,47 @@ init_cc_profiling(rts_argc, rts_argv, prog_argv)
     I_ rts_argc;
     char *rts_argv[], *prog_argv[];
 {
     I_ rts_argc;
     char *rts_argv[], *prog_argv[];
 {
-    I_ arg, ch, error = 0;
-    I_ prof_req = 0;
+    I_ arg, ch;
+#ifndef PAR
     char *select_cc = 0;
     char *select_mod = 0;
     char *select_grp = 0;
     char *select_descr = 0;
     char *select_type = 0;
     char *select_kind = 0;
     char *select_cc = 0;
     char *select_mod = 0;
     char *select_grp = 0;
     char *select_descr = 0;
     char *select_type = 0;
     char *select_kind = 0;
-    I_  select_age = 0;
     char *left, *right;
     char *left, *right;
+#endif
 
     prog_argv_save = prog_argv;
     rts_argv_save = rts_argv;
 
 
     prog_argv_save = prog_argv;
     rts_argv_save = rts_argv;
 
-#ifdef GUM
+#ifdef PAR
     sprintf(prof_filename, PROF_FILENAME_FMT_GUM, prog_argv[0], thisPE);
 #else
     sprintf(prof_filename, PROF_FILENAME_FMT, prog_argv[0]);
 #endif
 
     sprintf(prof_filename, PROF_FILENAME_FMT_GUM, prog_argv[0], thisPE);
 #else
     sprintf(prof_filename, PROF_FILENAME_FMT, prog_argv[0]);
 #endif
 
-    for (arg = 0; arg < rts_argc; arg++) {
-       if (rts_argv[arg][0] == '-') {
-           switch (rts_argv[arg][1]) {
-             case 'P': /* detailed cost centre profiling (time/alloc) */
-               cc_profiling++;
-             case 'p': /* cost centre profiling (time/alloc) */
-               cc_profiling++;
-               for (ch = 2; rts_argv[arg][ch]; ch++) {
-               switch (rts_argv[arg][2]) {
-                 case SORTCC_LABEL:
-                 case SORTCC_TIME:
-                 case SORTCC_ALLOC:
-                       cc_profiling_sort = rts_argv[arg][ch];
-                   break;
-                 default:
-                   fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]);
-                   error = 1;
-               }}
-               break;
-
-#if defined(USE_COST_CENTRES)
-             case 'h': /* serial heap profile */
-               switch (rts_argv[arg][2]) {
-                 case '\0':
-                 case CCchar:
-                   prof_req = HEAP_BY_CC;
-                   break;
-                 case MODchar:
-                   prof_req = HEAP_BY_MOD;
-                   break;
-                 case GRPchar:
-                   prof_req = HEAP_BY_GRP;
-                   break;
-                 case DESCRchar:
-                   prof_req = HEAP_BY_DESCR;
-                   break;
-                 case TYPEchar:
-                   prof_req = HEAP_BY_TYPE;
-                   break;
-                 case TIMEchar:
-                   prof_req = HEAP_BY_TIME;
-                   if (rts_argv[arg][3]) {
-                       char *start_str = strchr(rts_argv[arg]+3, ',');
-                       I_ intervals;
-                       if (start_str) *start_str = '\0';
-
-                       if ((intervals = decode(rts_argv[arg]+3)) != 0) {
-                           time_intervals = (hash_t) intervals;
-                           /* ToDo: and what if it *is* zero intervals??? */
-                       }
-                       if (start_str) {
-                           earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY));
-                       }
-                   }
-                   break;
-                 default:
-                   fprintf(stderr, "Invalid heap profile option: %s\n",
-                           rts_argv[arg]);
-                   error = 1;
-               }
-               break;
-
-             case 'z': /* size of index tables */
-               switch (rts_argv[arg][2]) {
-                 case CCchar:
-                   max_cc_no = (hash_t) decode(rts_argv[arg]+3);
-                   if (max_cc_no == 0) {
-                       fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
-                       error = 1;
-                   }
-                   break;
-                 case MODchar:
-                   max_mod_no = (hash_t) decode(rts_argv[arg]+3);
-                   if (max_mod_no == 0) {
-                       fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
-                       error = 1;
-                   }
-                   break;
-                 case GRPchar:
-                   max_grp_no = (hash_t) decode(rts_argv[arg]+3);
-                   if (max_grp_no == 0) {
-                       fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
-                       error = 1;
-                   }
-                   break;
-                 case DESCRchar:
-                   max_descr_no = (hash_t) decode(rts_argv[arg]+3);
-                   if (max_descr_no == 0) {
-                       fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
-                       error = 1;
-                   }
-                   break;
-                 case TYPEchar:
-                   max_type_no = (hash_t) decode(rts_argv[arg]+3);
-                   if (max_type_no == 0) {
-                       fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
-                       error = 1;
-                   }
-                   break;
-                 default:
-                   fprintf(stderr, "Invalid index table size option: %s\n",
-                           rts_argv[arg]);
-                   error = 1;
-               }
-               break;
-
-             case 'c': /* cost centre label select */
-             case 'm': /* cost centre module select */
-             case 'g': /* cost centre group select */
-             case 'd': /* closure descr select */
-             case 'y': /* closure type select */
-             case 'k': /* closure kind select */
-               left  = strchr(rts_argv[arg], '{');
-               right = strrchr(rts_argv[arg], '}');
-               if (! left || ! right ||
-                       strrchr(rts_argv[arg], '{') != left ||
-                        strchr(rts_argv[arg], '}') != right) {
-                   fprintf(stderr, "Invalid heap profiling selection bracketing\n   %s\n", rts_argv[arg]);
-                   error = 1;
-               } else {
-                   *right = '\0';
-                   switch (rts_argv[arg][1]) {
-                     case 'c': /* cost centre label select */
-                       select_cc = left + 1;
-               break;
-                     case 'm': /* cost centre module select */
-                       select_mod = left + 1;
-                       break;
-                     case 'g': /* cost centre group select */
-                       select_grp = left + 1;
-                       break;
-                     case 'd': /* closure descr select */
-                       select_descr = left + 1;
-                       break;
-                     case 't': /* closure type select */
-                       select_type = left + 1;
-                       break;
-                     case 'k': /* closure kind select */
-                       select_kind = left + 1;
-                       break;
-               }
-               }
-               break;
-
-             case 'a': /* closure age select */
-               select_age = decode(rts_argv[arg]+2);
-
-#endif /* defined(USE_COST_CENTRES) */
-
-             case 'i': /* serial profiling -- initial timer interval */
-               interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY));
-               if (interval_ticks <= 0)
-                   interval_ticks = 1;
-               break;
-           }
-       }
-    }
-    if (error) return 1;
-
     /* Now perform any work to initialise profiling ... */
 
     /* Now perform any work to initialise profiling ... */
 
-    if (cc_profiling || prof_req != HEAP_NO_PROFILING) {
+    if (RTSflags.CcFlags.doCostCentres
+#ifdef PROFILING
+     || RTSflags.ProfFlags.doHeapProfile
+#endif
+       ) {
 
        time_profiling++;
 
         /* set dump_intervals: if heap profiling only dump every 10 intervals */
 
        time_profiling++;
 
         /* set dump_intervals: if heap profiling only dump every 10 intervals */
-       if (prof_req == HEAP_NO_PROFILING) {
-           dump_intervals = 1;
-       } else {
-           dump_intervals = 10;
-       }
+#ifdef PROFILING
+       dump_intervals = (RTSflags.ProfFlags.doHeapProfile) ? 10 : 1;
+#else
+       dump_intervals = 1;
+#endif
 
 
-       if (cc_profiling > 1) {
+       if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
            /* produce serial time profile */
     
            /* produce serial time profile */
     
-#ifdef GUM
+#ifdef PAR
            sprintf(serial_filename, TIME_FILENAME_FMT_GUM, prog_argv[0], thisPE);
 #else
            sprintf(serial_filename, TIME_FILENAME_FMT, prog_argv[0]);
            sprintf(serial_filename, TIME_FILENAME_FMT_GUM, prog_argv[0], thisPE);
 #else
            sprintf(serial_filename, TIME_FILENAME_FMT, prog_argv[0]);
@@ -296,7 +137,11 @@ init_cc_profiling(rts_argc, rts_argv, prog_argv)
            fprintf(serial_file, "DATE \"%s\"\n", time_str());
     
            fprintf(serial_file, "SAMPLE_UNIT \"seconds\"\n");
            fprintf(serial_file, "DATE \"%s\"\n", time_str());
     
            fprintf(serial_file, "SAMPLE_UNIT \"seconds\"\n");
+#ifdef PAR
+           fprintf(serial_file, "VALUE_UNIT \"percentage time\"\n");
+#else
            fprintf(serial_file, "VALUE_UNIT \"time ticks\"\n");
            fprintf(serial_file, "VALUE_UNIT \"time ticks\"\n");
+#endif
     
            /* output initial 0 sample */
            fprintf(serial_file, "BEGIN_SAMPLE 0.00\n");
     
            /* output initial 0 sample */
            fprintf(serial_file, "BEGIN_SAMPLE 0.00\n");
@@ -304,10 +149,10 @@ init_cc_profiling(rts_argc, rts_argv, prog_argv)
        }
     }
 
        }
     }
 
-#if defined(USE_COST_CENTRES)
-    if (heap_profile_init(prof_req, select_cc, select_mod, select_grp,
-                                   select_descr, select_type, select_kind,
-                                   select_age, prog_argv))
+#if defined(PROFILING)
+    if (heap_profile_init(select_cc, select_mod, select_grp,
+                         select_descr, select_type, select_kind,
+                         prog_argv))
        return 1;
 #endif
     
        return 1;
 #endif
     
@@ -321,7 +166,6 @@ the area to hold the stack of modules still to register.
 \begin{code}
 extern P_ heap_space;    /* pointer to the heap space */
 StgFunPtr * register_stack;  /* stack of register routines -- heap area used */
 \begin{code}
 extern P_ heap_space;    /* pointer to the heap space */
 StgFunPtr * register_stack;  /* stack of register routines -- heap area used */
-extern I_ heap_profiling_req;
 
 EXTFUN(startCcRegisteringWorld);
 
 
 EXTFUN(startCcRegisteringWorld);
 
@@ -331,12 +175,12 @@ cc_register()
     REGISTER_CC(CC_MAIN);      /* register cost centre CC_MAIN */
     REGISTER_CC(CC_GC);                /* register cost centre CC_GC */
 
     REGISTER_CC(CC_MAIN);      /* register cost centre CC_MAIN */
     REGISTER_CC(CC_GC);                /* register cost centre CC_GC */
 
-#if defined(GUM)
+#if defined(PAR)
     REGISTER_CC(CC_MSG);       /* register cost centre CC_MSG */
     REGISTER_CC(CC_IDLE);      /* register cost centre CC_MSG */
 #endif
 
     REGISTER_CC(CC_MSG);       /* register cost centre CC_MSG */
     REGISTER_CC(CC_IDLE);      /* register cost centre CC_MSG */
 #endif
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     REGISTER_CC(CC_OVERHEAD);  /* register cost centre CC_OVERHEAD */
     REGISTER_CC(CC_DONTZuCARE);        /* register cost centre CC_DONT_CARE Right??? ToDo */
 #endif
     REGISTER_CC(CC_OVERHEAD);  /* register cost centre CC_OVERHEAD */
     REGISTER_CC(CC_DONTZuCARE);        /* register cost centre CC_DONT_CARE Right??? ToDo */
 #endif
@@ -345,9 +189,9 @@ cc_register()
     CCC = (CostCentre)STATIC_CC_REF(CC_MAIN);
     CCC->scc_count++;
 
     CCC = (CostCentre)STATIC_CC_REF(CC_MAIN);
     CCC->scc_count++;
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
 /*  always register -- if we do not, we get warnings (WDP 94/12) */
 /*  always register -- if we do not, we get warnings (WDP 94/12) */
-/*  if (cc_profiling || heap_profiling_req != HEAP_NO_PROFILING) */
+/*  if (RTSflags.CcFlags.doCostCentres || RTSflags.ProfFlags.doHeapProfile) */
 
     register_stack = (StgFunPtr *) heap_space;
     miniInterpret((StgFunPtr) startCcRegisteringWorld);
 
     register_stack = (StgFunPtr *) heap_space;
     miniInterpret((StgFunPtr) startCcRegisteringWorld);
@@ -357,25 +201,48 @@ cc_register()
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsection[cost-centre-profiling]{Cost Centre Profiling Report}
+\subsection{Cost Centre Profiling Report}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-
 static I_ dump_interval = 0;
 
 static I_ dump_interval = 0;
 
+rtsBool
+cc_to_ignore (CostCentre cc)
+  /* return rtsTrue if it is one of the ones that
+     should not be reported normally (because it confuses
+     the users)
+  */
+{
+#   if !defined(PROFILING)
+    /* in parallel land, everything is interesting (not ignorable) */
+    return rtsFalse;
+
+#   else
+    if ( cc == CC_OVERHEAD || cc == CC_DONTZuCARE ||  cc == CC_GC ) {
+       return rtsTrue;
+    } else {
+       return rtsFalse;
+    }
+#   endif /* PROFILING */
+}
+
 void
 report_cc_profiling(final)
 void
 report_cc_profiling(final)
-I_ final;
+  I_ final;
 {
     FILE *prof_file;
     CostCentre cc;
     I_ count;
 {
     FILE *prof_file;
     CostCentre cc;
     I_ count;
-    char temp[32];
-    W_ total_ticks = 0, total_alloc = 0, total_allocs = 0;
+    char temp[128]; /* sigh: magic constant */
+    W_ total_ticks   = 0, total_alloc   = 0, total_allocs   = 0;
+    W_ ignored_ticks = 0, ignored_alloc = 0, ignored_allocs = 0;
+#ifdef PAR
+    I_ final_ticks = 0;                                /*No. ticks in last sample*/
+#endif
 
 
-    if (!cc_profiling)
+    if (!RTSflags.CcFlags.doCostCentres)
        return;
 
     blockVtAlrmSignal();
        return;
 
     blockVtAlrmSignal();
@@ -384,24 +251,41 @@ I_ final;
        StgFloat seconds = (previous_ticks + current_ticks) / (StgFloat) TICK_FREQUENCY;
 
        if (final) {
        StgFloat seconds = (previous_ticks + current_ticks) / (StgFloat) TICK_FREQUENCY;
 
        if (final) {
-           /* ignore partial sample at end of execution */
+           fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds);
+#ifdef PAR
+           /*In the parallel world we're particularly interested in the last sample*/
+           for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
+               if (! cc_to_ignore(cc))
+                   final_ticks += cc->time_ticks;
+           }
 
 
-           /* output final 0 sample */
-           fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds);
+           for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
+               if (cc->time_ticks != 0 && ! cc_to_ignore(cc))
+                   fprintf(serial_file, "  %0.11s:%0.16s %3ld\n",
+                       cc->module, cc->label, cc->time_ticks*100 / final_ticks);
+           }
+#endif
+           /* In the sequential world, ignore partial sample at end of execution */
            fprintf(serial_file, "END_SAMPLE %0.2f\n", seconds);
            fclose(serial_file);
            serial_file = NULL;
 
        } else {
            fprintf(serial_file, "END_SAMPLE %0.2f\n", seconds);
            fclose(serial_file);
            serial_file = NULL;
 
        } else {
-           /* output serail profile sample */
+           /* output serial profile sample */
 
            fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 
            for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
                ASSERT_IS_REGISTERED(cc, 0);
 
            fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 
            for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
                ASSERT_IS_REGISTERED(cc, 0);
-               if (cc->time_ticks) {
+               if (cc->time_ticks != 0 && !cc_to_ignore(cc)) {
+#ifdef PAR                                          
+                 /* Print _percentages_ in the parallel world */
+                   fprintf(serial_file, "  %0.11s:%0.16s %3ld\n",
+                     cc->module, cc->label, cc->time_ticks * 100/TICK_FREQUENCY);
+#else
                    fprintf(serial_file, "  %0.11s:%0.16s %3ld\n",
                      cc->module, cc->label, cc->time_ticks);
                    fprintf(serial_file, "  %0.11s:%0.16s %3ld\n",
                      cc->module, cc->label, cc->time_ticks);
+#endif
                }
            }
 
                }
            }
 
@@ -415,13 +299,19 @@ I_ final;
        cc->prev_ticks += cc->time_ticks;
        cc->time_ticks = 0;
 
        cc->prev_ticks += cc->time_ticks;
        cc->time_ticks = 0;
 
-       total_ticks  += cc->prev_ticks;
-       total_alloc  += cc->mem_alloc;
-       total_allocs += cc->mem_allocs;
+       if ( cc_to_ignore(cc) ) { /* reporting these just confuses users... */
+           ignored_ticks  += cc->prev_ticks;
+           ignored_alloc  += cc->mem_alloc;
+           ignored_allocs += cc->mem_allocs;
+       } else {
+           total_ticks  += cc->prev_ticks;
+           total_alloc  += cc->mem_alloc;
+           total_allocs += cc->mem_allocs;
+       }
     }
 
     }
 
-    if (total_ticks != current_ticks + previous_ticks)
-       fprintf(stderr, "Warning: Cost Centre tick inconsistency: total=%ld, current=%ld, previous=%ld\n", total_ticks, current_ticks, previous_ticks);
+    if (total_ticks + ignored_ticks != current_ticks + previous_ticks)
+       fprintf(stderr, "Warning: Cost Centre tick inconsistency: total=%ld, ignored=%ld, current=%ld, previous=%ld\n", total_ticks, ignored_ticks, current_ticks, previous_ticks);
 
     unblockVtAlrmSignal();
 
 
     unblockVtAlrmSignal();
 
@@ -433,7 +323,7 @@ I_ final;
     dump_interval = 0;
 
     /* sort cost centres */
     dump_interval = 0;
 
     /* sort cost centres */
-    cc_sort(&Registered_CC, cc_profiling_sort);
+    cc_sort(&Registered_CC, RTSflags.CcFlags.sortBy);
 
     /* open profiling output file */
     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 
     /* open profiling output file */
     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
@@ -466,7 +356,7 @@ I_ final;
 */
     fprintf(prof_file, " %5s %5s %6s %6s", "scc", "subcc", "%time", "%alloc");
 
 */
     fprintf(prof_file, " %5s %5s %6s %6s", "scc", "subcc", "%time", "%alloc");
 
-    if (cc_profiling > 1)
+    if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE)
        fprintf(prof_file, " %11s  %13s %8s %8s %8s (%5s %8s)", "cafcc", "thunks", "funcs", "PAPs", "closures", "ticks", "bytes");
     fprintf(prof_file, "\n\n");
 
        fprintf(prof_file, " %11s  %13s %8s %8s %8s (%5s %8s)", "cafcc", "thunks", "funcs", "PAPs", "closures", "ticks", "bytes");
     fprintf(prof_file, "\n\n");
 
@@ -475,13 +365,15 @@ I_ final;
 
        /* Only print cost centres with non 0 data ! */
 
 
        /* Only print cost centres with non 0 data ! */
 
-       if (cc->scc_count || cc->sub_scc_count || cc->prev_ticks || cc->mem_alloc
-           || (cc_profiling > 1
-               && (cc->thunk_count || cc->function_count || cc->pap_count
-                || cc->cafcc_count || cc->sub_cafcc_count))
-           || (cc_profiling > 2
-               /* print all cost centres if -P -P */ )
-           ) {
+       if ( (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_ALL
+               /* force printing of *all* cost centres if -P -P */ )
+
+         || ( ! cc_to_ignore(cc)
+           && (cc->scc_count || cc->sub_scc_count || cc->prev_ticks || cc->mem_alloc
+               || (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
+                   && (cc->thunk_count || cc->function_count || cc->pap_count
+                    || cc->cafcc_count || cc->sub_cafcc_count))))
+          ) {
 
            fprintf(prof_file, "%-16.16s %-11.11s", cc->label, cc->module);
 /* ToDo:group
 
            fprintf(prof_file, "%-16.16s %-11.11s", cc->label, cc->module);
 /* ToDo:group
@@ -492,7 +384,7 @@ I_ final;
              total_ticks == 0 ? 0.0 : (cc->prev_ticks / (StgFloat) total_ticks * 100),
              total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat) total_alloc * 100));
 
              total_ticks == 0 ? 0.0 : (cc->prev_ticks / (StgFloat) total_ticks * 100),
              total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat) total_alloc * 100));
 
-           if (cc_profiling > 1)
+           if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE)
                fprintf(prof_file, " %8ld %-8ld %8ld %8ld %8ld %8ld (%5ld %8ld)",
                        cc->cafcc_count, cc->sub_cafcc_count,
                        cc->thunk_count, cc->function_count, cc->pap_count,
                fprintf(prof_file, " %8ld %-8ld %8ld %8ld %8ld %8ld (%5ld %8ld)",
                        cc->cafcc_count, cc->sub_cafcc_count,
                        cc->thunk_count, cc->function_count, cc->pap_count,
@@ -509,7 +401,7 @@ I_ final;
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-\subsection[profiling-misc]{Miscellanious Profiling Routines}
+\subsection{Miscellaneous profiling routines}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
@@ -519,8 +411,7 @@ insertion sort. First we need the different comparison routines.
 \begin{code}
 
 static I_
 \begin{code}
 
 static I_
-cc_lt_label(cc1, cc2)
-    CostCentre cc1, cc2;
+cc_lt_label(CostCentre cc1, CostCentre cc2)
 {
     I_ cmp;
 
 {
     I_ cmp;
 
@@ -542,8 +433,7 @@ cc_lt_label(cc1, cc2)
 }
 
 static I_
 }
 
 static I_
-cc_gt_time(cc1, cc2)
-    CostCentre cc1, cc2;
+cc_gt_time(CostCentre cc1, CostCentre cc2)
 {
     /* ToDo: normal then caf then dict (instead of scc at top) */
 
 {
     /* ToDo: normal then caf then dict (instead of scc at top) */
 
@@ -571,8 +461,7 @@ cc_gt_time(cc1, cc2)
 }
 
 static I_
 }
 
 static I_
-cc_gt_alloc(cc1, cc2)
-    CostCentre cc1, cc2;
+cc_gt_alloc(CostCentre cc1, CostCentre cc2)
 {
     /* ToDo: normal then caf then dict (instead of scc at top) */
 
 {
     /* ToDo: normal then caf then dict (instead of scc at top) */
 
@@ -599,15 +488,8 @@ cc_gt_alloc(cc1, cc2)
     return (cc_lt_label(cc1, cc2));                 /* all data equal: cmp labels */
 }
 
     return (cc_lt_label(cc1, cc2));                 /* all data equal: cmp labels */
 }
 
-#ifdef __STDC__
 void
 cc_sort(CostCentre *sort, char sort_on)
 void
 cc_sort(CostCentre *sort, char sort_on)
-#else
-void
-cc_sort(sort, sort_on)
-    CostCentre *sort;
-    char sort_on;
-#endif
 {
     I_ (*cc_lt)();
     CostCentre sorted, insert, *search, insert_rest;
 {
     I_ (*cc_lt)();
     CostCentre sorted, insert, *search, insert_rest;
@@ -649,5 +531,5 @@ cc_sort(sort, sort_on)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-#endif /* USE_COST_CENTRES || GUM */
+#endif /* PROFILING || PAR */
 \end{code}
 \end{code}
index 67c81cb..514e815 100644 (file)
@@ -1,4 +1,4 @@
-Only have cost centres etc if @USE_COST_CENTRES@ defined
+Only have cost centres etc if @PROFILING@ defined
 
 \begin{code}
 /* 
 
 \begin{code}
 /* 
@@ -13,9 +13,9 @@ Only have cost centres etc if @USE_COST_CENTRES@ defined
  */
 
 #define NULL_REG_MAP
  */
 
 #define NULL_REG_MAP
-#include "../storage/SMinternal.h"  /* for xmalloc */
+#include "../storage/SMinternal.h" /* for ???? */
 
 
-#if defined (USE_COST_CENTRES)
+#if defined (PROFILING)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -50,13 +50,9 @@ etc words are disregarded. The profiling itself is considered an
 idealised process which should not affect the statistics gathered.
 
 \begin{code}
 idealised process which should not affect the statistics gathered.
 
 \begin{code}
-
 #define MAX_SELECT 10
 
 #define MAX_SELECT 10
 
-I_ heap_profiling_req
-    = HEAP_NO_PROFILING; /* type of heap profiling */
-
-static char heap_profiling_char[]           /* indexed by heap_profiling_req */
+static char heap_profiling_char[] /* indexed by RTSflags.ProfFlags.doHeapProfile */
     = {'?', CCchar, MODchar, GRPchar, DESCRchar, TYPEchar, TIMEchar};
 
 static I_  cc_select = 0;                  /* are we selecting on Cost Centre */
     = {'?', CCchar, MODchar, GRPchar, DESCRchar, TYPEchar, TIMEchar};
 
 static I_  cc_select = 0;                  /* are we selecting on Cost Centre */
@@ -79,10 +75,7 @@ static I_   kind_select_no = 0;
 static I_   kind_selected[]    = {0, 0, 0, 0, 0, 0};
 static char *kind_select_strs[] = {"","CON","FN","PAP","THK","BH",0};
 
 static I_   kind_selected[]    = {0, 0, 0, 0, 0, 0};
 static char *kind_select_strs[] = {"","CON","FN","PAP","THK","BH",0};
 
-static I_   age_select = 0;       /* select ages greater than this */
-                                  /* 0 indicates survived to the end of alloced interval */
-
-I_ *resid = 0;                    /* residencies indexed by hashed feature */
+I_ *resid = 0; /* residencies indexed by hashed feature */
 
 /* For production times we have a resid table of time_intervals */
 /* And a seperate resid counter stuff produced earlier & later  */
 
 /* For production times we have a resid table of time_intervals */
 /* And a seperate resid counter stuff produced earlier & later  */
@@ -96,7 +89,8 @@ hash_t time_intervals = 18;   /* No of time_intervals, also earlier & later */
 
 static hash_t earlier_intervals;     /* No of earlier intervals grouped together + 1*/
 
 
 static hash_t earlier_intervals;     /* No of earlier intervals grouped together + 1*/
 
-hash_t dummy_index_time()
+hash_t
+dummy_index_time(STG_NO_ARGS)
 {
     return time_intervals;
 }
 {
     return time_intervals;
 }
@@ -114,27 +108,22 @@ hash_t (* init_index_fns[])() = {
 static char heap_filename[STATS_FILENAME_MAXLEN]; /* heap log file name = <program>.hp */
 static FILE *heap_file = NULL;
 
 static char heap_filename[STATS_FILENAME_MAXLEN]; /* heap log file name = <program>.hp */
 static FILE *heap_file = NULL;
 
-extern I_ SM_force_gc; /* Set here if we force 2-space GC */
-
 I_
 I_
-heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str,
+heap_profile_init(cc_select_str, mod_select_str, grp_select_str,
                  descr_select_str, type_select_str, kind_select_str,
                  descr_select_str, type_select_str, kind_select_str,
-                 select_age, argv) 
-    I_ prof;
+                 argv) 
     char *cc_select_str;
     char *mod_select_str;
     char *grp_select_str;
     char *descr_select_str;
     char *type_select_str;
     char *kind_select_str;
     char *cc_select_str;
     char *mod_select_str;
     char *grp_select_str;
     char *descr_select_str;
     char *type_select_str;
     char *kind_select_str;
-    I_  select_age;
     char *argv[];
 {
     hash_t count, max, first;
     char *argv[];
 {
     hash_t count, max, first;
+    W_ heap_prof_style;
 
 
-    heap_profiling_req = prof;
-
-    if (heap_profiling_req == HEAP_NO_PROFILING)
+    if (! RTSflags.ProfFlags.doHeapProfile)
        return 0;
 
     /* for now, if using a generational collector and trying
        return 0;
 
     /* for now, if using a generational collector and trying
@@ -142,15 +131,10 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str,
        WDP 94/07
     */
 #if defined(GCap) || defined(GCgn)
        WDP 94/07
     */
 #if defined(GCap) || defined(GCgn)
-    SM_force_gc = USE_2s;
+    RTSflags.GcFlags.force2s = rtsTrue;
 #endif
 
 #endif
 
-#if ! defined(HEAP_PROF_WITH_AGE)
-    if (heap_profiling_req == HEAP_BY_TIME || select_age) {
-       fprintf(stderr, "heap_profile_init: Heap Profiling not built with AGE field in closures\n");
-       return 1;
-    }
-#endif /* ! HEAP_PROF_WITH_AGE */
+    heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 
     /* process select strings -- will break them into bits */
     
 
     /* process select strings -- will break them into bits */
     
@@ -276,8 +260,6 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str,
        }
        clcat_select |= kind_select_no > 0;
     }
        }
        clcat_select |= kind_select_no > 0;
     }
-    age_select = select_age;
-
     
     /* open heap profiling log file */
     
     
     /* open heap profiling log file */
     
@@ -290,8 +272,8 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str,
     /* write start of log file */
     
     fprintf(heap_file, "JOB \"%s", argv[0]);
     /* write start of log file */
     
     fprintf(heap_file, "JOB \"%s", argv[0]);
-    fprintf(heap_file, " +RTS -h%c", heap_profiling_char[heap_profiling_req]);
-    if (heap_profiling_req == HEAP_BY_TIME) {
+    fprintf(heap_file, " +RTS -h%c", heap_profiling_char[heap_prof_style]);
+    if (heap_prof_style == HEAP_BY_TIME) {
        fprintf(heap_file, "%ld", time_intervals);
        if (earlier_ticks) {
            fprintf(heap_file, ",%3.1f",
        fprintf(heap_file, "%ld", time_intervals);
        if (earlier_ticks) {
            fprintf(heap_file, ",%3.1f",
@@ -342,9 +324,7 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str,
            }
        fprintf(heap_file, "}");
     }
            }
        fprintf(heap_file, "}");
     }
-    if (select_age) {
-       fprintf(heap_file, " -a%ld", age_select);
-    }
+
     fprintf(heap_file, " -i%4.2f -RTS", interval_ticks/(StgFloat)TICK_FREQUENCY);
     for(count = 1; argv[count]; count++)
        fprintf(heap_file, " %s", argv[count]);
     fprintf(heap_file, " -i%4.2f -RTS", interval_ticks/(StgFloat)TICK_FREQUENCY);
     for(count = 1; argv[count]; count++)
        fprintf(heap_file, " %s", argv[count]);
@@ -362,9 +342,11 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str,
     /* initialise required heap profiling data structures & hashing */
     
     earlier_intervals = (earlier_ticks / interval_ticks) + 1;
     /* initialise required heap profiling data structures & hashing */
     
     earlier_intervals = (earlier_ticks / interval_ticks) + 1;
-    max = (* init_index_fns[heap_profiling_req])();
-    resid = (I_ *) xmalloc(max * sizeof(I_));
-    for (count = 0; count < max; count++) resid[count] = 0;
+    max = (* init_index_fns[heap_prof_style])();
+    resid = (I_ *) stgMallocBytes(max * sizeof(I_), "heap_profile_init");
+
+    for (count = 0; count < max; count++)
+       resid[count] = 0;
     
     return 0;
 }
     
     return 0;
 }
@@ -385,7 +367,7 @@ Age selection is done for every closure -- not memoised.
 
 \begin{code}
 void
 
 \begin{code}
 void
-set_selected_ccs()            /* set selection before we profile heap */
+set_selected_ccs(STG_NO_ARGS)  /* set selection before we profile heap */
 {
     I_ x;
     CostCentre cc;
 {
     I_ x;
     CostCentre cc;
@@ -408,8 +390,7 @@ set_selected_ccs()            /* set selection before we profile heap */
 
 
 I_
 
 
 I_
-selected_clcat(clcat)
-    ClCategory clcat;
+selected_clcat(ClCategory clcat)
 {
     I_ x;
 
 {
     I_ x;
 
@@ -438,20 +419,16 @@ resident space counter by the size of the closure (less any profiling
 words).
 
 \begin{code}
 words).
 
 \begin{code}
-#define NON_PROF_HS (FIXED_HS - PROF_FIXED_HDR - AGE_FIXED_HDR)
+#define NON_PROF_HS (FIXED_HS - PROF_FIXED_HDR - TICKY_FIXED_HDR)
 
 void
 
 void
-profile_closure_none(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_none(P_ closure, I_ size)
 {
     return;
 }
 
 void
 {
     return;
 }
 
 void
-profile_closure_cc(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_cc(P_ closure, I_ size)
 {
     CostCentre cc = (CostCentre) CC_HDR(closure);
     resid[index_cc(cc)] += size + NON_PROF_HS;
 {
     CostCentre cc = (CostCentre) CC_HDR(closure);
     resid[index_cc(cc)] += size + NON_PROF_HS;
@@ -459,9 +436,7 @@ profile_closure_cc(closure,size)
 }
 
 void
 }
 
 void
-profile_closure_cc_select(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_cc_select(P_ closure, I_ size)
 {
     CostCentre cc; ClCategory clcat;
 
 {
     CostCentre cc; ClCategory clcat;
 
@@ -470,32 +445,15 @@ profile_closure_cc_select(closure,size)
        return;                           /* all selected if ! cc_select         */
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
        return;                           /* all selected if ! cc_select         */
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
-    if (clcat_select && ! selected_clcat(clcat))    /* selection memoised during profile */
+    if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
        return;
 
        return;
 
-#if defined(HEAP_PROF_WITH_AGE)
-    if (age_select) {
-       I_ age, ts = AGE_HDR(closure);
-
-       if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-           AGE_HDR(closure) = (W_)current_interval;
-           age = - age_select;
-       }
-       else {
-           age = current_interval - ts - age_select;
-       }
-       if (age < 0) return;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     resid[index_cc(cc)] += size + NON_PROF_HS;
     return;
 }
 
 void
     resid[index_cc(cc)] += size + NON_PROF_HS;
     return;
 }
 
 void
-profile_closure_mod(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_mod(P_ closure, I_ size)
 {
     CostCentre cc = (CostCentre) CC_HDR(closure);
     resid[index_mod(cc)] += size + NON_PROF_HS;
 {
     CostCentre cc = (CostCentre) CC_HDR(closure);
     resid[index_mod(cc)] += size + NON_PROF_HS;
@@ -503,9 +461,7 @@ profile_closure_mod(closure,size)
 }
 
 void
 }
 
 void
-profile_closure_mod_select(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_mod_select(P_ closure, I_ size)
 {
     CostCentre cc; ClCategory clcat;
 
 {
     CostCentre cc; ClCategory clcat;
 
@@ -514,41 +470,23 @@ profile_closure_mod_select(closure,size)
        return;
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
        return;
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
-    if (clcat_select && ! selected_clcat(clcat))    /* selection memoised during profile */
+    if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
        return;
 
        return;
 
-#if defined(HEAP_PROF_WITH_AGE)
-    if (age_select) {
-       I_ age, ts = AGE_HDR(closure);
-
-       if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-           AGE_HDR(closure) = (W_)current_interval;
-           age = - age_select;
-       }
-       else {
-           age = current_interval - ts - age_select;
-       }
-       if (age < 0) return;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     resid[index_mod(cc)] += size + NON_PROF_HS;
     return;
 }
 
 void
     resid[index_mod(cc)] += size + NON_PROF_HS;
     return;
 }
 
 void
-profile_closure_grp(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_grp(P_ closure, I_ size)
 {
     CostCentre cc = (CostCentre) CC_HDR(closure);
     resid[index_grp(cc)] += size + NON_PROF_HS;
     return;
 }
 {
     CostCentre cc = (CostCentre) CC_HDR(closure);
     resid[index_grp(cc)] += size + NON_PROF_HS;
     return;
 }
+
 void
 void
-profile_closure_grp_select(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_grp_select(P_ closure, I_ size)
 {
     CostCentre cc; ClCategory clcat;
 
 {
     CostCentre cc; ClCategory clcat;
 
@@ -557,32 +495,15 @@ profile_closure_grp_select(closure,size)
        return;
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
        return;
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
-    if (clcat_select && ! selected_clcat(clcat))    /* selection memoised during profile */
+    if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
        return;
 
        return;
 
-#if defined(HEAP_PROF_WITH_AGE)
-    if (age_select) {
-       I_ age, ts = AGE_HDR(closure);
-
-       if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-           AGE_HDR(closure) = (W_)current_interval;
-           age = - age_select;
-       }
-       else {
-           age = current_interval - ts - age_select;
-       }
-       if (age < 0) return;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     resid[index_grp(cc)] += size + NON_PROF_HS;
     return;
 }
 
 void
     resid[index_grp(cc)] += size + NON_PROF_HS;
     return;
 }
 
 void
-profile_closure_descr(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_descr(P_ closure, I_ size)
 {
     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
     resid[index_descr(clcat)] += size + NON_PROF_HS;
 {
     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
     resid[index_descr(clcat)] += size + NON_PROF_HS;
@@ -590,9 +511,7 @@ profile_closure_descr(closure,size)
 }
 
 void
 }
 
 void
-profile_closure_descr_select(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_descr_select(P_ closure, I_ size)
 {
     CostCentre cc; ClCategory clcat;
 
 {
     CostCentre cc; ClCategory clcat;
 
@@ -601,32 +520,15 @@ profile_closure_descr_select(closure,size)
        return;                             /* all selected if ! cc_select         */
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
        return;                             /* all selected if ! cc_select         */
 
     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
-    if (clcat_select && ! selected_clcat(clcat))  /* selection memoised during profile */
+    if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
        return;
 
        return;
 
-#if defined(HEAP_PROF_WITH_AGE)
-    if (age_select) {
-       I_ age, ts = AGE_HDR(closure);
-
-       if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-           AGE_HDR(closure) = (W_)current_interval;
-           age = - age_select;
-       }
-       else {
-           age = current_interval - ts - age_select;
-       }
-       if (age < 0) return;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     resid[index_descr(clcat)] += size + NON_PROF_HS;
     return;
 }
 
 void
     resid[index_descr(clcat)] += size + NON_PROF_HS;
     return;
 }
 
 void
-profile_closure_type(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_type(P_ closure, I_ size)
 {
     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
     resid[index_type(clcat)] += size + NON_PROF_HS;
 {
     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
     resid[index_type(clcat)] += size + NON_PROF_HS;
@@ -634,9 +536,7 @@ profile_closure_type(closure,size)
 }
 
 void
 }
 
 void
-profile_closure_type_select(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_type_select(P_ closure, I_ size)
 {
     CostCentre cc; ClCategory clcat;
 
 {
     CostCentre cc; ClCategory clcat;
 
@@ -648,95 +548,19 @@ profile_closure_type_select(closure,size)
     if (clcat_select && ! selected_clcat(clcat))  /* selection memoised during profile */
        return;
 
     if (clcat_select && ! selected_clcat(clcat))  /* selection memoised during profile */
        return;
 
-#if defined(HEAP_PROF_WITH_AGE)
-    if (age_select) {
-       I_ age, ts = AGE_HDR(closure);
-
-       if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-           AGE_HDR(closure) = (W_)current_interval;
-           age = - age_select;
-       }
-       else {
-           age = current_interval - ts - age_select;
-       }
-       if (age < 0) return;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     resid[index_type(clcat)] += size + NON_PROF_HS;
     return;
 }
 
 void
     resid[index_type(clcat)] += size + NON_PROF_HS;
     return;
 }
 
 void
-profile_closure_time(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_time(P_ closure, I_ size)
 {
 {
-#if defined(HEAP_PROF_WITH_AGE)
-    I_ ts = AGE_HDR(closure);
-
-    if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-       AGE_HDR(closure) = (W_)current_interval;
-       ts = current_interval;
-    }
-
-    ts -= earlier_intervals;
-
-    if (ts < 0) {
-       resid_earlier +=  size + NON_PROF_HS;
-    }
-    else if (ts < time_intervals) {
-       resid[ts] +=  size + NON_PROF_HS;
-    }
-    else {
-       resid_later +=  size + NON_PROF_HS;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     return;
 }
 
 void
     return;
 }
 
 void
-profile_closure_time_select(closure,size)
-  P_ closure;
-  I_ size;
+profile_closure_time_select(P_ closure, I_ size)
 {
 {
-#if defined(HEAP_PROF_WITH_AGE)
-    CostCentre cc; ClCategory clcat; I_ age, ts;
-
-    cc = (CostCentre) CC_HDR(closure);
-    if (! cc->selected)                     /* selection determined before profile */
-       return;                             /* all selected if ! cc_select         */
-
-    clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
-    if (clcat_select && ! selected_clcat(clcat))  /* selection memoised during profile */
-       return;
-
-    ts = AGE_HDR(closure);
-    if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */
-       AGE_HDR(closure) = (W_)current_interval;
-       ts = current_interval;
-       age = - age_select;
-    }
-    else {
-       age = current_interval - ts - age_select;
-    }
-    if (age < 0)
-       return;
-
-    ts -= earlier_intervals;
-
-    if (ts < 0) {
-       resid_earlier +=  size + NON_PROF_HS;
-    }
-    else if (ts < time_intervals) {
-       resid[ts] +=  size + NON_PROF_HS;
-    }
-    else {
-       resid_later +=  size + NON_PROF_HS;
-    }
-#endif /* HEAP_PROF_WITH_AGE */
-
     return;
 }
 \end{code}
     return;
 }
 \end{code}
@@ -776,37 +600,45 @@ void (* profiling_fns[]) PROTO((P_,I_)) = {
 void
 heap_profile_setup(STG_NO_ARGS)      /* called at start of heap profile */
 {
 void
 heap_profile_setup(STG_NO_ARGS)      /* called at start of heap profile */
 {
-    if (heap_profiling_req == HEAP_NO_PROFILING)
+    W_ heap_prof_style;
+
+    if (! RTSflags.ProfFlags.doHeapProfile)
        return;
 
        return;
 
-    if (cc_select || clcat_select || age_select) {
+    heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
+
+    if (cc_select || clcat_select) {
        set_selected_ccs();               /* memoise cc selection */
        set_selected_ccs();               /* memoise cc selection */
-       heap_profile_fn = profiling_fns_select[heap_profiling_req];
+       heap_profile_fn = profiling_fns_select[heap_prof_style];
     } else {
     } else {
-       heap_profile_fn = profiling_fns[heap_profiling_req];
+       heap_profile_fn = profiling_fns[heap_prof_style];
     }
 }
 
 void
 heap_profile_done(STG_NO_ARGS)   /* called at end of heap profile */
 {
     }
 }
 
 void
 heap_profile_done(STG_NO_ARGS)   /* called at end of heap profile */
 {
-    CostCentre cc; ClCategory clcat; hash_t ind, max;
+    CostCentre cc;
+    ClCategory clcat;
+    hash_t ind, max;
     StgFloat seconds;
     StgFloat seconds;
+    W_ heap_prof_style;
 
 
-    if (heap_profiling_req == HEAP_NO_PROFILING)
+    if (! RTSflags.ProfFlags.doHeapProfile)
        return;
 
        return;
 
+    heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
     heap_profile_fn = profile_closure_none;
 
     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
     fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 
     heap_profile_fn = profile_closure_none;
 
     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
     fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 
-    max = (* init_index_fns[heap_profiling_req])();
+    max = (* init_index_fns[heap_prof_style])();
 
 
-    switch (heap_profiling_req) {
+    switch (heap_prof_style) {
       case HEAP_BY_CC:
        for (ind = 0; ind < max; ind++) {
       case HEAP_BY_CC:
        for (ind = 0; ind < max; ind++) {
-           if ((cc = index_cc_table[ind]) != 0) {
+           if ((cc = index_cc_table[ind]) != 0 && ! cc_to_ignore(cc)) {
                fprintf(heap_file, "  %0.11s:%0.16s %ld\n", cc->module, cc->label, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
                fprintf(heap_file, "  %0.11s:%0.16s %ld\n", cc->module, cc->label, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
@@ -815,7 +647,7 @@ heap_profile_done(STG_NO_ARGS)        /* called at end of heap profile */
 
       case HEAP_BY_MOD:
        for (ind = 0; ind < max; ind++) {
 
       case HEAP_BY_MOD:
        for (ind = 0; ind < max; ind++) {
-           if ((cc = index_mod_table[ind]) != 0) {
+           if ((cc = index_mod_table[ind]) != 0 && ! cc_to_ignore(cc)) {
                fprintf(heap_file, "  %0.11s %ld\n", cc->module, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
                fprintf(heap_file, "  %0.11s %ld\n", cc->module, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
@@ -824,7 +656,7 @@ heap_profile_done(STG_NO_ARGS)        /* called at end of heap profile */
 
       case HEAP_BY_GRP:
        for (ind = 0; ind < max; ind++) {
 
       case HEAP_BY_GRP:
        for (ind = 0; ind < max; ind++) {
-           if ((cc = index_grp_table[ind]) != 0) {
+           if ((cc = index_grp_table[ind]) != 0 && ! cc_to_ignore(cc)) {
                fprintf(heap_file, "  %0.11s %ld\n", cc->group, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
                fprintf(heap_file, "  %0.11s %ld\n", cc->group, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
@@ -833,7 +665,7 @@ heap_profile_done(STG_NO_ARGS)        /* called at end of heap profile */
 
       case HEAP_BY_DESCR:
        for (ind = 0; ind < max; ind++) {
 
       case HEAP_BY_DESCR:
        for (ind = 0; ind < max; ind++) {
-           if ((clcat = index_descr_table[ind]) != 0) {
+           if ((clcat = index_descr_table[ind]) != 0 && ! cc_to_ignore(cc)) {
                fprintf(heap_file, "  %0.28s %ld\n", clcat->descr, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
                fprintf(heap_file, "  %0.28s %ld\n", clcat->descr, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
@@ -842,42 +674,12 @@ heap_profile_done(STG_NO_ARGS)      /* called at end of heap profile */
 
       case HEAP_BY_TYPE:
        for (ind = 0; ind < max; ind++) {
 
       case HEAP_BY_TYPE:
        for (ind = 0; ind < max; ind++) {
-           if ((clcat = index_type_table[ind]) != 0) {
+           if ((clcat = index_type_table[ind]) != 0 && ! cc_to_ignore(cc)) {
                fprintf(heap_file, "  %0.28s %ld\n", clcat->type, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
        }
        break;
                fprintf(heap_file, "  %0.28s %ld\n", clcat->type, resid[ind] * sizeof(W_));
            }
            resid[ind] = 0;
        }
        break;
-
-#if defined(HEAP_PROF_WITH_AGE)
-      case HEAP_BY_TIME:
-       { I_ resid_tot = 0;
-         if (resid_earlier) {
-             resid_tot += resid_earlier;
-             fprintf(heap_file, "  before_%4.2fs %ld\n",
-                     (earlier_intervals-1)*interval_ticks/(StgFloat)TICK_FREQUENCY,
-                     resid_earlier * sizeof(StgWord));
-             resid_earlier = 0;
-         }
-         for (ind = 0; ind < max; ind++) {
-             if (resid[ind]) {
-                 resid_tot +=  resid[ind];
-                 fprintf(heap_file, "  before_%4.2fs %ld\n",
-                         (ind+earlier_intervals)*interval_ticks/(StgFloat)TICK_FREQUENCY,
-                         resid[ind] * sizeof(StgWord));
-                 resid[ind] = 0;
-             }
-         }
-         if (resid_later) {
-             resid_tot += resid_later;
-             fprintf(heap_file, "  later %ld\n", resid_later * sizeof(StgWord));
-             resid_later = 0;
-         }
-
-         if (resid_max < resid_tot) resid_max = resid_tot;
-         break;
-        }
-#endif /* HEAP_PROF_WITH_AGE */
     }
 
     fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds);
     }
 
     fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds);
@@ -889,7 +691,7 @@ heap_profile_finish(STG_NO_ARGS)     /* called at end of execution */
 {
     StgFloat seconds;
 
 {
     StgFloat seconds;
 
-    if (heap_profiling_req == HEAP_NO_PROFILING)
+    if (! RTSflags.ProfFlags.doHeapProfile)
        return;
 
     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
        return;
 
     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
@@ -902,5 +704,5 @@ heap_profile_finish(STG_NO_ARGS)     /* called at end of execution */
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 \end{code}
 \end{code}
index 927e199..f9bfeca 100644 (file)
@@ -1,9 +1,9 @@
-Only have cost centres etc if @USE_COST_CENTRES@ defined
+Only have cost centres etc if @PROFILING@ defined
 
 \begin{code}
 #define NULL_REG_MAP   /* Not threaded */
 
 \begin{code}
 #define NULL_REG_MAP   /* Not threaded */
-#include "../storage/SMinternal.h"  /* for xmalloc */
-#if defined (USE_COST_CENTRES)
+#include "../storage/SMinternal.h"  /* for ??? */
+#if defined (PROFILING)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -40,8 +40,10 @@ init_index_cc()
     max_cc_no = max2;
     mask_cc = max2 - 1;
 
     max_cc_no = max2;
     mask_cc = max2 - 1;
 
-    index_cc_table = (CostCentre *) xmalloc(max2 * sizeof(CostCentre));
-    for (count = 0; count < max2; count++) index_cc_table[count] = 0;
+    index_cc_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_cc");
+
+    for (count = 0; count < max2; count++)
+       index_cc_table[count] = 0;
 
     return max2;
 }
 
     return max2;
 }
@@ -95,13 +97,16 @@ init_index_mod()
     max_mod_no = max2;
     mask_mod = max2 - 1;
 
     max_mod_no = max2;
     mask_mod = max2 - 1;
 
-    index_mod_table = (CostCentre *) xmalloc(max2 * sizeof(CostCentre));
-    for (count = 0; count < max2; count++) index_mod_table[count] = 0;
+    index_mod_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_mod");
+
+    for (count = 0; count < max2; count++)
+       index_mod_table[count] = 0;
 
     return max2;
 }
 
 
     return max2;
 }
 
-hash_t index_mod(cc)
+hash_t
+index_mod(cc)
     CostCentre cc;
 {
     if (cc->index_val == UNHASHED) {
     CostCentre cc;
 {
     if (cc->index_val == UNHASHED) {
@@ -152,13 +157,16 @@ init_index_grp()
     max_grp_no = max2;
     mask_grp = max2 - 1;
 
     max_grp_no = max2;
     mask_grp = max2 - 1;
 
-    index_grp_table = (CostCentre *) xmalloc(max2 * sizeof(CostCentre));
-    for (count = 0; count < max2; count++) index_grp_table[count] = 0;
+    index_grp_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_grp");
+
+    for (count = 0; count < max2; count++)
+       index_grp_table[count] = 0;
 
     return max2;
 }
 
 
     return max2;
 }
 
-hash_t index_grp(cc)
+hash_t
+index_grp(cc)
     CostCentre cc;
 {
     if (cc->index_val == UNHASHED) {
     CostCentre cc;
 {
     if (cc->index_val == UNHASHED) {
@@ -209,13 +217,16 @@ init_index_descr()
     max_descr_no = max2;
     mask_descr = max2 - 1;
 
     max_descr_no = max2;
     mask_descr = max2 - 1;
 
-    index_descr_table = (ClCategory *) xmalloc(max2 * sizeof(ClCategory));
-    for (count = 0; count < max2; count++) index_descr_table[count] = 0;
+    index_descr_table = (ClCategory *) stgMallocBytes(max2 * sizeof(ClCategory), "init_index_descr");
+
+    for (count = 0; count < max2; count++)
+       index_descr_table[count] = 0;
 
     return max2;
 }
 
 
     return max2;
 }
 
-hash_t index_descr(clcat)
+hash_t
+index_descr(clcat)
     ClCategory clcat;
 {
     if (clcat->index_val == UNHASHED) {
     ClCategory clcat;
 {
     if (clcat->index_val == UNHASHED) {
@@ -266,8 +277,10 @@ init_index_type()
     max_type_no = max2;
     mask_type = max2 - 1;
 
     max_type_no = max2;
     mask_type = max2 - 1;
 
-    index_type_table = (ClCategory *) xmalloc(max2 * sizeof(ClCategory));
-    for (count = 0; count < max2; count++) index_type_table[count] = 0;
+    index_type_table = (ClCategory *) stgMallocBytes(max2 * sizeof(ClCategory), "init_index_type");
+
+    for (count = 0; count < max2; count++)
+       index_type_table[count] = 0;
 
     return max2;
 }
 
     return max2;
 }
@@ -297,5 +310,5 @@ hash_t index_type(clcat)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 \end{code}
 \end{code}
diff --git a/ghc/runtime/profiling/LifeProfile.lc b/ghc/runtime/profiling/LifeProfile.lc
deleted file mode 100644 (file)
index dc5b74b..0000000
+++ /dev/null
@@ -1,299 +0,0 @@
-\section[LifeProfile.lc]{Code for Lifetime Profiling}
-
-\tr{life_profile} is the accumulated age at death profile. It is
-calculated from the difference of the prev and cur age profiles.
-
-\tr{update_profile} is the accumulated age at update profile.
-
-\begin{code}
-#include "rtsdefs.h"
-\end{code}
-
-Only have lifetime profiling if @LIFE_PROFILE@ defined
-
-\begin{code}
-#if defined(LIFE_PROFILE)
-\end{code}
-
-Note: Heap Lookahead may cause age increment when no alloc occurs !
-
-Could avoid it and assume space is available. If a closure was then
-allocated it may be given a younger age. Subsequent Heap Check would
-increment age.
-
-\begin{code}
-I_ do_life_prof = 0;     /* Global Flag */
-I_ CurrentTime  = 0;     /* Current time  (in LifeIntervals) */
-I_ LifeInterval = DEFAULT_LIFE_INTERVAL;    /* words alloced */
-
-W_ closures_updated = 0;
-W_ closures_alloced = 0;
-
-static W_ words_allocated = 0;
-
-static StgChar* prog;
-static I_ over_alloc = 0;
-static I_ progress = 999;
-\end{code}
-
-
-\tr{cur_age_profile} is a histogram of live words of each age.
-
-\tr{prev_age_profile} is a histogram of the live words at the last
-profile expressed in the ages they wold be at the current profile.
-When the current is copied into the previous it must be shifted along.
-\tr{prev_age_profile[0]} is always 0!
-
-\begin{code}
-static I_ intervals; /* No of active intervals -- report to 10Mb */
-
-static W_ cur_age_profile[INTERVALS];
-static W_ cur_older = 0;
-static W_ prev_age_profile[INTERVALS];
-static W_ prev_older = 0;
-
-static W_ life_profile[INTERVALS];
-static W_ life_older = 0;
-static W_ update_profile[INTERVALS];
-static W_ update_older = 0;
-\end{code}
-
-\begin{code}
-I_
-life_profile_init(rts_argv, prog_argv)
-    StgChar *rts_argv[];
-    StgChar *prog_argv[];
-{
-    I_ i;
-
-    if (! do_life_prof)
-       return 0;
-
-    prog = prog_argv[0];
-
-    /* report up to 10Mb (2.5 Mwords) */
-    intervals = 2500000 / LifeInterval;
-    if (intervals > INTERVALS) 
-       intervals = INTERVALS;
-
-    for (i = 0; i < intervals; i++) {
-       cur_age_profile[i] = 0;
-       prev_age_profile[i] = 0;
-       life_profile[i] = 0;
-       update_profile[i] = 0;
-    }
-
-    return 0;
-}
-
-void life_profile_setup(STG_NO_ARGS)
-{
-    return;
-}
-
-I_
-life_profile_done(alloc, reqsize)
-    I_ alloc;
-    I_ reqsize;
-{
-    I_ i, actual_alloc, slop, shift_prev_age;
-
-    life_profile[0] += cur_age_profile[0];     /* age 0 still alive */
-
-    for (i = 1; i < intervals; i++) {
-       life_profile[i] += prev_age_profile[i] - cur_age_profile[i];
-       prev_age_profile[i] = cur_age_profile[i-1];
-       cur_age_profile[i-1] = 0;
-    }
-    life_older += prev_older - cur_older;
-    prev_older = cur_age_profile[intervals-1] + cur_older;
-    cur_age_profile[intervals-1] = 0;
-    cur_older = 0;
-
-    CurrentTime++;
-
-    words_allocated += alloc;
-
-    actual_alloc = words_allocated - closures_alloced;
-    slop = CurrentTime * LifeInterval - actual_alloc;
-
-    shift_prev_age = 0;
-    while (slop < 0) {
-       /* over allocated due to large reqsize */
-       CurrentTime++;
-       slop += LifeInterval;
-       over_alloc++;
-       shift_prev_age++;
-    }
-    if (shift_prev_age) {
-       /* shift prev age profile as we have skipped profiles */
-       for (i = intervals - 1; i >= intervals - shift_prev_age; i--) {
-           prev_older += prev_age_profile[i];
-       }           
-       for (i = intervals - 1; i >= shift_prev_age; i--) {
-           prev_age_profile[i] = prev_age_profile[i-shift_prev_age];
-       }
-       for (i = shift_prev_age - 1; i >= 0; i--) {
-           prev_age_profile[i] = 0;
-       }
-    }
-
-    if (++progress == 1000 || do_life_prof > 1) {
-       fprintf(stderr, "%s: intervals %ld interval %ld alloc %ld slop %ld req %ld (over %ld)\n",
-               prog, CurrentTime, LifeInterval, actual_alloc, slop, reqsize, over_alloc);
-       progress = 0;
-    }
-
-    if (slop + LifeInterval < reqsize) {
-       return(reqsize);
-    } else {
-       return(slop + LifeInterval);
-    }
-}
-
-void
-life_profile_finish(alloc, prog_argv)
-    I_ alloc;
-    StgChar *prog_argv[];
-{
-    I_ report, i;
-    StgChar life_filename[STATS_FILENAME_MAXLEN];
-    FILE *life_file;
-    W_ total_life, total_upd, total_interval,
-            accum_life, accum_upd;
-
-    if (! do_life_prof)
-       return;
-
-    total_interval = words_allocated + alloc - closures_alloced;
-
-    /* convert age 0 still alive to age 0 died */
-    life_profile[0] = closures_alloced - life_profile[0];
-
-    /* All the prev stuff just died ! */
-    for (i = 1; i < intervals; i++) {
-       life_profile[i] += prev_age_profile[i];
-    }
-    life_older += prev_older;
-
-    /* Produce liftime reports */
-    sprintf(life_filename, LIFE_FILENAME_FMT, prog_argv[0]);
-    if ( (life_file = fopen(life_filename,"w")) == NULL ) {
-       fprintf(stderr, "Can't open life profile report file %s\n", life_filename);
-    }
-    else {
-       for(i = 0, total_life = total_upd = 0; i < intervals; i++) {
-           total_life += life_profile[i];
-           total_upd  += update_profile[i];
-       }
-       total_life += life_older;
-       total_upd  += update_older;
-       
-       if (total_life != closures_alloced) {
-           fprintf(stderr, "Warning: Life Profile: %1lu closures in profile, %1lu allocated\n",
-                   total_life, closures_alloced);
-       }
-       if (total_upd != closures_updated) {
-           fprintf(stderr, "Warning: Update Age Profile: %1lu closures in profile, %1lu updated\n",
-                   total_upd, closures_updated);
-       }
-       
-       fprintf(life_file, "\tClosure Lifetime Profile  (%s)\n", time_str());
-       fprintf(life_file, "\n\t  ");
-       for(i = 0; prog_argv[i]; i++)
-           fprintf(life_file, " %s", prog_argv[i]);
-       fprintf(life_file, "\n\n\ttotal closures alloced: %lu\n",
-               closures_alloced);
-       fprintf(life_file, "\ttotal closures updated: %lu\n",
-               closures_updated);
-       fprintf(life_file, "\ttotal bytes alloced:    %lu\n",
-               total_interval*sizeof(W_));
-       fprintf(life_file, "\n  age (allocation)       liftime      age when updated\n");
-       fprintf(life_file, "     bytes  %%total  %%closures   No    %%updates    No\n");
-
-       accum_life = 0;
-       accum_upd = 0;
-
-       report = 0;
-       while (report < intervals) {
-           I_ life = 0;
-           I_ upd  = 0;
-
-           i = report;
-           report += GROUPED;
-
-           while(i < report) {
-               life += life_profile[i];
-               upd  += update_profile[i];
-               i++;
-           }
-
-           accum_life += life;
-           accum_upd += upd;
-
-           fprintf(life_file, "  %8ld %7.3f   %6.2f%9lu   %6.2f%9lu\n",
-                   (report)*LifeInterval*sizeof(W_),
-                   (report)*LifeInterval/(StgFloat)total_interval*100,
-                   accum_life/(StgFloat)closures_alloced*100,
-                   life,
-                   accum_upd/(StgFloat)closures_updated*100,
-                   upd);
-       }
-
-       fprintf(life_file, "     older           %6.2f%9lu   %6.2f%9lu\n\n",
-               life_older/(StgFloat)closures_alloced*100,
-               life_older,
-               update_older/(StgFloat)closures_updated*100,
-               update_older);
-
-       fprintf(life_file, "Raw Data:   lifetime   update\n");
-       for(i = 0; i < intervals; i++) {
-           fprintf(life_file, "  %8ld %9lu %9lu\n",
-                   (i+1)*LifeInterval*sizeof(W_), life_profile[i], update_profile[i]);
-       }
-
-       fclose(life_file);
-    }
-    return;
-}
-
-
-void
-life_profile_closure(closure, size)
-    P_ closure;
-    I_ size;
-{
-    I_ age;
-
-    age = CurrentTime - AGE_HDR(closure);
-    if (age < intervals)
-       cur_age_profile[age] += 1;
-    else
-       cur_older += 1;
-    return;
-}
-
-extern void update_profile_closure(closure)
-    P_ closure;
-{
-    I_ age;
-    
-    if (! do_life_prof)
-       return;
-
-    age = CurrentTime - AGE_HDR(closure);
-    if (age < intervals)
-       update_profile[age] += 1;
-    else
-       update_older += 1;
-    closures_updated++;
-    return;
-}
-
-\end{code}
-
-
-\begin{code}
-#endif /* LIFE_PROFILE */
-\end{code}
-
index c76ad4a..3a0a2fb 100644 (file)
@@ -1,9 +1,9 @@
-Only have cost centres etc if @USE_COST_CENTRES@ defined
+Only have cost centres etc if @PROFILING@ defined
 
 \begin{code}
 #include "rtsdefs.h"
 
 
 \begin{code}
 #include "rtsdefs.h"
 
-#if defined (USE_COST_CENTRES) || defined(GUM)
+#if defined (PROFILING) || defined(PAR)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -26,13 +26,8 @@ I_ interval_ticks = DEFAULT_INTERVAL;  /* No of ticks in an interval */
 I_ previous_ticks = 0;                 /* ticks in previous intervals */
 I_ current_ticks = 0;                  /* ticks in current interval */
 
 I_ previous_ticks = 0;                 /* ticks in previous intervals */
 I_ current_ticks = 0;                  /* ticks in current interval */
 
-#ifdef CONCURRENT
-I_ tick_millisecs;                    /* milliseconds per timer tick */
-#endif
-
 void
 void
-set_profile_timer(ms)
-I_ ms;
+set_profile_timer(I_ ms)
 {
     if (initialize_virtual_timer(ms)) {
        fflush(stdout);
 {
     if (initialize_virtual_timer(ms)) {
        fflush(stdout);
@@ -47,14 +42,14 @@ handle_tick_serial(STG_NO_ARGS)
     CC_TICK(CCC);
 
     /* fprintf(stderr,"tick for %s\n", CCC->label); */
     CC_TICK(CCC);
 
     /* fprintf(stderr,"tick for %s\n", CCC->label); */
-#if defined(USE_COST_CENTRES) && defined(DEBUG)
+#if defined(PROFILING) && defined(DEBUG)
     /* Why is this here?  --JSM  Debugging --WDP */
     if (CCC == STATIC_CC_REF(CC_OVERHEAD))
        abort();
 #endif
 
     if (++current_ticks >= interval_ticks && CCC != STATIC_CC_REF(CC_GC)) {
     /* Why is this here?  --JSM  Debugging --WDP */
     if (CCC == STATIC_CC_REF(CC_OVERHEAD))
        abort();
 #endif
 
     if (++current_ticks >= interval_ticks && CCC != STATIC_CC_REF(CC_GC)) {
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
        interval_expired = 1;   /* stop to process interval */
 #else
        report_cc_profiling(0 /*partial*/);
        interval_expired = 1;   /* stop to process interval */
 #else
        report_cc_profiling(0 /*partial*/);
@@ -68,6 +63,7 @@ void
 handle_tick_noserial(STG_NO_ARGS)
 {
     CC_TICK(CCC);
 handle_tick_noserial(STG_NO_ARGS)
 {
     CC_TICK(CCC);
+    ++current_ticks;
     return;
 }
 
     return;
 }
 
@@ -82,7 +78,7 @@ stop_time_profiler()
 void
 restart_time_profiler()
 {                              /* Restarts time profile */
 void
 restart_time_profiler()
 {                              /* Restarts time profile */
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     if (interval_expired)
 #endif
     {
     if (interval_expired)
 #endif
     {
@@ -97,8 +93,8 @@ void
 start_time_profiler()
 {                              /* Starts time profile */
     if (time_profiling) {
 start_time_profiler()
 {                              /* Starts time profile */
     if (time_profiling) {
-#ifdef CONCURRENT
-       set_profile_timer(tick_millisecs);
+#ifdef PAR
+       set_profile_timer(RTSflags.CcFlags.msecsPerTick);
 #else
        set_profile_timer(TICK_MILLISECS);
 #endif
 #else
        set_profile_timer(TICK_MILLISECS);
 #endif
@@ -107,5 +103,5 @@ start_time_profiler()
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-#endif /* USE_COST_CENTRES || GUM */
+#endif /* PROFILING || PAR */
 \end{code}
 \end{code}
diff --git a/ghc/runtime/storage/Force_GC.lc b/ghc/runtime/storage/Force_GC.lc
deleted file mode 100644 (file)
index 0e5120a..0000000
+++ /dev/null
@@ -1,50 +0,0 @@
-\section[Force_GC.lc]{Code for Forcing Garbage Collections}
-
-\begin{code}
-#include "rtsdefs.h"
-\end{code}
-
-Only have GC forcing if @FORCE_GC@ defined
-
-- currently only works with appel GC
-- in normal appel GC, if the force_gc flag is set *major* GC occurs
-  at the next scheduled minor GC if at least GCInterval word allocations have happened
-  since the last major GC.
-  (It also occurs when the normal conditions for a major GC is met)
-- if the force2s and force_gc flags are set 
-  (forcing appel GC to work as a 2 space GC) GC occurs
-  at least at every GCInterval word allocations 
-  (it also occurs when the semi-space limit is reached).
-  Therefore it has no effect if the interval specified is >= semi-space.
-    
-
-\begin{code}
-#if defined(FORCE_GC)
-\end{code}
-
-\begin{code}
-I_ force_GC = 0;     /* Global Flag */
-I_ GCInterval = DEFAULT_GC_INTERVAL;    /* words alloced */
-I_ alloc_since_last_major_GC = 0;    /* words alloced since last major GC */
-
-
-#endif /* FORCE_GC */
-\end{code}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
index 51265e5..85919b0 100644 (file)
@@ -29,22 +29,24 @@ P_ heap_space = 0;          /* Address of first word of slab
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
-I_
-initHeap( sm )
-    smInfo *sm;    
+rtsBool
+initHeap( smInfo *sm )
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
        /* Allocate the roots space */
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
        /* Allocate the roots space */
-       sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) );
+       sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
 
        /* Allocate the heap */
 
        /* Allocate the heap */
-       heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_));
+       heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
+                                        "initHeap (heap)");
 
 
-       compactingInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
-       compactingInfo.bits      = (BitWord *)(heap_space + SM_word_heap_size) - compactingInfo.bit_words;
+       compactingInfo.bit_words
+         = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
+       compactingInfo.bits
+         = (BitWord *)(heap_space + RTSflags.GcFlags.heapSize) - compactingInfo.bit_words;
 
 
-       compactingInfo.heap_words =  SM_word_heap_size - compactingInfo.bit_words;
+       compactingInfo.heap_words = RTSflags.GcFlags.heapSize - compactingInfo.bit_words;
        compactingInfo.base = HEAP_FRAME_BASE(heap_space, compactingInfo.heap_words);
        compactingInfo.lim  = HEAP_FRAME_LIMIT(heap_space, compactingInfo.heap_words);
 
        compactingInfo.base = HEAP_FRAME_BASE(heap_space, compactingInfo.heap_words);
        compactingInfo.lim  = HEAP_FRAME_LIMIT(heap_space, compactingInfo.heap_words);
 
@@ -53,16 +55,17 @@ initHeap( sm )
 
     sm->hp = hp_start = compactingInfo.base - 1;
 
 
     sm->hp = hp_start = compactingInfo.base - 1;
 
-    if (SM_alloc_size) {
-       sm->hplim = sm->hp + SM_alloc_size;
-       SM_alloc_min = 0; /* No min; alloc size specified */
+    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+       sm->hplim = compactingInfo.lim;
+    } else {
+       sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
+
+       RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
 
        if (sm->hplim > compactingInfo.lim) {
            fprintf(stderr, "Not enough heap for requested alloc size\n");
 
        if (sm->hplim > compactingInfo.lim) {
            fprintf(stderr, "Not enough heap for requested alloc size\n");
-           return -1;
+           return rtsFalse;
        }
        }
-    } else {
-       sm->hplim = compactingInfo.lim;
     }
 
     sm->CAFlist = NULL;
     }
 
     sm->CAFlist = NULL;
@@ -71,7 +74,7 @@ initHeap( sm )
     initExtensions( sm );
 #endif /* !PAR */
 
     initExtensions( sm );
 #endif /* !PAR */
 
-    if (SM_trace) {
+    if (RTSflags.GcFlags.trace) {
        fprintf(stderr, "COMPACTING Heap: Base 0x%lx, Lim 0x%lx, Bits 0x%lx, bit words 0x%lx\n",
                (W_) compactingInfo.base, (W_) compactingInfo.lim,
                (W_) compactingInfo.bits, (W_) compactingInfo.bit_words);
        fprintf(stderr, "COMPACTING Heap: Base 0x%lx, Lim 0x%lx, Bits 0x%lx, bit words 0x%lx\n",
                (W_) compactingInfo.base, (W_) compactingInfo.lim,
                (W_) compactingInfo.bits, (W_) compactingInfo.bit_words);
@@ -81,7 +84,7 @@ initHeap( sm )
                (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
     }
 
                (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
     }
 
-    return 0;
+    return rtsTrue; /* OK */
 }
 
 I_
 }
 
 I_
@@ -96,8 +99,7 @@ collectHeap(reqsize, sm, do_full_collection)
 
     SAVE_REGS(&ScanRegDump); /* Save registers */
 
 
     SAVE_REGS(&ScanRegDump); /* Save registers */
 
-    if (SM_trace)
-      {
+    if (RTSflags.GcFlags.trace) {
         fflush(stdout);     /* Flush stdout at start of GC */
        fprintf(stderr, "COMPACTING Start: base 0x%lx, lim 0x%lx\n                 hp 0x%lx, hplim 0x%lx, req %lu\n",
                (W_) compactingInfo.base, (W_) compactingInfo.lim,
         fflush(stdout);     /* Flush stdout at start of GC */
        fprintf(stderr, "COMPACTING Start: base 0x%lx, lim 0x%lx\n                 hp 0x%lx, hplim 0x%lx, req %lu\n",
                (W_) compactingInfo.base, (W_) compactingInfo.lim,
@@ -156,23 +158,23 @@ collectHeap(reqsize, sm, do_full_collection)
     resident = sm->hp - (compactingInfo.base - 1);
     DO_MAX_RESIDENCY(resident); /* stats only */
 
     resident = sm->hp - (compactingInfo.base - 1);
     DO_MAX_RESIDENCY(resident); /* stats only */
 
-    if (SM_alloc_size) {
-       sm->hplim = sm->hp + SM_alloc_size;
+    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+       sm->hplim = compactingInfo.lim;
+       free_space = sm->hplim - sm->hp;
+    } else {
+       sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
        if (sm->hplim > compactingInfo.lim) {
            free_space = 0;
        } else {
        if (sm->hplim > compactingInfo.lim) {
            free_space = 0;
        } else {
-           free_space = SM_alloc_size;
+           free_space = RTSflags.GcFlags.allocAreaSize;
        }
        }
-    } else {
-       sm->hplim = compactingInfo.lim;
-       free_space = sm->hplim - sm->hp;
     }
 
     hp_start = sm->hp;
 
     stat_endGC(alloc, compactingInfo.heap_words, resident, "");
 
     }
 
     hp_start = sm->hp;
 
     stat_endGC(alloc, compactingInfo.heap_words, resident, "");
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
                (W_) compactingInfo.base, (W_) compactingInfo.lim,
                (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
        fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
                (W_) compactingInfo.base, (W_) compactingInfo.lim,
                (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
@@ -185,7 +187,7 @@ collectHeap(reqsize, sm, do_full_collection)
 
     RESTORE_REGS(&ScanRegDump);     /* Restore Registers */
 
 
     RESTORE_REGS(&ScanRegDump);     /* Restore Registers */
 
-    if ((SM_alloc_min > free_space) || (reqsize > free_space))
+    if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
        return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
     else 
        return GC_SUCCESS;              /* Heap OK */
        return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
     else 
        return GC_SUCCESS;              /* Heap OK */
index 1a50a0e..bdfa415 100644 (file)
@@ -24,18 +24,19 @@ P_ heap_space = 0;          /* Address of first word of slab
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
 
-I_ initHeap( sm )
-    smInfo *sm;    
+rtsBool
+initHeap(smInfo * sm)
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
-       I_ semispaceSize = SM_word_heap_size / 2;
+       I_ semispaceSize = RTSflags.GcFlags.heapSize / 2;
 
        /* Allocate the roots space */
 
        /* Allocate the roots space */
-       sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) );
+       sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
 
        /* Allocate the heap */
 
        /* Allocate the heap */
-       heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_));
+       heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
+                                        "initHeap (heap)");
     
        /* Define the semi-spaces */
        semispaceInfo[0].base = HEAP_FRAME_BASE(heap_space, semispaceSize);
     
        /* Define the semi-spaces */
        semispaceInfo[0].base = HEAP_FRAME_BASE(heap_space, semispaceSize);
@@ -52,35 +53,27 @@ I_ initHeap( sm )
     sm->hp = hp_start = semispaceInfo[semispace].base - 1;
     sm->hardHpOverflowSize = 0;
 
     sm->hp = hp_start = semispaceInfo[semispace].base - 1;
     sm->hardHpOverflowSize = 0;
 
-    if (SM_alloc_size) {
-       sm->hplim = sm->hp + SM_alloc_size;
-       SM_alloc_min = 0; /* No min; alloc size specified */
+    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+       sm->hplim = semispaceInfo[semispace].lim;
+    } else {
+       sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
+
+       RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
 
        if (sm->hplim > semispaceInfo[semispace].lim) {
            fprintf(stderr, "Not enough heap for requested alloc size\n");
 
        if (sm->hplim > semispaceInfo[semispace].lim) {
            fprintf(stderr, "Not enough heap for requested alloc size\n");
-           return -1;
+           return rtsFalse;
        }
        }
-    } else {
-       sm->hplim = semispaceInfo[semispace].lim;
     }
 
     }
 
-#if defined(FORCE_GC)
-    if (force_GC) {
-       if (sm->hplim > sm->hp + GCInterval) {
-          sm->hplim = sm->hp + GCInterval; 
-       }
-       else {
-          force_GC = 0; /* forcing GC has no effect, as semi-space is smaller than GCInterval */ 
+    if (RTSflags.GcFlags.forceGC) {
+       if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
+          sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; 
+       } else {
+          RTSflags.GcFlags.forceGC = rtsFalse;
+         /* forcing GC has no effect, as semi-space is smaller than forcingInterval */ 
        }
     }
        }
     }
-#endif /* FORCE_GC */
-
-#if defined(LIFE_PROFILE)
-    sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2); /* space for HpLim incr */
-    if (do_life_prof) {
-       sm->hplim = sm->hp + LifeInterval;
-    }
-#endif /* LIFE_PROFILE */
 
     sm->CAFlist = NULL;
 
 
     sm->CAFlist = NULL;
 
@@ -88,7 +81,7 @@ I_ initHeap( sm )
     initExtensions( sm );
 #endif /* !PAR */
 
     initExtensions( sm );
 #endif /* !PAR */
 
-    if (SM_trace) {
+    if (RTSflags.GcFlags.trace) {
        fprintf(stderr, "TWO SPACE Heap: 0base, 0lim, 1base, 1lim\n                0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
                (W_) semispaceInfo[0].base, (W_) semispaceInfo[0].lim,
                (W_) semispaceInfo[1].base, (W_) semispaceInfo[1].lim);
        fprintf(stderr, "TWO SPACE Heap: 0base, 0lim, 1base, 1lim\n                0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
                (W_) semispaceInfo[0].base, (W_) semispaceInfo[0].lim,
                (W_) semispaceInfo[1].base, (W_) semispaceInfo[1].lim);
@@ -99,7 +92,7 @@ I_ initHeap( sm )
                (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
     }
 
                (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
     }
 
-    return 0;
+    return rtsTrue; /* OK */
 }
 
 I_
 }
 
 I_
@@ -108,10 +101,6 @@ collectHeap(reqsize, sm, do_full_collection)
     smInfo *sm;
     rtsBool do_full_collection; /* ignored */
 {
     smInfo *sm;
     rtsBool do_full_collection; /* ignored */
 {
-#if defined(LIFE_PROFILE)
-    I_ next_interval;  /* if doing profile */
-#endif
-
     I_ free_space,     /* No of words of free space following GC */
         alloc,                 /* Number of words allocated since last GC */
        resident,       /* Number of words remaining after GC */
     I_ free_space,     /* No of words of free space following GC */
         alloc,                 /* Number of words allocated since last GC */
        resident,       /* Number of words remaining after GC */
@@ -122,15 +111,11 @@ collectHeap(reqsize, sm, do_full_collection)
     fflush(stdout);     /* Flush stdout at start of GC */
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
     fflush(stdout);     /* Flush stdout at start of GC */
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
-#if defined(LIFE_PROFILE)
-    if (do_life_prof) {        life_profile_setup(); }
-#endif /* LIFE_PROFILE */
-
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     if (interval_expired) { heap_profile_setup(); }
     if (interval_expired) { heap_profile_setup(); }
-#endif  /* USE_COST_CENTRES */
+#endif  /* PROFILING */
   
   
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "TWO SPACE Start: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, req %lu\n",
                semispace, (W_) semispaceInfo[semispace].base,
                (W_) semispaceInfo[semispace].lim,
        fprintf(stderr, "TWO SPACE Start: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, req %lu\n",
                semispace, (W_) semispaceInfo[semispace].base,
                (W_) semispaceInfo[semispace].lim,
@@ -181,19 +166,19 @@ collectHeap(reqsize, sm, do_full_collection)
     resident = sm->hp - (semispaceInfo[semispace].base - 1);
     DO_MAX_RESIDENCY(resident); /* stats only */
 
     resident = sm->hp - (semispaceInfo[semispace].base - 1);
     DO_MAX_RESIDENCY(resident); /* stats only */
 
-    if (SM_alloc_size) {
-       sm->hplim = sm->hp + SM_alloc_size;
+    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+       sm->hplim = semispaceInfo[semispace].lim;
+       free_space = sm->hplim - sm->hp;
+    } else {
+       sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
        if (sm->hplim > semispaceInfo[semispace].lim) {
            free_space = 0;
        } else {
        if (sm->hplim > semispaceInfo[semispace].lim) {
            free_space = 0;
        } else {
-           free_space = SM_alloc_size;
+           free_space = RTSflags.GcFlags.allocAreaSize;
        }
        }
-    } else {
-       sm->hplim = semispaceInfo[semispace].lim;
-       free_space = sm->hplim - sm->hp;
     }
 
     }
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char comment_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
        char comment_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
@@ -208,40 +193,25 @@ collectHeap(reqsize, sm, do_full_collection)
                0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
 #endif
 
                0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
 #endif
 
-#if defined(LIFE_PROFILE)
-       if (do_life_prof) {
-           strcat(comment_str, " life");
-       }
-#endif
-#if defined(USE_COST_CENTRES)
-       if (interval_expired) {
-           strcat(comment_str, " prof");
-       }
+#if defined(PROFILING)
+       if (interval_expired) { strcat(comment_str, " prof"); }
 #endif
 
 #endif
 
-       stat_endGC(alloc, SM_word_heap_size, resident, comment_str);
+       stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
     } else {
     } else {
-       stat_endGC(alloc, SM_word_heap_size, resident, "");
+       stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
     }
 
     }
 
-#if defined(LIFE_PROFILE)
-      free_space = free_space / 2; /* space for HpLim incr */
-      if (do_life_prof) {
-         next_interval = life_profile_done(alloc, reqsize);
-         free_space -= next_interval;  /* ensure interval available */
-      }
-#endif /* LIFE_PROFILE */
-
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
       if (interval_expired) {
       if (interval_expired) {
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
          heap_profile_done();
 #endif
          report_cc_profiling(0 /*partial*/);
       }
          heap_profile_done();
 #endif
          report_cc_profiling(0 /*partial*/);
       }
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "TWO SPACE Done: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
                semispace, (W_) semispaceInfo[semispace].base,
                (W_) semispaceInfo[semispace].lim,
        fprintf(stderr, "TWO SPACE Done: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
                semispace, (W_) semispaceInfo[semispace].base,
                (W_) semispaceInfo[semispace].lim,
@@ -257,35 +227,22 @@ collectHeap(reqsize, sm, do_full_collection)
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
-    if ( (SM_alloc_min > free_space) || (reqsize > free_space) ) {
+    if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_sapce < reqsize)
       return( GC_HARD_LIMIT_EXCEEDED );        /* Heap absolutely exhausted */
       return( GC_HARD_LIMIT_EXCEEDED );        /* Heap absolutely exhausted */
-    } else {
 
 
-#if defined(FORCE_GC)
-    if (force_GC) {
-       if (sm->hplim > sm->hp + GCInterval) {
-         sm->hplim = sm->hp + GCInterval;
-       }
-    }
-#endif /* FORCE_GC */
-+        
-#if defined(LIFE_PROFILE)
-      /* space for HpLim incr */
-      sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2);
-      if (do_life_prof) {
-         /* set hplim for next life profile */
-         sm->hplim = sm->hp + next_interval;
-      }
-#endif /* LIFE_PROFILE */
-         
-      if (reqsize + sm->hardHpOverflowSize > free_space) {
-       return( GC_SOFT_LIMIT_EXCEEDED );   /* Heap nearly exhausted */
-      } else {
-       return( GC_SUCCESS );               /* Heap OK */
-      }
+    else {
+       if (RTSflags.GcFlags.forceGC
+        && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
+             sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
+       }
+
+       if (reqsize + sm->hardHpOverflowSize > free_space) {
+           return( GC_SOFT_LIMIT_EXCEEDED );   /* Heap nearly exhausted */
+       } else {
+           return( GC_SUCCESS );                   /* Heap OK */
+       }
     }
 }
 
 #endif /* GC2s */
     }
 }
 
 #endif /* GC2s */
-
 \end{code}
 \end{code}
diff --git a/ghc/runtime/storage/SMalloc.lc b/ghc/runtime/storage/SMalloc.lc
deleted file mode 100644 (file)
index fa1bdab..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-[
- SMalloc seems a BAD choice of name.  I expected this to be the routines I
- could use to allocate memory, not those used by the storage manager internally.
-
- KH
-]
-
-Routines that deal with memory allocation:
-
-All dynamic allocation must be done before the stacks and heap are
-allocated. This allows us to use the lower level sbrk routines if
-required.
-
-\begin{code}
-#define NULL_REG_MAP
-#include "SMinternal.h"
-
-/* Return a ptr to n StgWords (note: WORDS not BYTES!) or die miserably */
-/* ToDo: Should allow use of valloc to allign on page boundary */
-
-char *
-#ifdef __STDC__
-xmalloc(size_t n)
-#else
-xmalloc(n)
-    size_t n;
-#endif
-{
-    char *space;
-
-    if ((space = (char *) malloc(n)) == NULL) {
-       MallocFailHook((W_) n); /*msg*/
-       EXIT(EXIT_FAILURE);
-    }
-    return space;
-}
-\end{code}
index e82a986..27ec2be 100644 (file)
@@ -30,14 +30,10 @@ P_ heap_space = 0;          /* Address of first word of slab
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
-#if defined(PROMOTION_DATA)     /* For dead promote & premature promote data */
-P_ thisbase;                /* Start of old gen before this minor collection */
-P_ prevbase;                /* Start of old gen before previous minor collection */
-I_ prev_prom = 0;              /* Promoted previous minor collection */
-I_ dead_prev_prom = 0;         /* Dead words promoted previous minor */
-#endif /* PROMOTION_DATA */
-
-#if defined(_GC_DEBUG)
+static I_ allocd_since_last_major_GC = 0;
+       /* words alloced since last major GC; used when forcing GC */
+
+#if defined(DEBUG)
 void
 debug_look_for (start, stop, villain)
   P_ start, stop, villain;
 void
 debug_look_for (start, stop, villain)
   P_ start, stop, villain;
@@ -51,21 +47,21 @@ debug_look_for (start, stop, villain)
 }
 #endif
 
 }
 #endif
 
-I_
-initHeap( sm )
-    smInfo *sm;    
+rtsBool
+initHeap(smInfo * sm)
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
        /* Allocate the roots space */
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
        /* Allocate the roots space */
-       sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) );
+       sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
 
        /* Allocate the heap */
 
        /* Allocate the heap */
-       heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_));
+       heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
+                                        "initHeap (heap)");
 
        /* ToDo (ADR): trash entire heap contents */
 
 
        /* ToDo (ADR): trash entire heap contents */
 
-       if (SM_force_gc == USE_2s) {
+       if (RTSflags.GcFlags.force2s) {
            stat_init("TWOSPACE(APPEL)",
                      " No of Roots  Caf   Caf    Astk   Bstk",
                      "Astk Bstk Reg  No  bytes  bytes  bytes");
            stat_init("TWOSPACE(APPEL)",
                      " No of Roots  Caf   Caf    Astk   Bstk",
                      "Astk Bstk Reg  No  bytes  bytes  bytes");
@@ -77,8 +73,8 @@ initHeap( sm )
     }
     sm->hardHpOverflowSize = 0;
 
     }
     sm->hardHpOverflowSize = 0;
 
-    if (SM_force_gc == USE_2s) {
-       I_ semi_space_words = SM_word_heap_size / 2;
+    if (RTSflags.GcFlags.force2s) {
+       I_ semi_space_words = RTSflags.GcFlags.heapSize / 2;
        appelInfo.space[0].base = HEAP_FRAME_BASE(heap_space, semi_space_words);
        appelInfo.space[1].base = HEAP_FRAME_BASE(heap_space + semi_space_words, semi_space_words);
        appelInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, semi_space_words);
        appelInfo.space[0].base = HEAP_FRAME_BASE(heap_space, semi_space_words);
        appelInfo.space[1].base = HEAP_FRAME_BASE(heap_space + semi_space_words, semi_space_words);
        appelInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, semi_space_words);
@@ -88,37 +84,28 @@ initHeap( sm )
 
        sm->hp = hp_start = appelInfo.space[appelInfo.semi_space].base - 1;
 
 
        sm->hp = hp_start = appelInfo.space[appelInfo.semi_space].base - 1;
 
-       if (SM_alloc_size) {
-           sm->hplim = sm->hp + SM_alloc_size;
-           SM_alloc_min = 0; /* No min; alloc size specified */
+       if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+           sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
+       } else {
+           sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
+
+           RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
 
            if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
                fprintf(stderr, "Not enough heap for requested alloc size\n");
 
            if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
                fprintf(stderr, "Not enough heap for requested alloc size\n");
-               return -1;
+               return rtsFalse;
            }
            }
-       } else {
-           sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
        }
 
        }
 
-#if defined(FORCE_GC)
-        if (force_GC) {
-          if (sm->hplim > sm->hp + GCInterval) {
-              sm->hplim = sm->hp + GCInterval;
-           }
-           else {
+        if (RTSflags.GcFlags.forceGC) {
+          if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
+              sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
+           } else {
               /* no point in forcing GC, 
               /* no point in forcing GC, 
-                 as the semi-space is smaller than GCInterval */
-              force_GC = 0; 
+                 as the semi-space is smaller than forcingInterval */
+              RTSflags.GcFlags.forceGC = rtsFalse;
            }
         }
            }
         }
-#endif /* FORCE_GC */
-
-#if defined(LIFE_PROFILE)
-        sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2); /* space for HpLim incr */
-        if (do_life_prof) {
-           sm->hplim = sm->hp + LifeInterval;
-        }
-#endif /* LIFE_PROFILE */
 
        sm->OldLim = appelInfo.oldlim;
        sm->CAFlist = NULL;
 
        sm->OldLim = appelInfo.oldlim;
        sm->CAFlist = NULL;
@@ -127,55 +114,59 @@ initHeap( sm )
        initExtensions( sm );
 #endif
 
        initExtensions( sm );
 #endif
 
-       if (SM_trace) {
+       if (RTSflags.GcFlags.trace) {
            fprintf(stderr, "APPEL(2s) Heap: 0x%lx .. 0x%lx\n",
            fprintf(stderr, "APPEL(2s) Heap: 0x%lx .. 0x%lx\n",
-                   (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size));
+                   (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
            fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %lu\n",
                    appelInfo.semi_space,
                    (W_) appelInfo.space[appelInfo.semi_space].base,
                    (W_) appelInfo.space[appelInfo.semi_space].lim,
                    (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
        }
            fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %lu\n",
                    appelInfo.semi_space,
                    (W_) appelInfo.space[appelInfo.semi_space].base,
                    (W_) appelInfo.space[appelInfo.semi_space].lim,
                    (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
        }
-       return 0;
+       return rtsTrue;
     }
 
 
 /* So not forced 2s */
 
     }
 
 
 /* So not forced 2s */
 
-    appelInfo.newlim  = heap_space + SM_word_heap_size - 1;
-    if (SM_alloc_size) {
-       appelInfo.newfixed = SM_alloc_size;
-       appelInfo.newmin   = SM_alloc_size;
-        appelInfo.newbase  = heap_space + SM_word_heap_size - appelInfo.newfixed;
+    appelInfo.newlim  = heap_space + RTSflags.GcFlags.heapSize - 1;
+    if (RTSflags.GcFlags.allocAreaSizeGiven) {
+       appelInfo.newfixed = RTSflags.GcFlags.allocAreaSize;
+       appelInfo.newmin   = RTSflags.GcFlags.allocAreaSize;
+        appelInfo.newbase  = heap_space + RTSflags.GcFlags.heapSize - appelInfo.newfixed;
     } else {
        appelInfo.newfixed = 0;
     } else {
        appelInfo.newfixed = 0;
-       appelInfo.newmin   = SM_alloc_min;
-       appelInfo.newbase  = heap_space + (SM_word_heap_size / 2);
+       appelInfo.newmin   = RTSflags.GcFlags.minAllocAreaSize;
+       appelInfo.newbase  = heap_space + (RTSflags.GcFlags.heapSize / 2);
     }
 
     appelInfo.oldbase = heap_space;
     appelInfo.oldlim  = heap_space - 1;
     appelInfo.oldlast = heap_space - 1;
     }
 
     appelInfo.oldbase = heap_space;
     appelInfo.oldlim  = heap_space - 1;
     appelInfo.oldlast = heap_space - 1;
-    appelInfo.oldmax  = heap_space - 1 + SM_word_heap_size - 2*appelInfo.newmin;
+    appelInfo.oldmax  = heap_space - 1 + RTSflags.GcFlags.heapSize - 2*appelInfo.newmin;
 
     if (appelInfo.oldbase > appelInfo.oldmax) {
        fprintf(stderr, "Not enough heap for requested/minimum allocation area\n");
 
     if (appelInfo.oldbase > appelInfo.oldmax) {
        fprintf(stderr, "Not enough heap for requested/minimum allocation area\n");
-       return -1;
+       fprintf(stderr, "heap_space=%ld\n", heap_space);
+       fprintf(stderr, "heapSize=%ld\n", RTSflags.GcFlags.heapSize);
+       fprintf(stderr, "newmin=%ld\n", appelInfo.newmin);
+       return rtsFalse;
     }
 
     }
 
-    appelInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
+    appelInfo.bit_words = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
+
     if (appelInfo.bit_words > appelInfo.newmin)
     if (appelInfo.bit_words > appelInfo.newmin)
-        appelInfo.oldmax = heap_space - 1 + SM_word_heap_size - appelInfo.bit_words - appelInfo.newmin;
+        appelInfo.oldmax = heap_space - 1 + RTSflags.GcFlags.heapSize - appelInfo.bit_words - appelInfo.newmin;
 
 
-    if (SM_major_gen_size) {
-       appelInfo.oldthresh = heap_space -1 + SM_major_gen_size;
+    if (RTSflags.GcFlags.specifiedOldGenSize) {
+       appelInfo.oldthresh = heap_space -1 + RTSflags.GcFlags.specifiedOldGenSize;
        if (appelInfo.oldthresh > appelInfo.oldmax) {
            fprintf(stderr, "Not enough heap for requested major resid size\n");
        if (appelInfo.oldthresh > appelInfo.oldmax) {
            fprintf(stderr, "Not enough heap for requested major resid size\n");
-           return -1;
+           return rtsFalse;
        }
     } else {
        }
     } else {
-       appelInfo.oldthresh = heap_space + SM_word_heap_size * 2 / 3; /* Initial threshold -- 2/3rds */
+       appelInfo.oldthresh = heap_space + RTSflags.GcFlags.heapSize * 2 / 3; /* Initial threshold -- 2/3rds */
        if (appelInfo.oldthresh > appelInfo.oldmax)
            appelInfo.oldthresh = appelInfo.oldmax;
     }
        if (appelInfo.oldthresh > appelInfo.oldmax)
            appelInfo.oldthresh = appelInfo.oldmax;
     }
@@ -183,11 +174,10 @@ initHeap( sm )
     sm->hp = hp_start = appelInfo.newbase - 1;
     sm->hplim = appelInfo.newlim;
 
     sm->hp = hp_start = appelInfo.newbase - 1;
     sm->hplim = appelInfo.newlim;
 
-#if defined(FORCE_GC)
-        if (force_GC && (sm->hplim > sm->hp + GCInterval)) {
-              sm->hplim = sm->hp + GCInterval;
-           }
-#endif /* FORCE_GC */
+    if (RTSflags.GcFlags.forceGC
+     && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
+       sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
+    }
 
     sm->OldLim = appelInfo.oldlim;
 
 
     sm->OldLim = appelInfo.oldlim;
 
@@ -201,14 +191,9 @@ initHeap( sm )
 
     appelInfo.PromMutables = 0;
 
 
     appelInfo.PromMutables = 0;
 
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data */
-    prevbase = appelInfo.oldlim + 1;
-    thisbase = appelInfo.oldlim + 1;
-#endif /* PROMOTION_DATA */
-
-    if (SM_trace) {
+    if (RTSflags.GcFlags.trace) {
        fprintf(stderr, "APPEL Heap: 0x%lx .. 0x%lx\n",
        fprintf(stderr, "APPEL Heap: 0x%lx .. 0x%lx\n",
-               (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size));
+               (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
        fprintf(stderr, "Initial: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n         hp 0x%lx, hplim 0x%lx\n",
                (W_) appelInfo.newbase, (W_) appelInfo.newlim,
                (W_) appelInfo.oldbase, (W_) appelInfo.oldlim,
        fprintf(stderr, "Initial: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n         hp 0x%lx, hplim 0x%lx\n",
                (W_) appelInfo.newbase, (W_) appelInfo.newlim,
                (W_) appelInfo.oldbase, (W_) appelInfo.oldlim,
@@ -216,17 +201,12 @@ initHeap( sm )
                (W_) sm->hp, (W_) sm->hplim);
     }
 
                (W_) sm->hp, (W_) sm->hplim);
     }
 
-    return 0;
+    return rtsTrue; /* OK */
 }
 
 static I_
 }
 
 static I_
-collect2s(reqsize, sm)
-    W_ reqsize;
-    smInfo *sm;
+collect2s(W_ reqsize, smInfo *sm)
 {
 {
-#if defined(LIFE_PROFILE)
-    I_ next_interval;  /* if doing profile */
-#endif
     I_ free_space,     /* No of words of free space following GC */
         alloc,                 /* Number of words allocated since last GC */
        resident,       /* Number of words remaining after GC */
     I_ free_space,     /* No of words of free space following GC */
         alloc,                 /* Number of words allocated since last GC */
        resident,       /* Number of words remaining after GC */
@@ -236,15 +216,11 @@ collect2s(reqsize, sm)
 
     SAVE_REGS(&ScavRegDump);        /* Save registers */
 
 
     SAVE_REGS(&ScavRegDump);        /* Save registers */
 
-#if defined(LIFE_PROFILE)
-    if (do_life_prof) {        life_profile_setup(); }
-#endif /* LIFE_PROFILE */
-
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
     if (interval_expired) { heap_profile_setup(); }
     if (interval_expired) { heap_profile_setup(); }
-#endif  /* USE_COST_CENTRES */
+#endif  /* PROFILING */
   
   
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, req %lu\n",
                appelInfo.semi_space,
                (W_) appelInfo.space[appelInfo.semi_space].base,
        fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, req %lu\n",
                appelInfo.semi_space,
                (W_) appelInfo.space[appelInfo.semi_space].base,
@@ -291,33 +267,32 @@ collect2s(reqsize, sm)
     resident = sm->hp - (appelInfo.space[appelInfo.semi_space].base - 1);
     DO_MAX_RESIDENCY(resident); /* stats only */
 
     resident = sm->hp - (appelInfo.space[appelInfo.semi_space].base - 1);
     DO_MAX_RESIDENCY(resident); /* stats only */
 
-    if (SM_alloc_size) {
-       sm->hplim = sm->hp + SM_alloc_size;
+    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+       sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
+       free_space = sm->hplim - sm->hp;
+    } else {
+       sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
        if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
            free_space = 0;
        } else {
        if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
            free_space = 0;
        } else {
-           free_space = SM_alloc_size;
+           free_space = RTSflags.GcFlags.allocAreaSize;
        }
        }
-    } else {
-       sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
-       free_space = sm->hplim - sm->hp;
     }
 
     }
 
-#if defined(FORCE_GC)
-    if (force_GC && (sm->hplim > sm->hp + GCInterval)) {
-              sm->hplim = sm->hp + GCInterval;
-           }
-#endif /* FORCE_GC */
+    if (RTSflags.GcFlags.forceGC
+     && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
+       sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
+    }
 
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char comment_str[BIG_STRING_LEN];
 #ifndef PAR
        char comment_str[BIG_STRING_LEN];
 #ifndef PAR
-       sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
-               (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
+       sprintf(comment_str, "%4lu %4ld %3ld %3ld %6lu %6lu %6lu  2s",
+               (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
                bstk_roots, sm->rootno,
                caf_roots, extra_caf_words*sizeof(W_),
                bstk_roots, sm->rootno,
                caf_roots, extra_caf_words*sizeof(W_),
-               (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_),
-               (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_));
+               (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_),
+               (W_) (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_));
 #else
        /* ToDo: come up with some interesting statistics for the parallel world */
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
 #else
        /* ToDo: come up with some interesting statistics for the parallel world */
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
@@ -325,40 +300,25 @@ collect2s(reqsize, sm)
 
 #endif
 
 
 #endif
 
-#if defined(LIFE_PROFILE)
-       if (do_life_prof) {
-           strcat(comment_str, " life");
-       }
-#endif
-#if defined(USE_COST_CENTRES)
-       if (interval_expired) {
-           strcat(comment_str, " prof");
-       }
+#if defined(PROFILING)
+       if (interval_expired) { strcat(comment_str, " prof"); }
 #endif
 
 #endif
 
-       stat_endGC(alloc, SM_word_heap_size, resident, comment_str);
+       stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
     } else {
     } else {
-       stat_endGC(alloc, SM_word_heap_size, resident, "");
+       stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
     }
 
     }
 
-#if defined(LIFE_PROFILE)
-      free_space = free_space / 2; /* space for HpLim incr */
-      if (do_life_prof) {
-         next_interval = life_profile_done(alloc, reqsize);
-         free_space -= next_interval;  /* ensure interval available */
-      }
-#endif /* LIFE_PROFILE */
-
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
       if (interval_expired) {
       if (interval_expired) {
-# if defined(USE_COST_CENTRES)
+# if defined(PROFILING)
          heap_profile_done();
 # endif
          report_cc_profiling(0 /*partial*/);
       }
          heap_profile_done();
 # endif
          report_cc_profiling(0 /*partial*/);
       }
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING */
 
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "Done:  space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, free %lu\n",
                appelInfo.semi_space,
                (W_) appelInfo.space[appelInfo.semi_space].base,
        fprintf(stderr, "Done:  space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, free %lu\n",
                appelInfo.semi_space,
                (W_) appelInfo.space[appelInfo.semi_space].base,
@@ -371,6 +331,7 @@ collect2s(reqsize, sm)
            we just came from. */
     {
       I_ old_space = NEXT_SEMI_SPACE(appelInfo.semi_space);
            we just came from. */
     {
       I_ old_space = NEXT_SEMI_SPACE(appelInfo.semi_space);
+
       TrashMem(appelInfo.space[old_space].base, appelInfo.space[old_space].lim);
       TrashMem(sm->hp+1, sm->hplim);
     }
       TrashMem(appelInfo.space[old_space].base, appelInfo.space[old_space].lim);
       TrashMem(sm->hp+1, sm->hplim);
     }
@@ -378,21 +339,9 @@ collect2s(reqsize, sm)
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
-    if ( (SM_alloc_min > free_space) || (reqsize > free_space) ) {
+    if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
       return( GC_HARD_LIMIT_EXCEEDED );        /* Heap absolutely exhausted */
       return( GC_HARD_LIMIT_EXCEEDED );        /* Heap absolutely exhausted */
-    } else {
-
-#if defined(LIFE_PROFILE)
-       /* ToDo: this may not be right now (WDP 94/11) */
-
-       /* space for HpLim incr */
-       sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2);
-       if (do_life_prof) {
-           /* set hplim for next life profile */
-           sm->hplim = sm->hp + next_interval;
-       }
-#endif /* LIFE_PROFILE */
-
+    else {
        if (reqsize + sm->hardHpOverflowSize > free_space) {
          return( GC_SOFT_LIMIT_EXCEEDED );     /* Heap nearly exhausted */
        } else {
        if (reqsize + sm->hardHpOverflowSize > free_space) {
          return( GC_SOFT_LIMIT_EXCEEDED );     /* Heap nearly exhausted */
        } else {
@@ -409,40 +358,29 @@ collectHeap(reqsize, sm, do_full_collection)
     rtsBool do_full_collection; /* do a major collection regardless? */
 {
     I_ bstk_roots, caf_roots, mutable, old_words;
     rtsBool do_full_collection; /* do a major collection regardless? */
 {
     I_ bstk_roots, caf_roots, mutable, old_words;
-    P_ oldptr, old_start, mutptr, prevmut;
+    P_ old_start, mutptr, prevmut;
     P_ CAFptr, prevCAF;
     P_ CAFptr, prevCAF;
-    P_ next;
 
     I_ alloc,          /* Number of words allocated since last GC */
        resident;       /* Number of words remaining after GC */
 
 
     I_ alloc,          /* Number of words allocated since last GC */
        resident;       /* Number of words remaining after GC */
 
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data */
-    I_ promote,        /* Promoted this minor collection */
-        dead_prom,      /* Dead words promoted this minor */
-        dead_prev;      /* Promoted words that died since previos minor collection */
-    I_  root;
-    P_ base[2];
-#endif /* PROMOTION_DATA */
-
     fflush(stdout);     /* Flush stdout at start of GC */
 
     fflush(stdout);     /* Flush stdout at start of GC */
 
-    if (SM_force_gc == USE_2s) {
+    if (RTSflags.GcFlags.force2s) {
        return collect2s(reqsize, sm);
     }
 
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
        return collect2s(reqsize, sm);
     }
 
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "Start: newbase 0x%lx, newlim 0x%lx\n        hp 0x%lx, hplim 0x%lx, req %lu\n",
                (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
 
     alloc = sm->hp - hp_start;
     stat_startGC(alloc);
 
        fprintf(stderr, "Start: newbase 0x%lx, newlim 0x%lx\n        hp 0x%lx, hplim 0x%lx, req %lu\n",
                (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
 
     alloc = sm->hp - hp_start;
     stat_startGC(alloc);
 
-#ifdef FORCE_GC
-    alloc_since_last_major_GC += sm->hplim - hp_start;
+    allocd_since_last_major_GC += sm->hplim - hp_start;
     /* this is indeed supposed to be less precise than alloc above */
     /* this is indeed supposed to be less precise than alloc above */
-#endif /* FORCE_GC */
 
     /* COPYING COLLECTION */
 
 
     /* COPYING COLLECTION */
 
@@ -481,6 +419,7 @@ collectHeap(reqsize, sm, do_full_collection)
     while ( mutptr ) {
 
        /* Scavenge the OldMutable */
     while ( mutptr ) {
 
        /* Scavenge the OldMutable */
+       P_ orig_mutptr = mutptr;
        P_ info = (P_) INFO_PTR(mutptr);
        StgScavPtr scav_code = SCAV_CODE(info);
        Scav = mutptr;
        P_ info = (P_) INFO_PTR(mutptr);
        StgScavPtr scav_code = SCAV_CODE(info);
        Scav = mutptr;
@@ -496,6 +435,7 @@ collectHeap(reqsize, sm, do_full_collection)
            prevmut = mutptr;
            mutptr = (P_) MUT_LINK(mutptr);
        }
            prevmut = mutptr;
            mutptr = (P_) MUT_LINK(mutptr);
        }
+
        mutable++;
     }
 
        mutable++;
     }
 
@@ -559,11 +499,11 @@ collectHeap(reqsize, sm, do_full_collection)
     resident = appelInfo.oldlim - sm->OldLim;
     /* DONT_DO_MAX_RESIDENCY -- it is just a minor collection */
 
     resident = appelInfo.oldlim - sm->OldLim;
     /* DONT_DO_MAX_RESIDENCY -- it is just a minor collection */
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char minor_str[BIG_STRING_LEN];
 #ifndef PAR
        char minor_str[BIG_STRING_LEN];
 #ifndef PAR
-       sprintf(minor_str, "%4u %4ld %3ld %3ld  %4ld        Minor",
-             (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
+       sprintf(minor_str, "%4lu %4ld %3ld %3ld  %4ld        Minor",
+             (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
              bstk_roots, sm->rootno, caf_roots, mutable); /* oldnew_roots, old_words */
 #else
        /* ToDo: come up with some interesting statistics for the parallel world */
              bstk_roots, sm->rootno, caf_roots, mutable); /* oldnew_roots, old_words */
 #else
        /* ToDo: come up with some interesting statistics for the parallel world */
@@ -577,41 +517,26 @@ collectHeap(reqsize, sm, do_full_collection)
 
     /* Note: if do_full_collection we want to force a full collection. [ADR] */
 
 
     /* Note: if do_full_collection we want to force a full collection. [ADR] */
 
-#ifdef FORCE_GC
-    if (force_GC && (alloc_since_last_major_GC >= GCInterval)) { 
-       do_full_collection = 1; 
+    if (RTSflags.GcFlags.forceGC
+     && allocd_since_last_major_GC >= RTSflags.GcFlags.forcingInterval) { 
+       do_full_collection = 1;
     }
     }
-#endif /* FORCE_GC */
-
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data major required */
-
-    if (! SM_stats_verbose &&
-       (appelInfo.oldlim < appelInfo.oldthresh) &&
-       (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) &&
-       (! do_full_collection) ) {
-
-#else  /* ! PROMOTION_DATA */
 
     if ((appelInfo.oldlim < appelInfo.oldthresh) &&
        (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) &&
        (! do_full_collection) ) {
 
 
     if ((appelInfo.oldlim < appelInfo.oldthresh) &&
        (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) &&
        (! do_full_collection) ) {
 
-#endif /* ! PROMOTION_DATA */
-
        sm->hp = hp_start = appelInfo.newbase - 1;
        sm->hplim = appelInfo.newlim;
 
        sm->hp = hp_start = appelInfo.newbase - 1;
        sm->hplim = appelInfo.newlim;
 
-#if defined(FORCE_GC)
-        if (force_GC && 
-            (alloc_since_last_major_GC + (sm->hplim - hp_start) > GCInterval))
-        {
-              sm->hplim = sm->hp + (GCInterval - alloc_since_last_major_GC);
+        if (RTSflags.GcFlags.forceGC
+        && (allocd_since_last_major_GC + (sm->hplim - hp_start) > RTSflags.GcFlags.forcingInterval)) {
+           sm->hplim = sm->hp + (RTSflags.GcFlags.forcingInterval - allocd_since_last_major_GC);
         }
         }
-#endif /* FORCE_GC */
 
        sm->OldLim = appelInfo.oldlim;
 
 
        sm->OldLim = appelInfo.oldlim;
 
-       if (SM_trace) {
+       if (RTSflags.GcFlags.trace) {
            fprintf(stderr, "Minor: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
                    (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
                    (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
            fprintf(stderr, "Minor: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
                    (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
                    (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
@@ -632,20 +557,12 @@ collectHeap(reqsize, sm, do_full_collection)
 
     DEBUG_STRING("Major Collection Required");
 
 
     DEBUG_STRING("Major Collection Required");
 
-#ifdef FORCE_GC
-    alloc_since_last_major_GC = 0;
-#endif /* FORCE_GC */
+    allocd_since_last_major_GC = 0;
 
     stat_startGC(0);
 
     alloc = (appelInfo.oldlim - appelInfo.oldbase) + 1;
 
 
     stat_startGC(0);
 
     alloc = (appelInfo.oldlim - appelInfo.oldbase) + 1;
 
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data */
-    if (SM_stats_verbose) {
-       promote = appelInfo.oldlim - thisbase + 1;
-    }
-#endif /* PROMOTION_DATA */
-
     appelInfo.bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
                          /* For some reason, this doesn't seem to use the last
     appelInfo.bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
                          /* For some reason, this doesn't seem to use the last
@@ -691,63 +608,6 @@ collectHeap(reqsize, sm, do_full_collection)
 
     LinkCAFs(appelInfo.OldCAFlist);
 
 
     LinkCAFs(appelInfo.OldCAFlist);
 
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data */
-    /* What does this have to do with CAFs? -- JSM */
-    if (SM_stats_verbose) {
-       base[0] = thisbase;
-       base[1] = prevbase;
-
-       if (SM_trace) {
-           fprintf(stderr, "Promote Bases: lim 0x%lx this 0x%lx prev 0x%lx Actual: ",
-                   appelInfo.oldlim + 1, thisbase, prevbase);
-       }
-       
-       /* search for first live closure for thisbase & prevbase */
-       for (root = 0; root < 2; root++) {
-           P_ baseptr, search, scan_w_start;
-           I_ prev_words, bit_words, bit_rem;
-           BitWord *bit_array_ptr, *bit_array_end;
-           
-           baseptr = base[root];
-           prev_words = (baseptr - appelInfo.oldbase);
-           bit_words  = prev_words / BITS_IN(BitWord);
-           bit_rem    = prev_words & (BITS_IN(BitWord) - 1);
-           
-           bit_array_ptr = appelInfo.bits + bit_words;
-           bit_array_end = appelInfo.bits + appelInfo.bit_words;
-           scan_w_start  = baseptr - bit_rem;
-           
-           baseptr = 0;
-           while (bit_array_ptr < bit_array_end && !baseptr) {
-               BitWord w = *(bit_array_ptr++);
-               search = scan_w_start;
-               if (bit_rem) {
-                   search += bit_rem;
-                   w >>= bit_rem;
-                   bit_rem = 0;                
-               }
-               while (w && !baseptr) {
-                   if (w & 0x1) {     /* bit set -- found first closure */
-                       baseptr = search;
-                   } else {
-                       search++;      /* look at next bit */
-                       w >>= 1;
-                   }
-               }
-               scan_w_start += BITS_IN(BitWord);
-           }
-           if (SM_trace) {
-               fprintf(stderr, "0x%lx%s", baseptr, root == 2 ? "\n" : " ");
-           }
-           
-           base[root] = baseptr;
-           if (baseptr) {
-               LINK_LOCATION_TO_CLOSURE(base + root);
-           }
-       }
-    }
-#endif /* PROMOTION_DATA */
-
     LinkRoots( sm->roots, sm->rootno );
 #ifdef CONCURRENT
     LinkSparks();
     LinkRoots( sm->roots, sm->rootno );
 #ifdef CONCURRENT
     LinkSparks();
@@ -785,7 +645,7 @@ collectHeap(reqsize, sm, do_full_collection)
 
     /* set major threshold, if not fixed */
     /* next major collection when old gen occupies 2/3rds of the free space or exceeds oldmax */
 
     /* set major threshold, if not fixed */
     /* next major collection when old gen occupies 2/3rds of the free space or exceeds oldmax */
-    if (! SM_major_gen_size) {
+    if (! RTSflags.GcFlags.specifiedOldGenSize) {
        appelInfo.oldthresh = appelInfo.oldlim + (appelInfo.newlim - appelInfo.oldlim) * 2 / 3;
        if (appelInfo.oldthresh > appelInfo.oldmax)
            appelInfo.oldthresh = appelInfo.oldmax;
        appelInfo.oldthresh = appelInfo.oldlim + (appelInfo.newlim - appelInfo.oldlim) * 2 / 3;
        if (appelInfo.oldthresh > appelInfo.oldmax)
            appelInfo.oldthresh = appelInfo.oldmax;
@@ -794,70 +654,37 @@ collectHeap(reqsize, sm, do_full_collection)
     sm->hp = hp_start = appelInfo.newbase - 1;
     sm->hplim = appelInfo.newlim;
     
     sm->hp = hp_start = appelInfo.newbase - 1;
     sm->hplim = appelInfo.newlim;
     
-#if defined(FORCE_GC)
-        if (force_GC && (sm->hplim > sm->hp + GCInterval)) {
-              sm->hplim = sm->hp + GCInterval;
-        }
-#endif /* FORCE_GC */
+    if (RTSflags.GcFlags.forceGC
+     && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
+       sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
+    }
 
     sm->OldLim = appelInfo.oldlim;
 
 
     sm->OldLim = appelInfo.oldlim;
 
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data */
-    if (SM_stats_verbose) {
-       /* restore moved thisbase & prevbase */
-       thisbase = base[0] ? base[0] : appelInfo.oldlim + 1;
-       prevbase = base[1] ? base[1] : appelInfo.oldlim + 1;
-
-       /* here are the numbers we want */
-       dead_prom = promote - (appelInfo.oldlim + 1 - thisbase);
-       dead_prev = prev_prom - (thisbase - prevbase) - dead_prev_prom;
-
-       if (SM_trace) {
-           fprintf(stderr, "Collect Bases: lim 0x%lx this 0x%lx prev 0x%lx\n",
-                   appelInfo.oldlim + 1, thisbase, prevbase);
-           fprintf(stderr, "Promoted: %ld Dead: this %ld prev %ld + %ld\n",
-                   promote, dead_prom, dead_prev_prom, dead_prev);
-       }
-
-       /* save values for next collection */
-       prev_prom = promote;
-       dead_prev_prom = dead_prom;
-       prevbase = thisbase;
-       thisbase = appelInfo.oldlim + 1;
-    }
-#endif /* PROMOTION_DATA */
-
 #ifdef HAVE_VADVISE
     vadvise(VA_NORM);
 #endif
 
 #ifdef HAVE_VADVISE
     vadvise(VA_NORM);
 #endif
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char major_str[BIG_STRING_LEN];
 #ifndef PAR
        char major_str[BIG_STRING_LEN];
 #ifndef PAR
-       sprintf(major_str, "%4u %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
-               (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
+       sprintf(major_str, "%4lu %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
+               (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
                bstk_roots, sm->rootno, appelInfo.OldCAFno,
                bstk_roots, sm->rootno, appelInfo.OldCAFno,
-               0, 0, resident / (StgFloat) SM_word_heap_size * 100);
+               0, 0, resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 #else
        /* ToDo: come up with some interesting statistics for the parallel world */
        sprintf(major_str, "%4u %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
                0, 0L, sm->rootno, appelInfo.OldCAFno, 0, 0,
 #else
        /* ToDo: come up with some interesting statistics for the parallel world */
        sprintf(major_str, "%4u %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
                0, 0L, sm->rootno, appelInfo.OldCAFno, 0, 0,
-               resident / (StgFloat) SM_word_heap_size * 100);
+               resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 #endif
 
 #endif
 
-#if defined(PROMOTION_DATA)   /* For dead promote & premature promote data */
-       { char *promote_str[BIG_STRING_LEN];
-          sprintf(promote_str, " %6ld %6ld", dead_prom*sizeof(W_), dead_prev*sizeof(W_));
-         strcat(major_str, promote_str);
-        }
-#endif /* PROMOTION_DATA */
-
        stat_endGC(0, alloc, resident, major_str);
     } else { 
        stat_endGC(0, alloc, resident, "");
     }
 
        stat_endGC(0, alloc, resident, major_str);
     } else { 
        stat_endGC(0, alloc, resident, "");
     }
 
-    if (SM_trace) {
+    if (RTSflags.GcFlags.trace) {
        fprintf(stderr, "Major: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
                (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
                (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
        fprintf(stderr, "Major: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
                (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
                (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
index 1318021..ba9f413 100644 (file)
@@ -14,7 +14,7 @@ required if we're tail-jumping (no mini-interpreter).
 #include "SMinternal.h"
 
 #define isHeapPtr(p) \
 #include "SMinternal.h"
 
 #define isHeapPtr(p) \
-    ((p) >= heap_space && (p) < heap_space + SM_word_heap_size)
+    ((p) >= heap_space && (p) < heap_space + RTSflags.GcFlags.heapSize)
 
 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
 #define validInfoPtr(i) \
 
 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
 #define validInfoPtr(i) \
@@ -48,7 +48,7 @@ required if we're tail-jumping (no mini-interpreter).
 /* Two cases needed, depending on whether the 2-space GC is forced
    SLPJ 17 June 93 */
 #define validHeapPtr(p)                                                        \
 /* Two cases needed, depending on whether the 2-space GC is forced
    SLPJ 17 June 93 */
 #define validHeapPtr(p)                                                        \
-    (SM_force_gc == USE_2s ?                                           \
+    (RTSflags.GcFlags.force2s ?                                                \
            ((p) >= appelInfo.space[appelInfo.semi_space].base &&       \
             (p) <= appelInfo.space[appelInfo.semi_space].lim) :        \
            (((p) >= appelInfo.oldbase && (p) <= appelInfo.oldlim) ||   \
            ((p) >= appelInfo.space[appelInfo.semi_space].base &&       \
             (p) <= appelInfo.space[appelInfo.semi_space].lim) :        \
            (((p) >= appelInfo.oldbase && (p) <= appelInfo.oldlim) ||   \
index 60942d3..96c7c0e 100644 (file)
@@ -77,9 +77,7 @@ LinkSparks(STG_NO_ARGS)
 #ifdef PAR
 
 void
 #ifdef PAR
 
 void
-LinkLiveGAs(base, bits)
-P_ base;
-BitWord *bits;
+LinkLiveGAs(P_ base, BitWord *bits)
 {
     GALA *gala;
     GALA *next;
 {
     GALA *gala;
     GALA *next;
@@ -97,7 +95,7 @@ BitWord *bits;
            prev = gala;
        } else {
            /* Since we have all of the weight, this GA is no longer needed */
            prev = gala;
        } else {
            /* Since we have all of the weight, this GA is no longer needed */
-           W_ pga = PACK_GA(thisPE, gala->ga.loc.gc.slot);
+           W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
 
 #ifdef FREE_DEBUG
            fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
 
 #ifdef FREE_DEBUG
            fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
@@ -124,8 +122,7 @@ BitWord *bits;
        bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
        if (!(bits[bit_index] & bit)) {
            int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
        bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
        if (!(bits[bit_index] & bit)) {
            int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
-           W_ pga = PACK_GA(pe, gala->ga.loc.gc.slot);
-           int i;
+           W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 
            (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
            freeRemoteGA(pe, &(gala->ga));
 
            (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
            freeRemoteGA(pe, &(gala->ga));
@@ -182,14 +179,12 @@ P_ botB;                  /* stackB points to topmost update frame */
 
     DEBUG_STRING("Linking B Stack:");
     for (updateFramePtr = stackB;
 
     DEBUG_STRING("Linking B Stack:");
     for (updateFramePtr = stackB;
-      SUBTRACT_B_STK(updateFramePtr, botB) > 0;
-      /* re-initialiser given explicitly */ ) {
+        SUBTRACT_B_STK(updateFramePtr, botB) > 0;
+        updateFramePtr = GRAB_SuB(updateFramePtr)) {
 
        P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE);
 
        LINK_LOCATION_TO_CLOSURE(updateClosurePtr);
 
        P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE);
 
        LINK_LOCATION_TO_CLOSURE(updateClosurePtr);
-
-       updateFramePtr = GRAB_SuB(updateFramePtr);
     }
 }
 #endif /* not PAR */
     }
 }
 #endif /* not PAR */
@@ -197,8 +192,7 @@ P_ botB;                    /* stackB points to topmost update frame */
 
 \begin{code}
 I_
 
 \begin{code}
 I_
-CountCAFs(CAFlist)
-P_ CAFlist;
+CountCAFs(P_ CAFlist)
 {
     I_ caf_no = 0;
 
 {
     I_ caf_no = 0;
 
@@ -211,8 +205,7 @@ P_ CAFlist;
 
 \begin{code}
 void
 
 \begin{code}
 void
-LinkCAFs(CAFlist)
-P_ CAFlist;
+LinkCAFs(P_ CAFlist)
 {
     DEBUG_STRING("Linking CAF Ptr Locations:");
     while(CAFlist != NULL) {
 {
     DEBUG_STRING("Linking CAF Ptr Locations:");
     while(CAFlist != NULL) {
@@ -222,13 +215,5 @@ P_ CAFlist;
     }
 }
 
     }
 }
 
-\end{code}
-
-\begin{code}
-
-#ifdef PAR
-
-#endif /* PAR */
-
 #endif /* defined(_INFO_COMPACTING) */
 \end{code}
 #endif /* defined(_INFO_COMPACTING) */
 \end{code}
index 8740253..fdb5b55 100644 (file)
@@ -1,11 +1,14 @@
 \section[SMcompacting-header]{Header file for SMcompacting}
 
 \begin{code}
 \section[SMcompacting-header]{Header file for SMcompacting}
 
 \begin{code}
-extern void LinkRoots PROTO((P_ roots[], I_ rootno));
-extern void LinkAStack PROTO((PP_ stackA, PP_ botA));
-extern void LinkBStack PROTO((P_ stackB, P_ botB));
-extern I_ CountCAFs PROTO((P_ CAFlist));
+void LinkRoots PROTO((P_ roots[], I_ rootno));
+void LinkAStack PROTO((PP_ stackA, PP_ botA));
+void LinkBStack PROTO((P_ stackB, P_ botB));
+I_ CountCAFs   PROTO((P_ CAFlist));
 
 
-extern void LinkCAFs PROTO((P_ CAFlist));
+void LinkCAFs  PROTO((P_ CAFlist));
+#ifdef CONCURRENT
+void LinkSparks(STG_NO_ARGS);
+#endif
 \end{code}
 
 \end{code}
 
index 98b1b79..736663a 100644 (file)
@@ -53,8 +53,7 @@ do {                                        \
 
 \begin{code}
 void
 
 \begin{code}
 void
-SetCAFInfoTables( CAFlist )
-  P_ CAFlist;
+SetCAFInfoTables(P_ CAFlist)
 {
   P_ CAFptr;
 
 {
   P_ CAFptr;
 
@@ -70,9 +69,7 @@ SetCAFInfoTables( CAFlist )
 
 \begin{code}
 void
 
 \begin{code}
 void
-EvacuateRoots( roots, rootno )
-  P_ roots[];
-  I_ rootno;
+EvacuateRoots(P_ roots[], I_ rootno)
 {
   I_ root;
 
 {
   I_ root;
 
@@ -109,9 +106,7 @@ don't have a single main stack.
 \begin{code}
 #ifndef PAR
 void
 \begin{code}
 #ifndef PAR
 void
-EvacuateAStack( stackA, botA )
-  PP_ stackA;
-  PP_ botA; /* botA points to bottom-most word */
+EvacuateAStack(PP_ stackA, PP_ botA /* botA points to bottom-most word */)
 {
   PP_ stackptr;
   
 {
   PP_ stackptr;
   
@@ -165,17 +160,15 @@ EvacuateBStack( stackB, botB, roots )
 #endif /* not PAR */
 \end{code}
 
 #endif /* not PAR */
 \end{code}
 
-When we do a copying collection, we want to evacuate all of the local entries
-in the GALA table for which there are outstanding remote pointers (i.e. for
-which the weight is not MAX_GA_WEIGHT.)
+When we do a copying collection, we want to evacuate all of the local
+entries in the GALA table for which there are outstanding remote
+pointers (i.e. for which the weight is not MAX_GA_WEIGHT.)
 
 \begin{code}
 
 \begin{code}
-
 #ifdef PAR
 
 void
 #ifdef PAR
 
 void
-EvacuateLocalGAs(full)
-rtsBool full;
+EvacuateLocalGAs(rtsBool full)
 {
     GALA *gala;
     GALA *next;
 {
     GALA *gala;
     GALA *next;
@@ -196,7 +189,7 @@ rtsBool full;
            prev = gala;
        } else {
            /* Since we have all of the weight, this GA is no longer needed */
            prev = gala;
        } else {
            /* Since we have all of the weight, this GA is no longer needed */
-           W_ pga = PACK_GA(thisPE, gala->ga.loc.gc.slot);
+           W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
 
 #ifdef FREE_DEBUG
            fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
 
 #ifdef FREE_DEBUG
            fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
@@ -222,8 +215,7 @@ rtsBool full;
 EXTDATA_RO(Forward_Ref_info);
 
 void
 EXTDATA_RO(Forward_Ref_info);
 
 void
-RebuildGAtables(full)
-rtsBool full;
+RebuildGAtables(rtsBool full)
 {
     GALA *gala;
     GALA *next;
 {
     GALA *gala;
     GALA *next;
@@ -259,8 +251,7 @@ rtsBool full;
 #endif
            if (INFO_PTR(closure) != (W_) Forward_Ref_info) {
                int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
 #endif
            if (INFO_PTR(closure) != (W_) Forward_Ref_info) {
                int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
-               W_ pga = PACK_GA(pe, gala->ga.loc.gc.slot);
-               int i;
+               W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 
                (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
                freeRemoteGA(pe, &(gala->ga));
 
                (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
                freeRemoteGA(pe, &(gala->ga));
@@ -299,7 +290,7 @@ rtsBool full;
 
 \begin{code}
 void
 
 \begin{code}
 void
-Scavenge()
+Scavenge(void)
 {
   DEBUG_SCAN("Scavenging Start", Scav, "ToHp", ToHp);
   while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
 {
   DEBUG_SCAN("Scavenging Start", Scav, "ToHp", ToHp);
   while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
@@ -343,15 +334,12 @@ EvacAndScavengeCAFs( CAFlist, extra_words, roots )
        CAFptr != NULL;
        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
 
        CAFptr != NULL;
        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
 
-    EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
-    caf_roots++;
-
-    DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp);
-    while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
-    DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp);
+      EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
+      caf_roots++;
 
 
-    /* this_extra_caf_words = ToHp - this_caf_start; */
-    /* ToDo: Report individual CAF space */
+      DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp);
+      while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
+      DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp);
   }
   *extra_words = ToHp - caf_start;
   *roots = caf_roots;
   }
   *extra_words = ToHp - caf_start;
   *roots = caf_roots;
index f2fbf14..9587f72 100644 (file)
@@ -1,11 +1,15 @@
 \section[SMcopying-header]{Header file for SMcopying}
 
 \begin{code}
 \section[SMcopying-header]{Header file for SMcopying}
 
 \begin{code}
-extern void SetCAFInfoTables PROTO(( P_ CAFlist ));
-extern void EvacuateRoots PROTO(( P_ roots[], I_ rootno ));
-extern void EvacuateAStack PROTO(( PP_ stackA, PP_ botA ));
-extern void EvacuateBStack PROTO(( P_ stackB, P_ botB, I_ *roots ));
-extern void Scavenge PROTO(());
+void SetCAFInfoTables  PROTO(( P_ CAFlist ));
+void EvacuateRoots     PROTO(( P_ roots[], I_ rootno ));
+void EvacuateAStack    PROTO(( PP_ stackA, PP_ botA ));
+void EvacuateBStack    PROTO(( P_ stackB, P_ botB, I_ *roots ));
+void Scavenge (STG_NO_ARGS);
+
+#ifdef CONCURRENT
+void EvacuateSparks(STG_NO_ARGS);
+#endif
 
 #ifdef GCdu
 extern void EvacuateCAFs PROTO(( P_ CAFlist ));
 
 #ifdef GCdu
 extern void EvacuateCAFs PROTO(( P_ CAFlist ));
index abd3923..3dbbd39 100644 (file)
@@ -34,22 +34,22 @@ P_ heap_space = 0;          /* Address of first word of slab
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
 
-I_
-initHeap( sm )
-    smInfo *sm;    
+rtsBool
+initHeap(smInfo * sm)
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
 {
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
-       I_ semispaceSize = SM_word_heap_size / 2;
+       I_ semispaceSize = RTSflags.GcFlags.heapSize / 2;
 
        /* Allocate the roots space */
 
        /* Allocate the roots space */
-       sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) );
+       sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
 
        /* Allocate the heap */
 
        /* Allocate the heap */
-       heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_));
+       heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
+                                        "initHeap (heap)");
     
        dualmodeInfo.modeinfo[TWO_SPACE_BOT].heap_words =
     
        dualmodeInfo.modeinfo[TWO_SPACE_BOT].heap_words =
-           dualmodeInfo.modeinfo[TWO_SPACE_TOP].heap_words = SM_word_heap_size;
+           dualmodeInfo.modeinfo[TWO_SPACE_TOP].heap_words = RTSflags.GcFlags.heapSize;
 
        dualmodeInfo.modeinfo[TWO_SPACE_BOT].base =
            HEAP_FRAME_BASE(heap_space, semispaceSize);
 
        dualmodeInfo.modeinfo[TWO_SPACE_BOT].base =
            HEAP_FRAME_BASE(heap_space, semispaceSize);
@@ -60,15 +60,15 @@ initHeap( sm )
        dualmodeInfo.modeinfo[TWO_SPACE_TOP].lim =
            HEAP_FRAME_LIMIT(heap_space + semispaceSize, semispaceSize);
 
        dualmodeInfo.modeinfo[TWO_SPACE_TOP].lim =
            HEAP_FRAME_LIMIT(heap_space + semispaceSize, semispaceSize);
 
-       dualmodeInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
-       dualmodeInfo.bits      = (BitWord *)(heap_space + SM_word_heap_size) - dualmodeInfo.bit_words;
+       dualmodeInfo.bit_words = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
+       dualmodeInfo.bits      = (BitWord *)(heap_space + RTSflags.GcFlags.heapSize) - dualmodeInfo.bit_words;
 
        dualmodeInfo.modeinfo[COMPACTING].heap_words =
 
        dualmodeInfo.modeinfo[COMPACTING].heap_words =
-           SM_word_heap_size - dualmodeInfo.bit_words;
+           RTSflags.GcFlags.heapSize - dualmodeInfo.bit_words;
        dualmodeInfo.modeinfo[COMPACTING].base =
        dualmodeInfo.modeinfo[COMPACTING].base =
-           HEAP_FRAME_BASE(heap_space, SM_word_heap_size - dualmodeInfo.bit_words);
+           HEAP_FRAME_BASE(heap_space, RTSflags.GcFlags.heapSize - dualmodeInfo.bit_words);
        dualmodeInfo.modeinfo[COMPACTING].lim =
        dualmodeInfo.modeinfo[COMPACTING].lim =
-           HEAP_FRAME_LIMIT(heap_space, SM_word_heap_size - dualmodeInfo.bit_words);
+           HEAP_FRAME_LIMIT(heap_space, RTSflags.GcFlags.heapSize - dualmodeInfo.bit_words);
 
        stat_init("DUALMODE", "Collection", "  Mode  ");
     }
 
        stat_init("DUALMODE", "Collection", "  Mode  ");
     }
@@ -77,11 +77,12 @@ initHeap( sm )
 
     if (SM_alloc_size) {
        sm->hplim = sm->hp + SM_alloc_size;
 
     if (SM_alloc_size) {
        sm->hplim = sm->hp + SM_alloc_size;
-       SM_alloc_min = 0; /* No min; alloc size specified */
+
+       RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
 
        if (sm->hplim > dualmodeInfo.modeinfo[dualmodeInfo.mode].lim) {
            fprintf(stderr, "Not enough heap for requested alloc size\n");
 
        if (sm->hplim > dualmodeInfo.modeinfo[dualmodeInfo.mode].lim) {
            fprintf(stderr, "Not enough heap for requested alloc size\n");
-           return -1;
+           return rtsFalse;
        }
     } else {
        sm->hplim = dualmodeInfo.modeinfo[dualmodeInfo.mode].lim;
        }
     } else {
        sm->hplim = dualmodeInfo.modeinfo[dualmodeInfo.mode].lim;
@@ -93,7 +94,7 @@ initHeap( sm )
     initExtensions( sm );
 #endif /* !PAR */
 
     initExtensions( sm );
 #endif /* !PAR */
 
-    if (SM_trace) {
+    if (RTSflags.GcFlags.trace) {
        fprintf(stderr, "DUALMODE Heap: TS base, TS lim, TS base, TS lim, CM base, CM lim, CM bits, bit words\n                0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
                (W_) dualmodeInfo.modeinfo[TWO_SPACE_BOT].base,
                (W_) dualmodeInfo.modeinfo[TWO_SPACE_BOT].lim,
        fprintf(stderr, "DUALMODE Heap: TS base, TS lim, TS base, TS lim, CM base, CM lim, CM bits, bit words\n                0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
                (W_) dualmodeInfo.modeinfo[TWO_SPACE_BOT].base,
                (W_) dualmodeInfo.modeinfo[TWO_SPACE_BOT].lim,
@@ -109,7 +110,7 @@ initHeap( sm )
                (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
     }
 
                (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
     }
 
-    return 0;
+    return rtsTrue; /* OK */
 }
 
 I_
 }
 
 I_
@@ -129,7 +130,7 @@ collectHeap(reqsize, sm, do_full_collection)
     fflush(stdout);     /* Flush stdout at start of GC */
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
     fflush(stdout);     /* Flush stdout at start of GC */
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "DUALMODE Start: mode %ld, base 0x%lx, lim 0x%lx\n                      hp 0x%lx, hplim 0x%lx, req %lu\n",
                dualmodeInfo.mode,
                (W_) dualmodeInfo.modeinfo[dualmodeInfo.mode].base,
        fprintf(stderr, "DUALMODE Start: mode %ld, base 0x%lx, lim 0x%lx\n                      hp 0x%lx, hplim 0x%lx, req %lu\n",
                dualmodeInfo.mode,
                (W_) dualmodeInfo.modeinfo[dualmodeInfo.mode].base,
@@ -227,7 +228,7 @@ collectHeap(reqsize, sm, do_full_collection)
     /* Use residency to determine if a change in mode is required */
 
     resident = sm->hp - (dualmodeInfo.modeinfo[dualmodeInfo.mode].base - 1);
     /* Use residency to determine if a change in mode is required */
 
     resident = sm->hp - (dualmodeInfo.modeinfo[dualmodeInfo.mode].base - 1);
-    residency = resident / (StgFloat) SM_word_heap_size;
+    residency = resident / (StgFloat) RTSflags.GcFlags.heapSize;
     DO_MAX_RESIDENCY(resident); /* stats only */
 
     if ((start_mode == TWO_SPACE_TOP) &&
     DO_MAX_RESIDENCY(resident); /* stats only */
 
     if ((start_mode == TWO_SPACE_TOP) &&
@@ -264,7 +265,7 @@ collectHeap(reqsize, sm, do_full_collection)
     stat_endGC(alloc, dualmodeInfo.modeinfo[start_mode].heap_words,
               resident, dualmodeInfo.modeinfo[start_mode].name);
 
     stat_endGC(alloc, dualmodeInfo.modeinfo[start_mode].heap_words,
               resident, dualmodeInfo.modeinfo[start_mode].name);
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "DUALMODE Done: mode %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
                dualmodeInfo.mode,
                (W_) dualmodeInfo.modeinfo[dualmodeInfo.mode].base,
        fprintf(stderr, "DUALMODE Done: mode %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
                dualmodeInfo.mode,
                (W_) dualmodeInfo.modeinfo[dualmodeInfo.mode].base,
@@ -279,7 +280,7 @@ collectHeap(reqsize, sm, do_full_collection)
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
-    if ((SM_alloc_min > free_space) || (reqsize > free_space))
+    if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
        return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
     else 
        return GC_SUCCESS;              /* Heap OK */
        return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
     else 
        return GC_SUCCESS;              /* Heap OK */
index 0eab98b..6cf5e80 100644 (file)
@@ -51,106 +51,106 @@ See SMscav.lhc for calling convention documentation.
 
 /*** DEBUGGING MACROS ***/
 
 
 /*** DEBUGGING MACROS ***/
 
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 
 #define DEBUG_EVAC(sizevar) \
 
 #define DEBUG_EVAC(sizevar) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \
                evac, ToHp, INFO_PTR(evac), sizevar)
 
 #define DEBUG_EVAC_DYN   \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \
                evac, ToHp, INFO_PTR(evac), sizevar)
 
 #define DEBUG_EVAC_DYN   \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Dyn info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), DYN_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_TUPLE \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Dyn info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), DYN_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_TUPLE \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Tuple info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), TUPLE_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_MUTUPLE \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Tuple info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), TUPLE_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_MUTUPLE \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, MuTuple info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), MUTUPLE_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_DATA  \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, MuTuple info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), MUTUPLE_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_DATA  \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Data info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), DATA_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_BH(sizevar) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Data info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), DATA_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_BH(sizevar) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BH info 0x%lx, size %ld\n", \
                evac, ToHp, INFO_PTR(evac), sizevar)
 
 #define DEBUG_EVAC_FORWARD \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BH info 0x%lx, size %ld\n", \
                evac, ToHp, INFO_PTR(evac), sizevar)
 
 #define DEBUG_EVAC_FORWARD \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Forward 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, FORWARD_ADDRESS(evac), INFO_PTR(evac))
    
 #define DEBUG_EVAC_IND1 \
         fprintf(stderr, "Evac: Forward 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, FORWARD_ADDRESS(evac), INFO_PTR(evac))
    
 #define DEBUG_EVAC_IND1 \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_IND2 \
         fprintf(stderr, "Evac: Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_IND2 \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Indirection Done -> 0x%lx\n", evac)
 
 #define DEBUG_EVAC_PERM_IND \
         fprintf(stderr, "Evac: Indirection Done -> 0x%lx\n", evac)
 
 #define DEBUG_EVAC_PERM_IND \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Permanent Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_CAF_EVAC1 \
         fprintf(stderr, "Evac: Permanent Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_CAF_EVAC1 \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Caf 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_CAF_EVAC2 \
         fprintf(stderr, "Evac: Caf 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_CAF_EVAC2 \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Caf Done -> 0x%lx\n", evac)
 
 #define DEBUG_EVAC_CAF_RET \
         fprintf(stderr, "Evac: Caf Done -> 0x%lx\n", evac)
 
 #define DEBUG_EVAC_CAF_RET \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Caf 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_STAT \
         fprintf(stderr, "Evac: Caf 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 
 #define DEBUG_EVAC_STAT \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Static 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, evac, INFO_PTR(evac))
 
 #define DEBUG_EVAC_CONST \
         fprintf(stderr, "Evac: Static 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, evac, INFO_PTR(evac))
 
 #define DEBUG_EVAC_CONST \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: Const 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, CONST_STATIC_CLOSURE(INFO_PTR(evac)), INFO_PTR(evac))
 
 #define DEBUG_EVAC_CHARLIKE \
         fprintf(stderr, "Evac: Const 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, CONST_STATIC_CLOSURE(INFO_PTR(evac)), INFO_PTR(evac))
 
 #define DEBUG_EVAC_CHARLIKE \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: CharLike (%lx) 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, CHARLIKE_VALUE(evac), CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac)), INFO_PTR(evac))
 
 #define        DEBUG_EVAC_INTLIKE_TO_STATIC \
         fprintf(stderr, "Evac: CharLike (%lx) 0x%lx -> 0x%lx, info 0x%lx\n", \
                evac, CHARLIKE_VALUE(evac), CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac)), INFO_PTR(evac))
 
 #define        DEBUG_EVAC_INTLIKE_TO_STATIC \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Evac: IntLike to Static (%ld) 0x%lx -> 0x%lx, info 0x%lx\n", \
                INTLIKE_VALUE(evac), evac, INTLIKE_CLOSURE(INTLIKE_VALUE(evac)), INFO_PTR(evac))
 
 #define DEBUG_EVAC_TO_OLD \
         fprintf(stderr, "Evac: IntLike to Static (%ld) 0x%lx -> 0x%lx, info 0x%lx\n", \
                INTLIKE_VALUE(evac), evac, INTLIKE_CLOSURE(INTLIKE_VALUE(evac)), INFO_PTR(evac))
 
 #define DEBUG_EVAC_TO_OLD \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
        fprintf(stderr, "Old ")
 
 #define DEBUG_EVAC_TO_NEW \
        fprintf(stderr, "Old ")
 
 #define DEBUG_EVAC_TO_NEW \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
        fprintf(stderr, "New ")
 
 #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new) \
        fprintf(stderr, "New ")
 
 #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
        fprintf(stderr, "  OldRoot: 0x%lx -> Old 0x%lx (-> New 0x%lx)\n", \
                         evac, oldind, newevac)
 
 #define DEBUG_EVAC_OLDROOT_FORWARD \
        fprintf(stderr, "  OldRoot: 0x%lx -> Old 0x%lx (-> New 0x%lx)\n", \
                         evac, oldind, newevac)
 
 #define DEBUG_EVAC_OLDROOT_FORWARD \
-    if (SM_trace & 2) { \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) { \
        fprintf(stderr, "Evac: OldRoot Forward 0x%lx -> Old 0x%lx ", evac, FORWARD_ADDRESS(evac)); \
        if (! InOldGen(Scav)) fprintf(stderr, "-> New 0x%lx ", IND_CLOSURE_PTR(FORWARD_ADDRESS(evac))); \
         fprintf(stderr, "info 0x%lx\n", INFO_PTR(evac)); \
        fprintf(stderr, "Evac: OldRoot Forward 0x%lx -> Old 0x%lx ", evac, FORWARD_ADDRESS(evac)); \
        if (! InOldGen(Scav)) fprintf(stderr, "-> New 0x%lx ", IND_CLOSURE_PTR(FORWARD_ADDRESS(evac))); \
         fprintf(stderr, "info 0x%lx\n", INFO_PTR(evac)); \
@@ -158,23 +158,23 @@ See SMscav.lhc for calling convention documentation.
 
 #ifdef CONCURRENT
 #define DEBUG_EVAC_BQ \
 
 #ifdef CONCURRENT
 #define DEBUG_EVAC_BQ \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BQ info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), BQ_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_TSO(size) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BQ info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), BQ_CLOSURE_SIZE(evac))
 
 #define DEBUG_EVAC_TSO(size) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Evac TSO: 0x%lx -> 0x%lx, size %ld\n", \
                evac, ToHp, size)
 
 #define DEBUG_EVAC_STKO(a,b) \
         fprintf(stderr, "Evac TSO: 0x%lx -> 0x%lx, size %ld\n", \
                evac, ToHp, size)
 
 #define DEBUG_EVAC_STKO(a,b) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Evac StkO: 0x%lx -> 0x%lx, size %ld (A), %ld (B)\n", \
                evac, ToHp, a, b)
 
 # ifdef PAR
 #  define DEBUG_EVAC_BF \
         fprintf(stderr, "Evac StkO: 0x%lx -> 0x%lx, size %ld (A), %ld (B)\n", \
                evac, ToHp, a, b)
 
 # ifdef PAR
 #  define DEBUG_EVAC_BF \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BF info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), BF_CLOSURE_SIZE(dummy))
 # endif
         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BF info 0x%lx, size %lu\n", \
                evac, ToHp, INFO_PTR(evac), BF_CLOSURE_SIZE(dummy))
 # endif
@@ -214,7 +214,7 @@ See SMscav.lhc for calling convention documentation.
 # endif
 #endif
 
 # endif
 #endif
 
-#endif /* not _GC_DEBUG */
+#endif /* not DEBUG */
 
 
 #if defined(GCgn)
 
 
 #if defined(GCgn)
@@ -285,9 +285,7 @@ extern P_ _Evacuate_Old_to_New();
             FORWARD_ADDRESS(closure) = (W_)(forw)
 
 
             FORWARD_ADDRESS(closure) = (W_)(forw)
 
 
-P_
-_Evacuate_Old_Forward_Ref(evac)
-P_ evac;
+EVAC_FN(Old_Forward_Ref)
 {
     /* Forward ref to old generation -- just return */
     DEBUG_EVAC_FORWARD;
 {
     /* Forward ref to old generation -- just return */
     DEBUG_EVAC_FORWARD;
@@ -296,9 +294,7 @@ P_ evac;
     return(evac);
 }
 
     return(evac);
 }
 
-P_
-_Evacuate_New_Forward_Ref(evac)
-P_ evac;
+EVAC_FN(New_Forward_Ref)
 {
     /* Forward ref to new generation -- check scavenged from the old gen */
     DEBUG_EVAC_FORWARD;
 {
     /* Forward ref to new generation -- check scavenged from the old gen */
     DEBUG_EVAC_FORWARD;
@@ -311,9 +307,7 @@ P_ evac;
     return(evac);
 }
 
     return(evac);
 }
 
-P_
-_Evacuate_OldRoot_Forward(evac)
-P_ evac;
+EVAC_FN(OldRoot_Forward)
 {
     /* Forward ref to old generation root -- return old root or new gen closure */
     DEBUG_EVAC_OLDROOT_FORWARD;
 {
     /* Forward ref to old generation root -- return old root or new gen closure */
     DEBUG_EVAC_OLDROOT_FORWARD;
@@ -353,11 +347,11 @@ P_ newevac, evac;
 
     DEBUG_EVAC_OLD_TO_NEW(oldind, evac, newevac);
     
 
     DEBUG_EVAC_OLD_TO_NEW(oldind, evac, newevac);
     
-    INFO_PTR(evac) = (W_) OldRoot_Forward_Ref_info;
-    FORWARD_ADDRESS(evac) = (W_)oldind;
+    INFO_PTR(evac)          = (W_) OldRoot_Forward_Ref_info;
+    FORWARD_ADDRESS(evac)    = (W_)oldind;
            
            
-    INFO_PTR(oldind) = (W_) OldRoot_info;
-    IND_CLOSURE_PTR(oldind) = (W_) newevac;
+    INFO_PTR(oldind)         = (W_) OldRoot_info;
+    IND_CLOSURE_PTR(oldind)  = (W_) newevac;
     IND_CLOSURE_LINK(oldind) = (W_) genInfo.OldInNew;
     genInfo.OldInNew = oldind;
     genInfo.OldInNewno++;
     IND_CLOSURE_LINK(oldind) = (W_) genInfo.OldInNew;
     genInfo.OldInNew = oldind;
     genInfo.OldInNewno++;
@@ -387,9 +381,7 @@ P_ newevac, evac;
 
 /*** Real Evac Code -- simply passed closure ***/
 
 
 /*** Real Evac Code -- simply passed closure ***/
 
-#define EVAC_FN(suffix) \
-       P_ CAT2(_Evacuate_,suffix)(evac) \
-       P_ evac;
+#define EVAC_FN(suffix)        P_ CAT2(_Evacuate_,suffix)(P_ evac)
 
 /*** FORWARD REF STUFF ***/
 
 
 /*** FORWARD REF STUFF ***/
 
@@ -511,7 +503,7 @@ BIG_SPEC_EVAC_FN(12)
 
 \end{code}
 
 
 \end{code}
 
-A @SPEC_RBH@ must be at least size @MIN_UPD_SIZE@ (Who are we fooling?
+A @SPEC_RBH@ must be at least size @MIN_UPD_SIZE@ (Whom are we fooling?
 This means 2), and the first word after the fixed header is a
 @MUT_LINK@.  The second word is a pointer to a blocking queue.
 Remaining words are the same as the underlying @SPEC@ closure.  Unlike
 This means 2), and the first word after the fixed header is a
 @MUT_LINK@.  The second word is a pointer to a blocking queue.
 Remaining words are the same as the underlying @SPEC@ closure.  Unlike
@@ -527,19 +519,24 @@ turns you on.
 
 #ifdef PAR
 
 
 #ifdef PAR
 
-#define SPEC_RBH_EVAC_FN(n) \
-EVAC_FN(CAT2(RBH_,n)) \
-{ \
-    int i; \
-    START_ALLOC(n); \
-    DEBUG_EVAC(n); \
-    COPY_FIXED_HDR; \
-    for (i = 0; i < n - 1; i++) { COPY_WORD(SPEC_RBH_HS + i); } \
-    SET_FORWARD_REF(evac,ToHp); \
-    evac = ToHp; \
-    FINISH_ALLOC(n); \
-    PROMOTE_MUTABLE(evac);\
-    return(evac); \
+#define SPEC_RBH_EVAC_FN(n)                                    \
+EVAC_FN(CAT2(RBH_,n))                                          \
+{                                                              \
+    I_ count = FIXED_HS - 1;                                   \
+    I_ size  = SPEC_RBH_VHS + (n);                             \
+    START_ALLOC(size);                                                 \
+    DEBUG_EVAC(size);                                          \
+    COPY_FIXED_HDR;                                            \
+    while (++count <= size + (FIXED_HS - 1)) {                 \
+       COPY_WORD(count);                                       \
+    }                                                          \
+    SET_FORWARD_REF(evac,ToHp);                                \
+    evac = ToHp;                                               \
+    FINISH_ALLOC(size);                                                \
+                                                               \
+    PROMOTE_MUTABLE(evac);                                     \
+                                                               \
+    return(evac);                                              \
 }
 
 /* instantiate for 2--12 */
 }
 
 /* instantiate for 2--12 */
@@ -560,11 +557,12 @@ SPEC_RBH_EVAC_FN(12)
 #ifndef PAR
 EVAC_FN(MallocPtr)
 {
 #ifndef PAR
 EVAC_FN(MallocPtr)
 {
-    START_ALLOC(MallocPtr_SIZE);
-    DEBUG_EVAC(MallocPtr_SIZE);
+    I_ size = MallocPtr_SIZE;
+    START_ALLOC(size);
+    DEBUG_EVAC(size);
 
 
-#if defined(_GC_DEBUG)
-    if (SM_trace & 16) {
+#if defined(DEBUG)
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
       printf("DEBUG: Evacuating MallocPtr(%x)=<%x,_,%x,%x>", evac, evac[0], evac[2], evac[3]);
       printf(" Data = %x, Next = %x\n", 
             MallocPtr_CLOSURE_DATA(evac), MallocPtr_CLOSURE_LINK(evac) );
       printf("DEBUG: Evacuating MallocPtr(%x)=<%x,_,%x,%x>", evac, evac[0], evac[2], evac[3]);
       printf(" Data = %x, Next = %x\n", 
             MallocPtr_CLOSURE_DATA(evac), MallocPtr_CLOSURE_LINK(evac) );
@@ -577,8 +575,8 @@ EVAC_FN(MallocPtr)
     MallocPtr_CLOSURE_DATA(ToHp) = MallocPtr_CLOSURE_DATA(evac);
     MallocPtr_CLOSURE_LINK(ToHp) = MallocPtr_CLOSURE_LINK(evac);
 
     MallocPtr_CLOSURE_DATA(ToHp) = MallocPtr_CLOSURE_DATA(evac);
     MallocPtr_CLOSURE_LINK(ToHp) = MallocPtr_CLOSURE_LINK(evac);
 
-#if defined(_GC_DEBUG)
-    if (SM_trace & 16) {
+#if defined(DEBUG)
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
       printf("DEBUG: Evacuated  MallocPtr(%x)=<%x,_,%x,%x>", ToHp, ToHp[0], ToHp[2], ToHp[3]);
       printf(" Data = %x, Next = %x\n", 
             MallocPtr_CLOSURE_DATA(ToHp), MallocPtr_CLOSURE_LINK(ToHp) );
       printf("DEBUG: Evacuated  MallocPtr(%x)=<%x,_,%x,%x>", ToHp, ToHp[0], ToHp[2], ToHp[3]);
       printf(" Data = %x, Next = %x\n", 
             MallocPtr_CLOSURE_DATA(ToHp), MallocPtr_CLOSURE_LINK(ToHp) );
@@ -586,7 +584,7 @@ EVAC_FN(MallocPtr)
 #endif
 
     evac = ToHp;
 #endif
 
     evac = ToHp;
-    FINISH_ALLOC(MallocPtr_SIZE);
+    FINISH_ALLOC(size);
     return(evac);
 }
 #endif /* !PAR */
     return(evac);
 }
 #endif /* !PAR */
@@ -733,86 +731,103 @@ EVAC_FN(Data)
                Evac already contains this address -- just return   */
 /* Scavenging: Static closures should never be scavenged */
 
                Evac already contains this address -- just return   */
 /* Scavenging: Static closures should never be scavenged */
 
-P_
-_Evacuate_Static(evac)
-P_ evac;
+EVAC_FN(Static)
 {
     DEBUG_EVAC_STAT;
     return(evac);
 }
 
 {
     DEBUG_EVAC_STAT;
     return(evac);
 }
 
-void
-_Scavenge_Static(STG_NO_ARGS)
-{
-    fprintf(stderr,"Called _Scavenge_Static: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
-    abort();
-}
-
-
 /*** BLACK HOLE CODE ***/
 
 EVAC_FN(BH_U)
 {
 /*** BLACK HOLE CODE ***/
 
 EVAC_FN(BH_U)
 {
-    START_ALLOC(MIN_UPD_SIZE);
-    DEBUG_EVAC_BH(MIN_UPD_SIZE);
+    START_ALLOC(BH_U_SIZE);
+    DEBUG_EVAC_BH(BH_U_SIZE);
     COPY_FIXED_HDR;
     SET_FORWARD_REF(evac,ToHp);
     evac = ToHp;
     COPY_FIXED_HDR;
     SET_FORWARD_REF(evac,ToHp);
     evac = ToHp;
-    FINISH_ALLOC(MIN_UPD_SIZE);
+    FINISH_ALLOC(BH_U_SIZE);
     return(evac);
 }
 
 EVAC_FN(BH_N)
 {
     return(evac);
 }
 
 EVAC_FN(BH_N)
 {
-    START_ALLOC(MIN_NONUPD_SIZE);
-    DEBUG_EVAC_BH(MIN_NONUPD_SIZE);
+    START_ALLOC(BH_N_SIZE);
+    DEBUG_EVAC_BH(BH_N_SIZE);
     COPY_FIXED_HDR;
     SET_FORWARD_REF(evac,ToHp);
     evac = ToHp;
     COPY_FIXED_HDR;
     SET_FORWARD_REF(evac,ToHp);
     evac = ToHp;
-    FINISH_ALLOC(MIN_NONUPD_SIZE);
+    FINISH_ALLOC(BH_N_SIZE);
     return(evac);
 }
 
 /*** INDIRECTION CODE ***/
 
     return(evac);
 }
 
 /*** INDIRECTION CODE ***/
 
-/* Evacuation: Evacuate closure pointed to */
+/* permanent indirections first */
+#if defined(PROFILING) || defined(TICKY_TICKY)
+#undef PI
 
 
-P_
-_Evacuate_Ind(evac)
-P_ evac;
+EVAC_FN(PI) /* used for ticky in case just below... */
+{
+#ifdef TICKY_TICKY
+    if (! AllFlags.doUpdEntryCounts) {
+       DEBUG_EVAC_IND1;
+       GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
+
+       evac = (P_) IND_CLOSURE_PTR(evac);
+
+# if defined(GCgn) || defined(GCap)
+       if (evac > OldGen)  /* Only evacuate new gen with generational collector */
+           evac = EVACUATE_CLOSURE(evac);
+# else
+       evac = EVACUATE_CLOSURE(evac);
+# endif
+
+       DEBUG_EVAC_IND2;
+    } else {
+#endif
+
+       /* *not* shorting one out... */
+       START_ALLOC(IND_CLOSURE_SIZE(dummy));
+       DEBUG_EVAC_PERM_IND;
+       COPY_FIXED_HDR;
+       COPY_WORD(IND_HS);
+       SET_FORWARD_REF(evac,ToHp);
+       evac = ToHp;
+       FINISH_ALLOC(IND_CLOSURE_SIZE(dummy));
+
+#ifdef TICKY_TICKY
+    }
+#endif
+    return(evac);
+}
+#endif /* PROFILING or TICKY */
+
+EVAC_FN(Ind) /* Indirections are shorted-out; if doing weird ticky
+               stuff, we will have used *permanent* indirections
+               for overwriting updatees...
+            */
 {
     DEBUG_EVAC_IND1;
 {
     DEBUG_EVAC_IND1;
+    GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
+
     evac = (P_) IND_CLOSURE_PTR(evac);
 
     evac = (P_) IND_CLOSURE_PTR(evac);
 
-#if defined(GCgn) || defined(GCap)
+# if defined(GCgn) || defined(GCap)
     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
        evac = EVACUATE_CLOSURE(evac);
     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
        evac = EVACUATE_CLOSURE(evac);
-#else
+# else
     evac = EVACUATE_CLOSURE(evac);
     evac = EVACUATE_CLOSURE(evac);
-#endif
+# endif
 
     DEBUG_EVAC_IND2;
 
     DEBUG_EVAC_IND2;
-    return(evac);
 
     /* This will generate a stack of returns for a chain of indirections!
        However chains can only be 2 long.
 
     /* This will generate a stack of returns for a chain of indirections!
        However chains can only be 2 long.
-   */
-}
+    */
 
 
-#ifdef USE_COST_CENTRES
-#undef PI
-EVAC_FN(PI)
-{
-    START_ALLOC(MIN_UPD_SIZE);
-    DEBUG_EVAC_PERM_IND;
-    COPY_FIXED_HDR;
-    COPY_WORD(IND_HS);
-    SET_FORWARD_REF(evac,ToHp);
-    evac = ToHp;
-    FINISH_ALLOC(MIN_UPD_SIZE);
     return(evac);
 }
     return(evac);
 }
-#endif
 
 /*** SELECTORS CODE (much like an indirection) ***/
 
 
 /*** SELECTORS CODE (much like an indirection) ***/
 
@@ -830,30 +845,70 @@ EVAC_FN(PI)
    the n'th field is.
 
    ToDo: what if the constructor is a Gen thing?
    the n'th field is.
 
    ToDo: what if the constructor is a Gen thing?
+   
+   "selector_depth" stuff below: (WDP 95/12)
+
+      It is possible to have a *very* considerable number of selectors
+      all chained together, which will cause the code here to chew up
+      enormous C stack space (very deeply nested set of calls), which
+      can crash the program.
+
+      Various solutions are possible, but we opt for a simple one --
+      we run a "selector_depth" counter, and we stop doing the
+      selections if we get beyond that depth.  The main nice property
+      is that it doesn't affect (or slow down) any of the rest of the
+      GC.
+      
+      What should the depth be?  For SPARC friendliness, it should
+      probably be very small (e.g., 8 or 16), to avoid register-window
+      spillage.  However, that would increase the chances that
+      selectors are left undone and lots of junk is promoted to the
+      old generation.  So we set it quite a bit higher -- we'd like to
+      do all the selections except in the most extreme circumstances.
 */
 */
+static int selector_depth = 0;
+#define MAX_SELECTOR_DEPTH 100 /* reasonably arbitrary */
+
 static P_
 static P_
-_EvacuateSelector_n(evac, n)
-  P_ evac;
-  I_ n;
+_EvacuateSelector_n(P_ evac, I_ n)
 {
     P_ maybe_con = (P_) evac[_FHS];
 
     /* must be a SPEC 2 1 closure */
     ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */
 
 {
     P_ maybe_con = (P_) evac[_FHS];
 
     /* must be a SPEC 2 1 closure */
     ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */
 
-#if defined(_GC_DEBUG)
-    if (SM_trace & 2)
-        fprintf(stderr, "Evac Selector: 0x%lx, info 0x%lx, maybe_con 0x%lx, info 0x%lx, tag %ld\n",
-               evac, INFO_PTR(evac), maybe_con,
+#ifdef TICKY_TICKY
+    /* if a thunk, its update-entry count must be zero */
+    ASSERT(TICKY_HDR(evac) == 0);
+#endif
+
+    selector_depth++; /* see story above */
+
+#if defined(DEBUG)
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC)
+        fprintf(stderr, "Evac Selector (depth %ld): 0x%lx, info 0x%lx, maybe_con 0x%lx, info 0x%lx, tag %ld\n",
+               selector_depth, evac, INFO_PTR(evac), maybe_con,
                INFO_PTR(maybe_con), INFO_TAG(INFO_PTR(maybe_con)));
 #endif
 
                INFO_PTR(maybe_con), INFO_TAG(INFO_PTR(maybe_con)));
 #endif
 
-    if (INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */
+    if (INFO_TAG(INFO_PTR(maybe_con)) < 0   /* not in WHNF */
+#if !defined(CONCURRENT)
+        || (! RTSflags.GcFlags.lazyBlackHoling) /* see "price of laziness" paper */
+#endif
+       || selector_depth > MAX_SELECTOR_DEPTH
+       || (! RTSflags.GcFlags.doSelectorsAtGC)
+       ) {
+#ifdef TICKY_TICKY
+         if (INFO_TAG(INFO_PTR(maybe_con)) >= 0) { /* we *could* have done it */
+            GC_SEL_ABANDONED();
+         }
+#endif
          /* Evacuate as normal (it is size *2* because of MIN_UPD_SIZE) */
          return( _Evacuate_2(evac) );
          /* Evacuate as normal (it is size *2* because of MIN_UPD_SIZE) */
          return( _Evacuate_2(evac) );
+    }
 
 
-#if defined(_GC_DEBUG)
-    if (SM_trace & 2)
+#if defined(DEBUG)
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC)
         fprintf(stderr, "Evac Selector:shorting: 0x%lx -> 0x%lx\n",
                evac, maybe_con[_FHS + n]);
 #endif
         fprintf(stderr, "Evac Selector:shorting: 0x%lx -> 0x%lx\n",
                evac, maybe_con[_FHS + n]);
 #endif
@@ -861,6 +916,8 @@ _EvacuateSelector_n(evac, n)
     /* Ha!  Short it out */
     evac = (P_) (maybe_con[_FHS + n]); /* evac now has the result of the selection */
 
     /* Ha!  Short it out */
     evac = (P_) (maybe_con[_FHS + n]); /* evac now has the result of the selection */
 
+    GC_SEL_MINOR(); /* ticky-ticky */
+
 #if defined(GCgn) || defined(GCap)
     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
        evac = EVACUATE_CLOSURE(evac);
 #if defined(GCgn) || defined(GCap)
     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
        evac = EVACUATE_CLOSURE(evac);
@@ -868,6 +925,8 @@ _EvacuateSelector_n(evac, n)
     evac = EVACUATE_CLOSURE(evac);
 #endif
 
     evac = EVACUATE_CLOSURE(evac);
 #endif
 
+    selector_depth--; /* see story above */
+
     return(evac);
 }
 
     return(evac);
 }
 
@@ -893,7 +952,7 @@ DEF_SEL_EVAC(12)
 #ifdef CONCURRENT
 EVAC_FN(BQ)
 {
 #ifdef CONCURRENT
 EVAC_FN(BQ)
 {
-    START_ALLOC(MIN_UPD_SIZE);
+    START_ALLOC(BQ_CLOSURE_SIZE(dummy));
     DEBUG_EVAC_BQ;
 
     COPY_FIXED_HDR;
     DEBUG_EVAC_BQ;
 
     COPY_FIXED_HDR;
@@ -901,7 +960,7 @@ EVAC_FN(BQ)
 
     SET_FORWARD_REF(evac,ToHp);
     evac = ToHp;
 
     SET_FORWARD_REF(evac,ToHp);
     evac = ToHp;
-    FINISH_ALLOC(MIN_UPD_SIZE);
+    FINISH_ALLOC(BQ_CLOSURE_SIZE(dummy));
 
     /* Add to OldMutables list (if evacuated to old generation) */
     PROMOTE_MUTABLE(evac);
 
     /* Add to OldMutables list (if evacuated to old generation) */
     PROMOTE_MUTABLE(evac);
@@ -912,9 +971,10 @@ EVAC_FN(BQ)
 EVAC_FN(TSO)
 {
     I_ count;
 EVAC_FN(TSO)
 {
     I_ count;
+    I_ size = TSO_VHS + TSO_CTS_SIZE;
 
 
-    START_ALLOC(TSO_VHS + TSO_CTS_SIZE);
-    DEBUG_EVAC_TSO(TSO_VHS + TSO_CTS_SIZE);
+    START_ALLOC(size);
+    DEBUG_EVAC_TSO(size);
 
     COPY_FIXED_HDR;
     for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
 
     COPY_FIXED_HDR;
     for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
@@ -925,7 +985,7 @@ EVAC_FN(TSO)
 
     SET_FORWARD_REF(evac, ToHp);
     evac = ToHp;
 
     SET_FORWARD_REF(evac, ToHp);
     evac = ToHp;
-    FINISH_ALLOC(TSO_VHS + TSO_CTS_SIZE);
+    FINISH_ALLOC(size);
 
     /* Add to OldMutables list (if evacuated to old generation) */
     PROMOTE_MUTABLE(evac);
 
     /* Add to OldMutables list (if evacuated to old generation) */
     PROMOTE_MUTABLE(evac);
@@ -936,17 +996,19 @@ EVAC_FN(TSO)
 EVAC_FN(StkO)
 {
     I_ count;
 EVAC_FN(StkO)
 {
     I_ count;
-    I_ size  = STKO_CLOSURE_SIZE(evac);
+    I_ size       = STKO_CLOSURE_SIZE(evac);
     I_ spa_offset = STKO_SpA_OFFSET(evac);
     I_ spb_offset = STKO_SpB_OFFSET(evac);
     I_ sub_offset = STKO_SuB_OFFSET(evac);
     I_ offset;
 
     I_ spa_offset = STKO_SpA_OFFSET(evac);
     I_ spb_offset = STKO_SpB_OFFSET(evac);
     I_ sub_offset = STKO_SuB_OFFSET(evac);
     I_ offset;
 
+    ASSERT(sanityChk_StkO(evac));
+
     START_ALLOC(size);
     DEBUG_EVAC_STKO(STKO_CLOSURE_CTS_SIZE(evac) - spa_offset + 1, spb_offset);
 
     COPY_FIXED_HDR;
     START_ALLOC(size);
     DEBUG_EVAC_STKO(STKO_CLOSURE_CTS_SIZE(evac) - spa_offset + 1, spb_offset);
 
     COPY_FIXED_HDR;
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
     COPY_WORD(STKO_ADEP_LOCN);
     COPY_WORD(STKO_BDEP_LOCN);
 #endif
     COPY_WORD(STKO_ADEP_LOCN);
     COPY_WORD(STKO_BDEP_LOCN);
 #endif
@@ -1018,8 +1080,9 @@ EVAC_FN(FetchMe)
 EVAC_FN(BF)
 {
     I_ count;
 EVAC_FN(BF)
 {
     I_ count;
+    I_ size = BF_CLOSURE_SIZE(evac);
 
 
-    START_ALLOC(BF_CLOSURE_SIZE(evac));
+    START_ALLOC(size);
     DEBUG_EVAC_BF;
 
     COPY_FIXED_HDR;
     DEBUG_EVAC_BF;
 
     COPY_FIXED_HDR;
@@ -1034,7 +1097,7 @@ EVAC_FN(BF)
 
     SET_FORWARD_REF(evac, ToHp);
     evac = ToHp;
 
     SET_FORWARD_REF(evac, ToHp);
     evac = ToHp;
-    FINISH_ALLOC(BF_CLOSURE_SIZE(evac));
+    FINISH_ALLOC(size);
 
     /* Add to OldMutables list (if evacuated to old generation) */
     PROMOTE_MUTABLE(evac);
 
     /* Add to OldMutables list (if evacuated to old generation) */
     PROMOTE_MUTABLE(evac);
@@ -1047,30 +1110,28 @@ EVAC_FN(BF)
 /*** SPECIAL CAF CODE ***/
 
 /* Evacuation: Return closure pointed to (already explicitly evacuated) */
 /*** SPECIAL CAF CODE ***/
 
 /* Evacuation: Return closure pointed to (already explicitly evacuated) */
-/* Scavenging: Should not be scavenged */  
 
 
-P_
-_Evacuate_Caf(evac)
-P_ evac;
+EVAC_FN(Caf)
 {
     DEBUG_EVAC_CAF_RET;
 {
     DEBUG_EVAC_CAF_RET;
+    GC_SHORT_CAF(); /* ticky: record that we shorted an indirection */
+
     evac = (P_) IND_CLOSURE_PTR(evac);
     return(evac);
 }
 
 /* In addition we need an internal Caf indirection which evacuates,
     evac = (P_) IND_CLOSURE_PTR(evac);
     return(evac);
 }
 
 /* In addition we need an internal Caf indirection which evacuates,
-   updates and returns the indirection. Before GC is started the
+   updates and returns the indirection. Before GC is started, the
    @CAFlist@ must be traversed and the info tables set to this.
 */
 
    @CAFlist@ must be traversed and the info tables set to this.
 */
 
-P_
-_Evacuate_Caf_Evac_Upd(evac)
-  P_ evac;
+EVAC_FN(Caf_Evac_Upd)
 {
     P_ closure = evac;
 
     DEBUG_EVAC_CAF_EVAC1;
 {
     P_ closure = evac;
 
     DEBUG_EVAC_CAF_EVAC1;
-    INFO_PTR(evac) = (W_) Caf_info;            /* Change to return CAF */
+
+    INFO_PTR(evac) = (W_) Caf_info;    /* Change back to Caf_info */
 
     evac = (P_) IND_CLOSURE_PTR(evac);          /* Grab reference and evacuate */
 
 
     evac = (P_) IND_CLOSURE_PTR(evac);          /* Grab reference and evacuate */
 
@@ -1095,44 +1156,56 @@ _Evacuate_Caf_Evac_Upd(evac)
 /*** CONST CLOSURE CODE ***/
 
 /* Evacuation: Just return address of the static closure stored in the info table */
 /*** CONST CLOSURE CODE ***/
 
 /* Evacuation: Just return address of the static closure stored in the info table */
-/* Scavenging: Const closures should never be scavenged */
 
 
-P_
-_Evacuate_Const(evac)
-P_ evac;
+EVAC_FN(Const)
 {
 {
+#ifdef TICKY_TICKY
+     if (AllFlags.doUpdEntryCounts) {
+       /* evacuate as if a closure of size 0
+          (there is no _Evacuate_0 to call)
+       */
+       START_ALLOC(0);
+       DEBUG_EVAC(0);
+       COPY_FIXED_HDR;
+       SET_FORWARD_REF(evac,ToHp);
+       evac = ToHp;
+       FINISH_ALLOC(0);
+
+     } else {
+#endif
+
     DEBUG_EVAC_CONST;
     DEBUG_EVAC_CONST;
+    GC_COMMON_CONST(); /* ticky */
+
     evac = CONST_STATIC_CLOSURE(INFO_PTR(evac));
     evac = CONST_STATIC_CLOSURE(INFO_PTR(evac));
-    return(evac);
-}
 
 
-void
-_Scavenge_Const(STG_NO_ARGS)
-{
-    fprintf(stderr,"Called _Scavenge_Const: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
-    abort();
+#ifdef TICKY_TICKY
+    }
+#endif
+    return(evac);
 }
 
 }
 
-
 /*** CHARLIKE CLOSURE CODE ***/
 
 /* Evacuation: Just return address of the static closure stored fixed array */
 /*** CHARLIKE CLOSURE CODE ***/
 
 /* Evacuation: Just return address of the static closure stored fixed array */
-/* Scavenging: CharLike closures should never be scavenged */
 
 
-P_
-_Evacuate_CharLike(evac)
-P_ evac;
+EVAC_FN(CharLike)
 {
 {
+#ifdef TICKY_TICKY
+     if (AllFlags.doUpdEntryCounts) {
+       evac = _Evacuate_1(evac);  /* evacuate closure of size 1 */
+     } else {
+#endif
+
     DEBUG_EVAC_CHARLIKE;
     DEBUG_EVAC_CHARLIKE;
+    GC_COMMON_CHARLIKE(); /* ticky */
+
     evac = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac));
     evac = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac));
-    return(evac);
-}
 
 
-void
-_Scavenge_CharLike(STG_NO_ARGS)
-{
-    fprintf(stderr,"Called _Scavenge_CharLike: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
-    abort();
+#ifdef TICKY_TICKY
+    }
+#endif
+    return(evac);
 }
 \end{code}
 
 }
 \end{code}
 
@@ -1141,8 +1214,6 @@ _Scavenge_CharLike(STG_NO_ARGS)
 Evacuation: Return address of the static closure if available
 Otherwise evacuate converting to aux closure.
 
 Evacuation: Return address of the static closure if available
 Otherwise evacuate converting to aux closure.
 
-Scavenging: IntLike closures should never be scavenged.
-
 There are some tricks here:
 \begin{enumerate}
 \item
 There are some tricks here:
 \begin{enumerate}
 \item
@@ -1158,19 +1229,25 @@ EVAC_FN(IntLike)
 {
     I_ val = INTLIKE_VALUE(evac);
  
 {
     I_ val = INTLIKE_VALUE(evac);
  
-    if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {   /* in range of static closures */
+    if (val >= MIN_INTLIKE   /* in range of static closures */
+     && val <= MAX_INTLIKE
+#ifdef TICKY_TICKY
+     && !AllFlags.doUpdEntryCounts
+#endif
+       ) {
        DEBUG_EVAC_INTLIKE_TO_STATIC;
        DEBUG_EVAC_INTLIKE_TO_STATIC;
-       evac = (P_) INTLIKE_CLOSURE(val);             /* return appropriate static closure */
+       GC_COMMON_INTLIKE(); /* ticky */
+
+       evac = (P_) INTLIKE_CLOSURE(val); /* return appropriate static closure */
     }
     else {
     }
     else {
-       START_ALLOC(1);                                   /* evacuate closure of size 1 */
-       DEBUG_EVAC(1);
-       COPY_FIXED_HDR;
-       SPEC_COPY_FREE_VAR(1);
-       SET_FORWARD_REF(evac,ToHp);
-       evac = ToHp;
-       FINISH_ALLOC(1);
+       evac = _Evacuate_1(evac); /* evacuate closure of size 1 */
+
+#ifdef TICKY_TICKY
+       if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL();
+#endif
     }
     }
+
     return(evac);
 }
 
     return(evac);
 }
 
index bd39ae4..48e024d 100644 (file)
@@ -63,7 +63,7 @@ TrashMem(from, to)
 {
 /* assertion overly strong - if free_mem == 0, sm->hp == sm->hplim */
 /*  ASSERT( from <= to ); */
 {
 /* assertion overly strong - if free_mem == 0, sm->hp == sm->hplim */
 /*  ASSERT( from <= to ); */
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        printf("Trashing from 0x%lx to 0x%lx inclusive\n", (W_) from, (W_) to);
     while (from <= to) {
        *from++ = DEALLOCATED_TRASH;
        printf("Trashing from 0x%lx to 0x%lx inclusive\n", (W_) from, (W_) to);
     while (from <= to) {
        *from++ = DEALLOCATED_TRASH;
@@ -113,10 +113,11 @@ themselves, we'll trash its contents when we're done with it.
 void
 Trash_MallocPtr_Closure(mptr)
   P_ mptr;
 void
 Trash_MallocPtr_Closure(mptr)
   P_ mptr;
-{ int i;
-  for( i = 0; i != MallocPtr_SIZE + _FHS; i++ ) {
-    mptr[ i ] = DEALLOCATED_TRASH;
-  }
+{
+    int i;
+    for( i = 0; i < MallocPtr_SIZE + _FHS; i++ ) {
+      mptr[ i ] = DEALLOCATED_TRASH;
+    }
 }
 \end{code}
 
 }
 \end{code}
 
@@ -160,7 +161,7 @@ void
 Trace_MallocPtr( MPptr )
   P_ MPptr;
 {
 Trace_MallocPtr( MPptr )
   P_ MPptr;
 {
-  if (SM_trace & 16) {
+  if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
     printf("DEBUG: MallocPtr(%lx)=<%lx,_,%lx,%lx,%lx>\n", (W_) MPptr, (W_) MPptr[0], (W_) MPptr[1], (W_) MPptr[2], (W_) MPptr[3]);
     printf(" Data = %lx, Next = %lx\n", 
        (W_) MallocPtr_CLOSURE_DATA(MPptr), (W_) MallocPtr_CLOSURE_LINK(MPptr) );
     printf("DEBUG: MallocPtr(%lx)=<%lx,_,%lx,%lx,%lx>\n", (W_) MPptr, (W_) MPptr[0], (W_) MPptr[1], (W_) MPptr[2], (W_) MPptr[3]);
     printf(" Data = %lx, Next = %lx\n", 
        (W_) MallocPtr_CLOSURE_DATA(MPptr), (W_) MallocPtr_CLOSURE_LINK(MPptr) );
@@ -170,7 +171,7 @@ Trace_MallocPtr( MPptr )
 void
 Trace_MPdies()
 {
 void
 Trace_MPdies()
 {
-  if (SM_trace & 16) {
+  if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
     printf(" dying\n");
   }
 }
     printf(" dying\n");
   }
 }
@@ -178,8 +179,8 @@ Trace_MPdies()
 void
 Trace_MPlives()
 {
 void
 Trace_MPlives()
 {
-  if (SM_trace & 16) { 
-    printf(" lived to tell the tale \n"); 
+  if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { 
+    printf(" lived to tell the tale\n"); 
   }
 }
 
   }
 }
 
@@ -187,7 +188,7 @@ void
 Trace_MPforwarded( MPPtr, newAddress )
   P_ MPPtr, newAddress;
 {
 Trace_MPforwarded( MPPtr, newAddress )
   P_ MPPtr, newAddress;
 {
-  if (SM_trace & 16) {
+  if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
     printf(" forwarded to %lx\n", (W_) newAddress);
   }
 }
     printf(" forwarded to %lx\n", (W_) newAddress);
   }
 }
index ed2e3a8..4c096a0 100644 (file)
@@ -3,38 +3,36 @@
 \begin{code}
 #ifndef PAR
 
 \begin{code}
 #ifndef PAR
 
-extern void initExtensions PROTO((smInfo *sm));
+void initExtensions PROTO((smInfo *sm));
 
 
-#if defined(_INFO_COPYING)
+# if defined(_INFO_COPYING)
 
 
-extern void evacSPTable PROTO((smInfo *sm));
-extern void reportDeadMallocPtrs PROTO((StgPtr oldMPList, StgPtr new, StgPtr *newMPLust));
+void evacSPTable PROTO((smInfo *sm));
+void reportDeadMallocPtrs PROTO((StgPtr oldMPList, StgPtr new, StgPtr *newMPLust));
 
 
-#endif /* _INFO_COPYING */
+# endif /* _INFO_COPYING */
 
 
-#if defined(_INFO_COMPACTING)
+# if defined(_INFO_COMPACTING)
 
 
-extern void sweepUpDeadMallocPtrs PROTO((
-                                        P_ MallocPtrList,
-                                        P_ base,
-                                        BitWord *bits
-                                        ));
+void sweepUpDeadMallocPtrs PROTO((P_ MallocPtrList,
+                                 P_ base,
+                                 BitWord *bits
+                               ));
 
 
-#endif /* _INFO_COMPACTING */
+# endif /* _INFO_COMPACTING */
 
 
-extern void TrashMem PROTO(( P_ from, P_ to ));
+void TrashMem PROTO(( P_ from, P_ to ));
 
 
-#if defined(DEBUG)
+# if defined(DEBUG)
 
 
-extern void Trash_MallocPtr_Closure PROTO((P_ mptr));
-extern void Validate_MallocPtrList PROTO(( P_ MallocPtrList ));
+void Trash_MallocPtr_Closure PROTO((P_ mptr));
+void Validate_MallocPtrList PROTO(( P_ MallocPtrList ));
 
 
-extern void Trace_MPdies  PROTO((void));
-extern void Trace_MPlives PROTO((void));
-extern void Trace_MPforwarded PROTO(( P_ MPPtr, P_ newAddress ));
+void Trace_MPdies  PROTO((void));
+void Trace_MPlives PROTO((void));
+void Trace_MPforwarded PROTO(( P_ MPPtr, P_ newAddress ));
 
 
-
-#endif /* DEBUG */
+# endif /* DEBUG */
 
 #endif /* !PAR */
 \end{code}
 
 #endif /* !PAR */
 \end{code}
index 302ee64..d539149 100644 (file)
@@ -57,9 +57,8 @@ P_ heap_space = 0;            /* Address of first word of slab
 P_ hp_start;           /* Value of Hp when reduction was resumed */
                                 /* Always allocbase - 1 */
 
 P_ hp_start;           /* Value of Hp when reduction was resumed */
                                 /* Always allocbase - 1 */
 
-I_
-initHeap( sm )
-    smInfo *sm;    
+rtsBool
+initHeap(smInfo * sm)
 {
     I_ heap_error = 0;
     I_ bit_words;
 {
     I_ heap_error = 0;
     I_ bit_words;
@@ -70,12 +69,13 @@ initHeap( sm )
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
        /* Allocate the roots space */
     if (heap_space == 0) { /* allocates if it doesn't already exist */
 
        /* Allocate the roots space */
-       sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) );
+       sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
 
        /* Allocate the heap */
 
        /* Allocate the heap */
-       heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_));
+       heap_space = (P_) stgMallocWords(SM_word_heap_size + EXTRA_HEAP_WORDS,
+                                        "initHeap (heap)");
 
 
-       if (SM_force_gc == USE_2s) {
+       if (RTSflags.GcFlags.force2s) {
            stat_init("TWOSPACE(GEN)",
                      " No of Roots  Caf   Caf    Astk   Bstk",
                      "Astk Bstk Reg  No  bytes  bytes  bytes");
            stat_init("TWOSPACE(GEN)",
                      " No of Roots  Caf   Caf    Astk   Bstk",
                      "Astk Bstk Reg  No  bytes  bytes  bytes");
@@ -86,8 +86,8 @@ initHeap( sm )
        }
     }
 
        }
     }
 
-    if (SM_force_gc == USE_2s) {
-       genInfo.semi_space = SM_word_heap_size / 2;
+    if (RTSflags.GcFlags.force2s) {
+       genInfo.semi_space = RTSflags.GcFlags.heapSize / 2;
        genInfo.space[0].base = HEAP_FRAME_BASE(heap_space, genInfo.semi_space);
        genInfo.space[1].base = HEAP_FRAME_BASE(heap_space + genInfo.semi_space, genInfo.semi_space);
        genInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, genInfo.semi_space);
        genInfo.space[0].base = HEAP_FRAME_BASE(heap_space, genInfo.semi_space);
        genInfo.space[1].base = HEAP_FRAME_BASE(heap_space + genInfo.semi_space, genInfo.semi_space);
        genInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, genInfo.semi_space);
@@ -97,16 +97,17 @@ initHeap( sm )
 
        sm->hp = hp_start = genInfo.space[genInfo.semi_space].base - 1;
 
 
        sm->hp = hp_start = genInfo.space[genInfo.semi_space].base - 1;
 
-       if (SM_alloc_size) {
-           sm->hplim = sm->hp + SM_alloc_size;
-           SM_alloc_min = 0; /* No min; alloc size specified */
+       if (! RTSflags.GcFlags.allocAreaSizeGiven) {
+           sm->hplim = genInfo.space[genInfo.semi_space].lim;
+       } else {
+           sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
+
+           RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
 
            if (sm->hplim > genInfo.space[genInfo.semi_space].lim) {
                fprintf(stderr, "Not enough heap for requested alloc size\n");
 
            if (sm->hplim > genInfo.space[genInfo.semi_space].lim) {
                fprintf(stderr, "Not enough heap for requested alloc size\n");
-               return -1;
+               return rtsFalse;
            }
            }
-       } else {
-           sm->hplim = genInfo.space[genInfo.semi_space].lim;
        }
 
        sm->OldLim = genInfo.oldlim;
        }
 
        sm->OldLim = genInfo.oldlim;
@@ -116,25 +117,23 @@ initHeap( sm )
        initExtensions( sm );
 #endif
 
        initExtensions( sm );
 #endif
 
-       if (SM_trace) {
+       if (RTSflags.GcFlags.trace) {
            fprintf(stderr, "GEN(2s) Heap: 0x%lx .. 0x%lx\n",
            fprintf(stderr, "GEN(2s) Heap: 0x%lx .. 0x%lx\n",
-                   (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size));
+                   (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
            fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %ld\n",
                    genInfo.semi_space,
                    (W_) genInfo.space[genInfo.semi_space].base,
                    (W_) genInfo.space[genInfo.semi_space].lim,
                    (W_) sm->hp, (W_) sm->hplim, (I_) (sm->hplim - sm->hp));
        }
            fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %ld\n",
                    genInfo.semi_space,
                    (W_) genInfo.space[genInfo.semi_space].base,
                    (W_) genInfo.space[genInfo.semi_space].lim,
                    (W_) sm->hp, (W_) sm->hplim, (I_) (sm->hplim - sm->hp));
        }
-       return 0;
+       return rtsTrue;
     }
 
     }
 
-    if (SM_alloc_size == 0) SM_alloc_size = DEFAULT_ALLOC_SIZE;
-
-    genInfo.alloc_words = SM_alloc_size;
-    genInfo.new_words   = SM_alloc_size;
+    genInfo.alloc_words = RTSflags.GcFlags.allocAreaSize;
+    genInfo.new_words   = RTSflags.GcFlags.allocAreaSize;
 
 
-    genInfo.allocbase  = heap_space + SM_word_heap_size - genInfo.alloc_words;
-    genInfo.alloclim   = heap_space + SM_word_heap_size - 1;
+    genInfo.allocbase  = heap_space + RTSflags.GcFlags.heapSize - genInfo.alloc_words;
+    genInfo.alloclim   = heap_space + RTSflags.GcFlags.heapSize - 1;
 
     genInfo.newgen[0].newbase   = genInfo.allocbase - genInfo.new_words;
     genInfo.newgen[0].newlim    = genInfo.newgen[0].newbase - 1;
 
     genInfo.newgen[0].newbase   = genInfo.allocbase - genInfo.new_words;
     genInfo.newgen[0].newlim    = genInfo.newgen[0].newbase - 1;
@@ -144,8 +143,8 @@ initHeap( sm )
 
     genInfo.oldbase = heap_space;
 
 
     genInfo.oldbase = heap_space;
 
-    if (SM_major_gen_size) {
-       genInfo.old_words = SM_major_gen_size;
+    if (RTSflags.GcFlags.specifiedOldGenSize) {
+       genInfo.old_words = RTSflags.GcFlags.specifiedOldGenSize;
        genInfo.oldend    = heap_space + genInfo.old_words - 1;
        genInfo.oldthresh = genInfo.oldend - genInfo.new_words;
                                         /* ToDo: extra old ind words not accounted for ! */
        genInfo.oldend    = heap_space + genInfo.old_words - 1;
        genInfo.oldthresh = genInfo.oldend - genInfo.new_words;
                                         /* ToDo: extra old ind words not accounted for ! */
@@ -161,7 +160,7 @@ initHeap( sm )
            if (genInfo.bit_vect + bit_words >= (BitWord *) genInfo.newgen[1].newbase) heap_error = 1;
        }
     } else {
            if (genInfo.bit_vect + bit_words >= (BitWord *) genInfo.newgen[1].newbase) heap_error = 1;
        }
     } else {
-       genInfo.old_words = SM_word_heap_size - genInfo.alloc_words - 2 * genInfo.new_words;
+       genInfo.old_words = RTSflags.GcFlags.heapSize - genInfo.alloc_words - 2 * genInfo.new_words;
        genInfo.oldend    = heap_space + genInfo.old_words - 1;
        genInfo.oldthresh = genInfo.oldend - genInfo.new_words;
                                         /* ToDo: extra old ind words not accounted for ! */
        genInfo.oldend    = heap_space + genInfo.old_words - 1;
        genInfo.oldthresh = genInfo.oldend - genInfo.new_words;
                                         /* ToDo: extra old ind words not accounted for ! */
@@ -182,7 +181,7 @@ initHeap( sm )
     }
 
     if (heap_error) {
     }
 
     if (heap_error) {
-       fprintf(stderr, "initHeap: Requested heap size: %ld\n", SM_word_heap_size);
+       fprintf(stderr, "initHeap: Requested heap size: %ld\n", RTSflags.GcFlags.heapSize);
        fprintf(stderr, "          Alloc area %ld  Delay area %ld  Old area %ld  Bit area %ld\n",
                                   genInfo.alloc_words, genInfo.new_words * 2, genInfo.old_words,
                                   genInfo.bit_vect == (BitWord *) genInfo.allocbase ? 0 : bit_words);
        fprintf(stderr, "          Alloc area %ld  Delay area %ld  Old area %ld  Bit area %ld\n",
                                   genInfo.alloc_words, genInfo.new_words * 2, genInfo.old_words,
                                   genInfo.bit_vect == (BitWord *) genInfo.allocbase ? 0 : bit_words);
@@ -216,9 +215,9 @@ initHeap( sm )
     initExtensions( sm );
 #endif
 
     initExtensions( sm );
 #endif
 
-    if (SM_trace) {
+    if (RTSflags.GcFlags.trace) {
        fprintf(stderr, "GEN Heap: 0x%lx .. 0x%lx\n",
        fprintf(stderr, "GEN Heap: 0x%lx .. 0x%lx\n",
-               (W_) heap_space, (W_) (heap_space + SM_word_heap_size - 1));
+               (W_) heap_space, (W_) (heap_space + RTSflags.GcFlags.heapSize - 1));
        fprintf(stderr, "          alloc %ld, new %ld, old %ld, bit %ld\n",
                genInfo.alloc_words, genInfo.new_words, genInfo.old_words, bit_words);
        fprintf(stderr, "          allocbase 0x%lx, alloclim 0x%lx\n",
        fprintf(stderr, "          alloc %ld, new %ld, old %ld, bit %ld\n",
                genInfo.alloc_words, genInfo.new_words, genInfo.old_words, bit_words);
        fprintf(stderr, "          allocbase 0x%lx, alloclim 0x%lx\n",
@@ -249,7 +248,7 @@ collect2s(reqsize, sm)
 
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
 
     SAVE_REGS(&ScavRegDump); /* Save registers */
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, req %lu\n",
                genInfo.semi_space,
                (W_) genInfo.space[genInfo.semi_space].base,
        fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, req %lu\n",
                genInfo.semi_space,
                (W_) genInfo.space[genInfo.semi_space].base,
@@ -344,7 +343,7 @@ collect2s(reqsize, sm)
     /* DONT_DO_MAX_RESIDENCY -- because this collector is utterly hosed */
     free_space = sm->hplim - sm->hp;
 
     /* DONT_DO_MAX_RESIDENCY -- because this collector is utterly hosed */
     free_space = sm->hplim - sm->hp;
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char comment_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
        char comment_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
@@ -358,12 +357,12 @@ collect2s(reqsize, sm)
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
                0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
 #endif
        sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
                0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
 #endif
-       stat_endGC(alloc, SM_word_heap_size, resident, comment_str);
+       stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
     } else {
     } else {
-       stat_endGC(alloc, SM_word_heap_size, resident, "");
+       stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
     }
 
     }
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "Done:  space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, free %lu\n",
                genInfo.semi_space,
                (W_) genInfo.space[genInfo.semi_space].base,
        fprintf(stderr, "Done:  space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, free %lu\n",
                genInfo.semi_space,
                (W_) genInfo.space[genInfo.semi_space].base,
@@ -378,7 +377,7 @@ collect2s(reqsize, sm)
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
 
     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 
-    if ((SM_alloc_size > free_space) || (reqsize > free_space))
+    if ((RTSflags.GcFlags.allocAreaSize > free_space) || (reqsize > free_space))
        return(-1);     /* Heap exhausted */
 
     return(0);          /* Heap OK */
        return(-1);     /* Heap exhausted */
 
     return(0);          /* Heap OK */
@@ -409,7 +408,7 @@ collectHeap(reqsize, sm)
 
     fflush(stdout);     /* Flush stdout at start of GC */
 
 
     fflush(stdout);     /* Flush stdout at start of GC */
 
-    if (SM_force_gc == USE_2s) {
+    if (RTSflags.GcFlags.force2s) {
        return collect2s(reqsize, sm);
     }
 
        return collect2s(reqsize, sm);
     }
 
@@ -423,7 +422,8 @@ collectHeap(reqsize, sm)
 
     SAVE_REGS(&ScavRegDump);        /* Save registers */
 
 
     SAVE_REGS(&ScavRegDump);        /* Save registers */
 
-    if (SM_trace) fprintf(stderr, "GEN Start: hp 0x%lx, hplim 0x%lx, req %ld  Minor\n",
+    if (RTSflags.GcFlags.trace)
+       fprintf(stderr, "GEN Start: hp 0x%lx, hplim 0x%lx, req %ld  Minor\n",
                          (W_) sm->hp, (W_) sm->hplim, (I_) (reqsize * sizeof(W_)));
 
     alloc = sm->hp - hp_start;
                          (W_) sm->hp, (W_) sm->hplim, (I_) (reqsize * sizeof(W_)));
 
     alloc = sm->hp - hp_start;
@@ -632,7 +632,7 @@ collectHeap(reqsize, sm)
     sm->MallocPtrList = NULL;   /* all (new) MallocPtrs have been promoted */
 #endif /* PAR */
 
     sm->MallocPtrList = NULL;   /* all (new) MallocPtrs have been promoted */
 #endif /* PAR */
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char minor_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(minor_str, "%6lu %4lu   %4lu %4ld %3ld %3ld %4ld  %3ld %3ld %6ld   Minor",
        char minor_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(minor_str, "%6lu %4lu   %4lu %4ld %3ld %3ld %4ld  %3ld %3ld %6ld   Minor",
@@ -660,7 +660,7 @@ collectHeap(reqsize, sm)
        sm->hplim = genInfo.alloclim;
        sm->OldLim = genInfo.oldlim;
     
        sm->hplim = genInfo.alloclim;
        sm->OldLim = genInfo.oldlim;
     
-       if (SM_trace)
+       if (RTSflags.GcFlags.trace)
            fprintf(stderr, "GEN End: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %lu\n",
                    (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh,
                    (W_) genInfo.newgen[genInfo.curnew].newbase,
            fprintf(stderr, "GEN End: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %lu\n",
                    (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh,
                    (W_) genInfo.newgen[genInfo.curnew].newbase,
@@ -786,26 +786,26 @@ collectHeap(reqsize, sm)
     genInfo.oldwas = genInfo.oldlim;
     genInfo.minor_since_major = 0;
 
     genInfo.oldwas = genInfo.oldlim;
     genInfo.minor_since_major = 0;
 
-    if (SM_stats_verbose) {
+    if (RTSflags.GcFlags.giveStats) {
        char major_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(major_str, "%6d %4ld   %4u %4ld %3ld %3ld %4d  %3d %3d %6.6s  *Major* %4.1f%%",
                0, genInfo.OldInNewno,
                (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
                bstk_roots, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno,
        char major_str[BIG_STRING_LEN];
 #ifndef PAR
        sprintf(major_str, "%6d %4ld   %4u %4ld %3ld %3ld %4d  %3d %3d %6.6s  *Major* %4.1f%%",
                0, genInfo.OldInNewno,
                (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
                bstk_roots, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno,
-               0, 0, 0, "", total_resident / (StgFloat) SM_word_heap_size * 100);
+               0, 0, 0, "", total_resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 #else
        sprintf(major_str, "%6d %4ld   %4u %4ld %3ld %3ld %4d  %3d %3d %6.6s  *Major* %4.1f%%",
                0, genInfo.OldInNewno,
                0, 0, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno,
 #else
        sprintf(major_str, "%6d %4ld   %4u %4ld %3ld %3ld %4d  %3d %3d %6.6s  *Major* %4.1f%%",
                0, genInfo.OldInNewno,
                0, 0, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno,
-               0, 0, 0, "", total_resident / (StgFloat) SM_word_heap_size * 100);
+               0, 0, 0, "", total_resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 #endif
        stat_endGC(0, alloc, resident, major_str);
     } else { 
        stat_endGC(0, alloc, resident, "");
     }
 
 #endif
        stat_endGC(0, alloc, resident, major_str);
     } else { 
        stat_endGC(0, alloc, resident, "");
     }
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "GEN Major: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n           hp 0x%lx, hplim 0x%lx, free %lu\n",
                (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh,
                (W_) genInfo.newgen[genInfo.curnew].newbase,
        fprintf(stderr, "GEN Major: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n           hp 0x%lx, hplim 0x%lx, free %lu\n",
                (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh,
                (W_) genInfo.newgen[genInfo.curnew].newbase,
index 6b1ec5f..4224c9a 100644 (file)
@@ -15,172 +15,16 @@ A filehandle to which any storage-manager statistics should be written.
 \begin{code}
 #define NULL_REG_MAP
 #include "SMinternal.h"
 \begin{code}
 #define NULL_REG_MAP
 #include "SMinternal.h"
-
-/* global vars to hold some storage-mgr details; */
-/* decls for these are in SMinternal.h           */
-I_   SM_force_gc       = 0;
-I_   SM_alloc_size     = 0;
-I_   SM_alloc_min      = 0;
-I_   SM_major_gen_size = 0;
-FILE *SM_statsfile = NULL;
-I_   SM_trace = 0;
-I_   SM_stats_summary = 0;
-I_   SM_stats_verbose = 0;
-I_   SM_ring_bell = 0;
-
-/*To SizeHooks: I_   SM_word_heap_size = DEFAULT_HEAP_SIZE; */
-/*To SizeHooks: StgFloat SM_pc_free_heap = DEFAULT_PC_FREE; */
-extern I_ SM_word_stk_size; /*To SizeHooks: = DEFAULT_STACKS_SIZE; */
-
-I_ MaxResidency = 0;     /* in words; for stats only */
-I_ ResidencySamples = 0; /* for stats only */
-
-#ifndef atof
-extern double atof();
-/* no proto because some machines use const and some do not */
-#endif
-
-I_
-decode(s)
-  char *s;
-{
-    I_ c;
-    StgDouble m;
-    if (!*s)
-       return 0;
-    m = atof(s);
-    c = s[strlen(s)-1];
-    if (c == 'g' || c == 'G')
-       m *= 1000*1000*1000;    /* UNchecked! */
-    else if (c == 'm' || c == 'M')
-       m *= 1000*1000;                 /* We do not use powers of 2 (1024) */
-    else if (c == 'k' || c == 'K')     /* to avoid possible bad effects on */
-       m *= 1000;                      /* a direct-mapped cache.           */ 
-    else if (c == 'w' || c == 'W')
-       m *= sizeof(W_);
-    return (I_)m;
-}
-
-static void
-badoption(s)
-  char *s;
-{
-  fflush(stdout);
-  fprintf(stderr, "initSM: Bad RTS option: %s\n", s);
-  EXIT(EXIT_FAILURE);
-}              
-
-extern long strtol  PROTO((const char *, char **, int)); /* ToDo: properly? */
-
-I_
-initSM(rts_argc, rts_argv, statsfile)
-    I_     rts_argc;
-    char **rts_argv;
-    FILE  *statsfile;
-{
-    I_ arg;
-
-    /* save statsfile info */
-    SM_statsfile = statsfile;
-    
-    /* slurp through RTS args */
-
-    for (arg = 0; arg < rts_argc; arg++) {
-       if (rts_argv[arg][0] == '-') {
-           switch(rts_argv[arg][1]) {
-             case 'H':
-               SM_word_heap_size = decode(rts_argv[arg]+2) / sizeof(W_);
-
-               if (SM_word_heap_size <= 0) badoption( rts_argv[arg] );
-               break;
-
-             case 'M':
-               SM_pc_free_heap = atof(rts_argv[arg]+2);
-
-               if ((SM_pc_free_heap < 0) || (SM_pc_free_heap > 100))
-                   badoption( rts_argv[arg] );
-               break;
-
-             case 'A':
-               SM_alloc_size = decode(rts_argv[arg]+2) / sizeof(W_);
-
-               if (SM_alloc_size == 0) SM_alloc_size = DEFAULT_ALLOC_SIZE;
-               break;
-
-             case 'G':
-               SM_major_gen_size = decode(rts_argv[arg]+2) / sizeof(W_);
-               break;
-
-             case 'F':
-               if (strcmp(rts_argv[arg]+2, "2s") == 0) {
-                   SM_force_gc = USE_2s;
-               } else if (strcmp(rts_argv[arg]+2, "1s") == 0) {
-                   badoption( rts_argv[arg] ); /* ToDo ! */
-               } else {
-                   badoption( rts_argv[arg] );
-               }
-               break;
-
-             case 'K':
-               SM_word_stk_size = decode(rts_argv[arg]+2) / sizeof(W_);
-
-               if (SM_word_stk_size == 0) badoption( rts_argv[arg] );
-               break;
-
-             case 'S':
-               SM_stats_verbose++;
-               /* statsfile has already been determined */
-               break;
-             case 's':
-               SM_stats_summary++;
-               /* statsfile has already been determined */
-               break;
-             case 'B':
-               SM_ring_bell++;
-               break;
-
-             case 'T':
-               if (rts_argv[arg][2] != '\0')
-                   SM_trace = (I_) strtol(rts_argv[arg]+2, (char **)NULL, 0);
-               else
-                   SM_trace = 1;
-               break;
-
-#ifdef GCdu
-             case 'u':
-               dualmodeInfo.resid_to_compact = atof(rts_argv[arg]+2);
-               dualmodeInfo.resid_from_compact = dualmodeInfo.resid_from_compact + 0.05;
-               if (dualmodeInfo.resid_from_compact < 0.0 ||
-                   dualmodeInfo.resid_to_compact > 1.0) {
-                 badoption( rts_argv[arg] );
-               }
-#endif
-
-             default:
-               /* otherwise none of my business */
-               break;
-           }
-       }
-       /* else none of my business */
-    }
-
-    SM_alloc_min = (I_) (SM_word_heap_size * SM_pc_free_heap / 100);
-
-    return(0); /* all's well */
-}
 \end{code}
 
 \end{code}
 
-
 \section[storage-manager-exit]{Winding up the storage manager}
 
 \begin{code}
 \section[storage-manager-exit]{Winding up the storage manager}
 
 \begin{code}
-
-I_
-exitSM (sm_info)
-    smInfo *sm_info;
+rtsBool
+exitSM (smInfo *sm_info)
 {
     stat_exit(sm_info->hp - hp_start);
 
 {
     stat_exit(sm_info->hp - hp_start);
 
-    return(0); /* I'm happy */
+    return rtsTrue; /* I'm happy */
 }
 \end{code}
 }
 \end{code}
index 6979337..ddbb20c 100644 (file)
@@ -22,29 +22,13 @@ This stuff needs to be documented.  KH
 #include <sys/vadvise.h>
 #endif
 
 #include <sys/vadvise.h>
 #endif
 
-extern I_   SM_force_gc;
-#define USE_2s 1
-#define USE_1s 2
-
-extern I_   SM_word_heap_size; /* all defined in SMinit.lc */
-extern I_   SM_alloc_min;
-extern StgFloat SM_pc_free_heap;
-extern I_   SM_alloc_size;
-extern I_   SM_major_gen_size;
-/*moved: extern I_   SM_word_stk_size; */
-extern FILE    *SM_statsfile;
-extern I_   SM_trace;
-extern I_   SM_stats_summary;
-extern I_   SM_stats_verbose;
-extern I_   SM_ring_bell;
-
 extern P_ heap_space;
 extern P_ hp_start;
 
 extern P_ heap_space;
 extern P_ hp_start;
 
-extern void stat_init    PROTO((char *collector, char *c1, char *c2));
-extern void stat_startGC PROTO((I_ alloc));
-extern void stat_endGC   PROTO((I_ alloc, I_ collect, I_ live, char *comment));
-extern void stat_exit    PROTO((I_ alloc));
+void stat_init    PROTO((char *collector, char *c1, char *c2));
+void stat_startGC PROTO((I_ alloc));
+void stat_endGC   PROTO((I_ alloc, I_ collect, I_ live, char *comment));
+void stat_exit    PROTO((I_ alloc));
 
 extern I_ MaxResidency;     /* in words; for stats only */
 extern I_ ResidencySamples; /* for stats only */
 
 extern I_ MaxResidency;     /* in words; for stats only */
 extern I_ ResidencySamples; /* for stats only */
@@ -58,35 +42,20 @@ extern I_ ResidencySamples; /* for stats only */
        }                                       \
     } while (0)
 
        }                                       \
     } while (0)
 
-extern StgFunPtr _Dummy_entry(STG_NO_ARGS);
-extern char *xmalloc PROTO((size_t));
+StgFunPtr _Dummy_entry(STG_NO_ARGS);
 
 
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 #define DEBUG_SCAN(str, pos, to, topos) \
 #define DEBUG_SCAN(str, pos, to, topos) \
-       if (SM_trace & 2) fprintf(stderr, "%s: 0x%lx, %s 0x%lx\n", str, pos, to, topos)
+       if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
+           fprintf(stderr, "%s: 0x%lx, %s 0x%lx\n", str, pos, to, topos)
 #define DEBUG_STRING(str) \
 #define DEBUG_STRING(str) \
-       if (SM_trace & 2) fprintf(stderr, "%s\n", str)
+       if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
+           fprintf(stderr, "%s\n", str)
 #else
 #define DEBUG_SCAN(str, pos, to, topos)
 #define DEBUG_STRING(str)
 #endif
 
 #else
 #define DEBUG_SCAN(str, pos, to, topos)
 #define DEBUG_STRING(str)
 #endif
 
-/************************ Default HEAP and STACK sizes **********************/
-
-/* A user can change these main defaults with a
-   "hooks" file equiv to runtime/hooks/SizeHooks.lc.
-*/
-
-#define DEFAULT_STACKS_SIZE     0x10002  /* 2^16 = 16Kwords = 64Kbytes */
-
-#define DEFAULT_HEAP_SIZE       0x100002 /* 2^20 = 1Mwords = 4Mbytes  */
-#define DEFAULT_ALLOC_SIZE       0x4002   /* 2^14 = 16k words = 64k bytes */
-#define DEFAULT_PC_FREE          3       /* 3% */
-
-/* I added a couple of extra words above, to be more sure of avoiding
-    bad effects on direct-mapped caches. (WDP)
-*/
-
 #define NEXT_SEMI_SPACE(space) ((space + 1) % 2)
 
 /************************ Random stuff **********************/
 #define NEXT_SEMI_SPACE(space) ((space + 1) % 2)
 
 /************************ Random stuff **********************/
@@ -262,8 +231,8 @@ extern genData genInfo;
 #define EVAC_CODE(infoptr)  ((StgEvacPtr) ((P_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET])
 #define SCAV_CODE(infoptr)  ((StgScavPtr) ((P_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET+1])
 
 #define EVAC_CODE(infoptr)  ((StgEvacPtr) ((P_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET])
 #define SCAV_CODE(infoptr)  ((StgScavPtr) ((P_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET+1])
 
-extern void Scavenge(STG_NO_ARGS);
-extern void  _Scavenge_Forward_Ref(STG_NO_ARGS);
+void Scavenge(STG_NO_ARGS);
+void  _Scavenge_Forward_Ref(STG_NO_ARGS);
 
 /* Note: any change to FORWARD_ADDRESS should be
    reflected in layout of MallocPtrs (includes/SMClosures.lh)
 
 /* Note: any change to FORWARD_ADDRESS should be
    reflected in layout of MallocPtrs (includes/SMClosures.lh)
@@ -294,7 +263,7 @@ MAYBE_DECLARE_RTBL(,_Evacuate_Forward_Ref,)
     const W_ MK_REP_LBL(,evac_forward,)[] = { \
        INCLUDE_TYPE_INFO(INTERNAL)                             \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
     const W_ MK_REP_LBL(,evac_forward,)[] = { \
        INCLUDE_TYPE_INFO(INTERNAL)                             \
        INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
-       INCLUDE_PAR_INFO                                \
+       INCLUDE_PAR_INFO                                        \
        INCLUDE_COPYING_INFO(evac_forward,_Scavenge_Forward_Ref)\
        INCLUDE_COMPACTING_INFO(INFO_UNUSED,INFO_UNUSED,INFO_UNUSED,INFO_UNUSED) \
        }
        INCLUDE_COPYING_INFO(evac_forward,_Scavenge_Forward_Ref)\
        INCLUDE_COMPACTING_INFO(INFO_UNUSED,INFO_UNUSED,INFO_UNUSED,INFO_UNUSED) \
        }
@@ -317,7 +286,7 @@ MAYBE_DECLARE_RTBL(Caf_Evac_Upd,,)
     const W_ MK_REP_LBL(Caf_Evac_Upd,,)[] = { \
        INCLUDE_TYPE_INFO(INTERNAL)                             \
        INCLUDE_SIZE_INFO(MIN_UPD_SIZE,INFO_UNUSED)             \
     const W_ MK_REP_LBL(Caf_Evac_Upd,,)[] = { \
        INCLUDE_TYPE_INFO(INTERNAL)                             \
        INCLUDE_SIZE_INFO(MIN_UPD_SIZE,INFO_UNUSED)             \
-       INCLUDE_PAR_INFO                \
+       INCLUDE_PAR_INFO                                        \
        INCLUDE_COPYING_INFO(_Evacuate_Caf_Evac_Upd,_Scavenge_Caf) \
        INCLUDE_COMPACTING_INFO(INFO_UNUSED,INFO_UNUSED,INFO_UNUSED,INFO_UNUSED) \
     }
        INCLUDE_COPYING_INFO(_Evacuate_Caf_Evac_Upd,_Scavenge_Caf) \
        INCLUDE_COMPACTING_INFO(INFO_UNUSED,INFO_UNUSED,INFO_UNUSED,INFO_UNUSED) \
     }
@@ -332,8 +301,8 @@ MAYBE_DECLARE_RTBL(Caf_Evac_Upd,,)
 
 #if defined(_INFO_MARKING)
 
 
 #if defined(_INFO_MARKING)
 
-extern I_ markHeapRoots PROTO((smInfo *sm, P_ cafs1, P_ cafs2,
-                               P_ base, P_ lim, BitWord *bit_array));
+I_ markHeapRoots PROTO((smInfo *sm, P_ cafs1, P_ cafs2,
+                       P_ base, P_ lim, BitWord *bit_array));
 
 #define PRMARK_CODE(infoptr) \
          (((FP_)(INFO_RTBL(infoptr)))[COMPACTING_INFO_OFFSET+1])
 
 #define PRMARK_CODE(infoptr) \
          (((FP_)(INFO_RTBL(infoptr)))[COMPACTING_INFO_OFFSET+1])
@@ -381,12 +350,12 @@ MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextSpark,)
 MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextRoot,)
 MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextCAF,)
 
 MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextRoot,)
 MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextCAF,)
 
-#define DUMMY_PRRETURN_RTBL(prreturn_code,dummy_code) \
-    const W_ MK_REP_LBL(,prreturn_code,)[] = {     \
-       INCLUDE_TYPE_INFO(INTERNAL)                 \
-       INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)  \
-       INCLUDE_PAR_INFO   \
-       INCLUDE_COPYING_INFO(dummy_code,dummy_code) \
+#define DUMMY_PRRETURN_RTBL(prreturn_code,dummy_code)  \
+    const W_ MK_REP_LBL(,prreturn_code,)[] = {         \
+       INCLUDE_TYPE_INFO(INTERNAL)                     \
+       INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)      \
+       INCLUDE_PAR_INFO                                \
+       INCLUDE_COPYING_INFO(dummy_code,dummy_code)     \
        INCLUDE_COMPACTING_INFO(dummy_code,dummy_code,dummy_code,prreturn_code) \
     }
 
        INCLUDE_COMPACTING_INFO(dummy_code,dummy_code,dummy_code,prreturn_code) \
     }
 
@@ -477,11 +446,11 @@ MAYBE_DECLARE_RTBL(OldRoot,,)
 
 #endif /* ! GCgn */
 
 
 #endif /* ! GCgn */
 
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 
 #if defined(GCgn)
 #define DEBUG_LINK_LOCATION(location, closure, linklim)        \
 
 #if defined(GCgn)
 #define DEBUG_LINK_LOCATION(location, closure, linklim)        \
-    if (SM_trace & 4) {                                \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC) {                               \
        if (DYNAMIC_CLOSURE(closure) && (closure <= linklim)) \
             fprintf(stderr, "  Link Loc: 0x%lx to 0x%lx\n", location, closure); \
        else if (! DYNAMIC_CLOSURE(closure))    \
        if (DYNAMIC_CLOSURE(closure) && (closure <= linklim)) \
             fprintf(stderr, "  Link Loc: 0x%lx to 0x%lx\n", location, closure); \
        else if (! DYNAMIC_CLOSURE(closure))    \
@@ -491,7 +460,7 @@ MAYBE_DECLARE_RTBL(OldRoot,,)
     }
 #else /* ! GCgn */
 #define DEBUG_LINK_LOCATION(location, closure) \
     }
 #else /* ! GCgn */
 #define DEBUG_LINK_LOCATION(location, closure) \
-    if (SM_trace & 4) {                                \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC) {                               \
        if (DYNAMIC_CLOSURE(closure))           \
             fprintf(stderr, "  Link Loc: 0x%lx to 0x%lx\n", location, closure); \
        else                                    \
        if (DYNAMIC_CLOSURE(closure))           \
             fprintf(stderr, "  Link Loc: 0x%lx to 0x%lx\n", location, closure); \
        else                                    \
@@ -500,15 +469,15 @@ MAYBE_DECLARE_RTBL(OldRoot,,)
 #endif /* ! GCgn */
 
 #define DEBUG_UNLINK_LOCATION(location, closure, newlocation)  \
 #endif /* ! GCgn */
 
 #define DEBUG_UNLINK_LOCATION(location, closure, newlocation)  \
-    if (SM_trace & 4)                                          \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC)                                         \
         fprintf(stderr, "  UnLink Loc: 0x%lx, 0x%lx -> 0x%lx\n", location, closure, newlocation)
 
 #define DEBUG_LINK_CAF(caf) \
         fprintf(stderr, "  UnLink Loc: 0x%lx, 0x%lx -> 0x%lx\n", location, closure, newlocation)
 
 #define DEBUG_LINK_CAF(caf) \
-    if (SM_trace & 4)          \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC)         \
        fprintf(stderr, "Caf: 0x%lx  Closure: 0x%lx\n", caf, IND_CLOSURE_PTR(caf))
 
 #define DEBUG_SET_MARK(closure, hp_word) \
        fprintf(stderr, "Caf: 0x%lx  Closure: 0x%lx\n", caf, IND_CLOSURE_PTR(caf))
 
 #define DEBUG_SET_MARK(closure, hp_word) \
-    if (SM_trace & 8)                   \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)                   \
         fprintf(stderr, "  Set Mark Bit: 0x%lx, word %ld, bit_word %ld, bit %d\n", closure, hp_word, hp_word / BITS_IN(BitWord), hp_word & (BITS_IN(BitWord) - 1))
 
 #else
         fprintf(stderr, "  Set Mark Bit: 0x%lx, word %ld, bit_word %ld, bit %d\n", closure, hp_word, hp_word / BITS_IN(BitWord), hp_word & (BITS_IN(BitWord) - 1))
 
 #else
index ae6a3fa..13b55c9 100644 (file)
@@ -747,6 +747,8 @@ STGFUN(_PRStart_Ind)
 {
     FUNBEGIN;
     DEBUG_PR_IND;
 {
     FUNBEGIN;
     DEBUG_PR_IND;
+    GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
+
     Mark = (P_) IND_CLOSURE_PTR(Mark);
     JUMP_MARK;
     FUNEND;
     Mark = (P_) IND_CLOSURE_PTR(Mark);
     JUMP_MARK;
     FUNEND;
@@ -756,29 +758,25 @@ STGFUN(_PRStart_Ind)
 ``Permanent indirection''---used in profiling.  Works basically
 like @_PRStart_1@ (one pointer).
 \begin{code}
 ``Permanent indirection''---used in profiling.  Works basically
 like @_PRStart_1@ (one pointer).
 \begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
+
 STGFUN(_PRStart_PI)
 {
     FUNBEGIN;
 STGFUN(_PRStart_PI)
 {
     FUNBEGIN;
-/* This test would be here if it really was like a PRStart_1.
-   But maybe it is not needed because a PI cannot have two
-   things pointing at it (so no need to mark it), because
-   they are only created in exactly one place in UpdatePAP.
-   ??? WDP 95/07
 
     if (IS_MARK_BIT_SET(Mark)) {
        DEBUG_PR_MARKED;
        JUMP_MARK_RETURN;
     } else {
 
     if (IS_MARK_BIT_SET(Mark)) {
        DEBUG_PR_MARKED;
        JUMP_MARK_RETURN;
     } else {
-*/
        INIT_MARK_NODE("PI  ",1);
        /* the "1" above is dodgy (i.e. wrong), but it is never
           used except in debugging info.  ToDo??? WDP 95/07
        */
        INIT_MSTACK(PERM_IND_CLOSURE_PTR);
        INIT_MARK_NODE("PI  ",1);
        /* the "1" above is dodgy (i.e. wrong), but it is never
           used except in debugging info.  ToDo??? WDP 95/07
        */
        INIT_MSTACK(PERM_IND_CLOSURE_PTR);
-/*  } */
+    }
     FUNEND;
 }
     FUNEND;
 }
+
 STGFUN(_PRIn_PI)
 {
     FUNBEGIN;
 STGFUN(_PRIn_PI)
 {
     FUNBEGIN;
@@ -788,7 +786,8 @@ STGFUN(_PRIn_PI)
     */
     FUNEND;
 }
     */
     FUNEND;
 }
-#endif
+
+#endif /* PROFILING or TICKY */
 \end{code}
 
 Marking a ``selector closure'': This is a size-2 SPEC thunk that
 \end{code}
 
 Marking a ``selector closure'': This is a size-2 SPEC thunk that
@@ -800,39 +799,26 @@ unevaluated, then we behave {\em exactly as for a SPEC-2 thunk}.
 or ``on the way back up'' (\tr{_PRIn_Selector})?}  Answer: probably on
 the way down.  Downside: we are flummoxed by indirections, so we'll
 have to wait until the {\em next} major GC to do the selections (after
 or ``on the way back up'' (\tr{_PRIn_Selector})?}  Answer: probably on
 the way down.  Downside: we are flummoxed by indirections, so we'll
 have to wait until the {\em next} major GC to do the selections (after
-the indirections are sorted out in this GC).  But the downside of
+the indirections are shorted out in this GC).  But the downside of
 doing selections on the way back up is that we are then in a world of
 reversed pointers, and selecting a reversed pointer---we've see this
 on selectors for very recursive structures---is a total disaster.
 (WDP 94/12)
 
 \begin{code}
 doing selections on the way back up is that we are then in a world of
 reversed pointers, and selecting a reversed pointer---we've see this
 on selectors for very recursive structures---is a total disaster.
 (WDP 94/12)
 
 \begin{code}
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 #define IF_GC_DEBUG(x) x
 #else
 #define IF_GC_DEBUG(x) /*nothing*/
 #endif
 
 #define IF_GC_DEBUG(x) x
 #else
 #define IF_GC_DEBUG(x) /*nothing*/
 #endif
 
-/* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
+#if !defined(CONCURRENT)
+# define NOT_BLACKHOLING (! RTSflags.GcFlags.lazyBlackHoling)
+#else
+# define NOT_BLACKHOLING 0
+#endif
 
 
-#if 0
-/* testing */
-#define MARK_SELECTOR(n)                                               \
-STGFUN(CAT2(_PRStartSelector_,n))                                      \
-{                                                                      \
-    P_ maybe_con;                                                      \
-    FUNBEGIN;                                                          \
-                                                                       \
-    /* must be a SPEC 2 1 closure */                                   \
-    ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2);                            \
-    ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1);                          \
-    ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */           \
-                                                                       \
-    JMP_(_PRStart_1);                                                  \
-                                                                       \
-    FUNEND;                                                            \
-}
-#endif /* 0 */
+/* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
 
 #define MARK_SELECTOR(n)                                               \
 STGFUN(CAT2(_PRStartSelector_,n))                                      \
 
 #define MARK_SELECTOR(n)                                               \
 STGFUN(CAT2(_PRStartSelector_,n))                                      \
@@ -853,8 +839,8 @@ STGFUN(CAT2(_PRStartSelector_,n))                                   \
     maybe_con = (P_) *(Mark + _FHS);                                   \
                                                                        \
     IF_GC_DEBUG(                                                       \
     maybe_con = (P_) *(Mark + _FHS);                                   \
                                                                        \
     IF_GC_DEBUG(                                                       \
-    if (SM_trace & 2)  {                                               \
-        fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, marked? 0x%%lx, info 0x%lx", \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)  {                                               \
+        fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, info 0x%lx", \
                (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)),   \
                INFO_NoPTRS(INFO_PTR(Mark)),                            \
                maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/       \
                (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)),   \
                INFO_NoPTRS(INFO_PTR(Mark)),                            \
                maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/       \
@@ -864,10 +850,6 @@ STGFUN(CAT2(_PRStartSelector_,n))                                  \
            INFO_SIZE(INFO_PTR(maybe_con)),                             \
            INFO_NoPTRS(INFO_PTR(maybe_con)));                          \
        if (INFO_TAG(INFO_PTR(maybe_con)) >=0) {                        \
            INFO_SIZE(INFO_PTR(maybe_con)),                             \
            INFO_NoPTRS(INFO_PTR(maybe_con)));                          \
        if (INFO_TAG(INFO_PTR(maybe_con)) >=0) {                        \
-           /* int i; */                                                \
-           /* for (i = 0; i < INFO_SIZE(INFO_PTR(maybe_con)); i++) { */ \
-               /* fprintf(stderr, ", 0x%lx", maybe_con[_FHS + i]); */  \
-           /*}*/                                                       \
            fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]);         \
        }                                                               \
        fprintf(stderr, "\n");                                          \
            fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]);         \
        }                                                               \
        fprintf(stderr, "\n");                                          \
@@ -875,7 +857,9 @@ STGFUN(CAT2(_PRStartSelector_,n))                                   \
                                                                        \
     if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\
      || IS_MARK_BIT_SET(maybe_con)   /* been here: may be mangled */   \
                                                                        \
     if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\
      || IS_MARK_BIT_SET(maybe_con)   /* been here: may be mangled */   \
-     ||        INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */            \
+     ||        INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */             \
+     || NOT_BLACKHOLING  /* see "price of laziness" paper */           \
+     || (! RTSflags.GcFlags.doSelectorsAtGC ))                         \
        /* see below for OLD test we used here (WDP 95/04) */           \
        /* ToDo: decide WHNFness another way? */                        \
        JMP_(_PRStart_1);                                               \
        /* see below for OLD test we used here (WDP 95/04) */           \
        /* ToDo: decide WHNFness another way? */                        \
        JMP_(_PRStart_1);                                               \
@@ -885,6 +869,7 @@ STGFUN(CAT2(_PRStartSelector_,n))                                   \
     /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \
                                                                        \
     /* OK, it is evaluated: behave just like an indirection */         \
     /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \
                                                                        \
     /* OK, it is evaluated: behave just like an indirection */         \
+    GC_SEL_MAJOR(); /* ticky-ticky */                                  \
                                                                        \
     Mark = (P_) (maybe_con[_FHS + (n)]);                               \
     /* Mark now has the result of the selection */                     \
                                                                        \
     Mark = (P_) (maybe_con[_FHS + (n)]);                               \
     /* Mark now has the result of the selection */                     \
@@ -932,7 +917,27 @@ STGFUN(_PRStart_Const)
 {
     FUNBEGIN;
     DEBUG_PR_CONST;
 {
     FUNBEGIN;
     DEBUG_PR_CONST;
+
+#ifndef TICKY_TICKY
+    /* normal stuff */
     Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
     Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
+
+#else /* TICKY */
+    if (IS_MARK_BIT_SET(Mark)) {
+       DEBUG_PR_MARKED;
+    } else {
+       if (!AllFlags.doUpdEntryCounts) {
+
+           GC_COMMON_CONST(); /* ticky */
+
+           Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
+
+       } else { /* no commoning */
+           INIT_MARK_NODE("CONST ",0);
+       }
+    }
+#endif /* TICKY */
+
     JUMP_MARK_RETURN;
     FUNEND;
 }
     JUMP_MARK_RETURN;
     FUNEND;
 }
@@ -945,9 +950,37 @@ closure.
 \begin{code}
 STGFUN(_PRStart_CharLike)
 {
 \begin{code}
 STGFUN(_PRStart_CharLike)
 {
+    I_ val;
+
     FUNBEGIN;
     FUNBEGIN;
+
     DEBUG_PR_CHARLIKE;
     DEBUG_PR_CHARLIKE;
+
+#ifndef TICKY_TICKY
+    /* normal stuff */
+
     Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark));
     Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark));
+
+#else /* TICKY */
+
+    if (IS_MARK_BIT_SET(Mark)) {
+       DEBUG_PR_MARKED;
+    } else {
+       val = CHARLIKE_VALUE(Mark);
+
+       if (!AllFlags.doUpdEntryCounts) {
+           GC_COMMON_CHARLIKE(); /* ticky */
+
+           INFO_PTR(Mark) = (W_) Ind_info;
+           IND_CLOSURE_PTR(Mark) = (W_) CHARLIKE_CLOSURE(val);
+           Mark = (P_) IND_CLOSURE_PTR(Mark);
+
+       } else { /* no commoning */
+           INIT_MARK_NODE("CHAR ",0);
+       }
+    }
+#endif /* TICKY */
+
     JUMP_MARK_RETURN;
     FUNEND;
 }
     JUMP_MARK_RETURN;
     FUNEND;
 }
@@ -966,57 +999,34 @@ STGFUN(_PRStart_IntLike)
     if (IS_MARK_BIT_SET(Mark)) {
        DEBUG_PR_MARKED;
     } else {
     if (IS_MARK_BIT_SET(Mark)) {
        DEBUG_PR_MARKED;
     } else {
-    val = INTLIKE_VALUE(Mark);
+       val = INTLIKE_VALUE(Mark);
+
+       if (val >= MIN_INTLIKE
+        && val <= MAX_INTLIKE
+#ifdef TICKY_TICKY
+        && !AllFlags.doUpdEntryCounts
+#endif
+          ) {
+           DEBUG_PR_INTLIKE_TO_STATIC;
+           GC_COMMON_INTLIKE(); /* ticky */
 
 
-    if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {
-       DEBUG_PR_INTLIKE_TO_STATIC;
            INFO_PTR(Mark) = (W_) Ind_info;
            IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val);
            Mark = (P_) IND_CLOSURE_PTR(Mark);
            INFO_PTR(Mark) = (W_) Ind_info;
            IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val);
            Mark = (P_) IND_CLOSURE_PTR(Mark);
-       } else {        
-           /* out of range of static closures */
-       DEBUG_PR_INTLIKE_IN_HEAP;
+
+       } else {        /* out of range of static closures */
+           DEBUG_PR_INTLIKE_IN_HEAP;
+#ifdef TICKY_TICKY
+           if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL();
+#endif
            INIT_MARK_NODE("INT ",0);
            INIT_MARK_NODE("INT ",0);
-    }
+       }
     }
     JUMP_MARK_RETURN;
     FUNEND;
 }
 \end{code}
 
     }
     JUMP_MARK_RETURN;
     FUNEND;
 }
 \end{code}
 
-CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD!
-
-\begin{code}
-#if defined(GCgn)
-
-/* Marking an OldGen root -- treat as indirection if it references the old generation */
-
-STGFUN(_PRStart_OldRoot)
-{
-    P_ oldroot;
-
-    FUNBEGIN;
-    oldroot = (P_) IND_CLOSURE_PTR(Mark);
-
-    if (oldroot <= HeapLim)                               /* does the root reference the old generation ? */
-      {
-       DEBUG_PR_OLDIND;
-       Mark = oldroot;                                   /* short circut if the old generation root */
-       JUMP_MARK;                                        /* references an old generation closure    */
-      }
-
-    else
-      {
-       INIT_MARK_NODE("OldRoot",1);                   /* oldroot to new generation */
-       INIT_MSTACK(SPEC_CLOSURE_PTR);                    /* treat as _PRStart_1       */
-      }
-    FUNEND;
-}
-
-#endif /* GCgn */
-
-\end{code}
-
 Special error routine, used for closures which should never call their
 ``in'' code.
 
 Special error routine, used for closures which should never call their
 ``in'' code.
 
@@ -1232,6 +1242,9 @@ STGFUN(_PRStart_StkO)
     I_ cts_size;
 
     FUNBEGIN;
     I_ cts_size;
 
     FUNBEGIN;
+
+    /* ToDo: ASSERT(sanityChk_StkO(Mark)); ??? */
+
     if (IS_MARK_BIT_SET(Mark)) {
        DEBUG_PR_MARKED;
        JUMP_MARK_RETURN;
     if (IS_MARK_BIT_SET(Mark)) {
        DEBUG_PR_MARKED;
        JUMP_MARK_RETURN;
@@ -1323,7 +1336,7 @@ STGFUN(_PRIn_StkO)
 %
 %****************************************************************************
 
 %
 %****************************************************************************
 
-A CAF is shorted out as if it is an indirection.
+A CAF is shorted out as if it were an indirection.
 The CAF reference is explicitly updated by the garbage collector.
 
 \begin{code}
 The CAF reference is explicitly updated by the garbage collector.
 
 \begin{code}
@@ -1331,89 +1344,12 @@ STGFUN(_PRStart_Caf)
 {
     FUNBEGIN;
     DEBUG_PR_CAF;
 {
     FUNBEGIN;
     DEBUG_PR_CAF;
-    Mark = (P_) IND_CLOSURE_PTR(Mark);
-    JUMP_MARK;
-    FUNEND;
-}
-
-#if 0 /* Code to avoid explicit updating of CAF references */
-      /* We need auxiliary mark and update reference info table */
-
-CAF_MARK_UPD_ITBL(Caf_Mark_Upd_info,const);
-
-/* Start marking a CAF -- special mark upd info table */
-/* Change to marking state and mark reference */
-
-STGFUN(_PRStart_Caf) 
-{
-    FUNBEGIN;
-    if (IS_MARK_BIT_SET(Mark)) {
-       DEBUG_PR_MARKED;
-       JUMP_MARK_RETURN;
-    } else {
-       INIT_MARK_NODE("CAF ",1);
-    INIT_MSTACK(IND_CLOSURE_PTR2);
-    }
-    FUNEND;
-}
+    GC_SHORT_CAF(); /* ticky */
 
 
-/* Completed marking a CAF -- special mark upd info table */
-/* Change info table back to normal CAF info, return reference (Mark) */
-
-STGFUN(_PRInLast_Caf) 
-{
-    P_ temp;
-
-    FUNBEGIN;
-    DEBUG_PRLAST_CAF;
-    SET_INFO_PTR(MStack, Caf_info); /* normal marked CAF */
-
-    /* Like POP_MSTACK */
-    temp = MStack;
-    MStack = (P_) IND_CLOSURE_PTR(temp);
-    IND_CLOSURE_PTR(temp) = (W_) Mark;
-
-    /* Mark left unmodified so CAF reference is returned */
-    JUMP_MARK_RETURN;
-    FUNEND;
-}
-
-/* Marking a CAF currently being marked -- special mark upd info table */
-/* Just return CAF as if marked -- wont be shorted out */
-/* Marking once reference marked and updated -- normal CAF info table */
-/* Return reference to short CAF out */
-
-STGFUN(_PRStart_Caf) 
-{
-    FUNBEGIN;
-    if (IS_MARK_BIT_SET(Mark)) {
-        DEBUG_PR_MARKING_CAF;
-       JUMP_MARK_RETURN;
-    } else {
-    DEBUG_PR_MARKED_CAF;
     Mark = (P_) IND_CLOSURE_PTR(Mark);
     Mark = (P_) IND_CLOSURE_PTR(Mark);
-    JUMP_MARK_RETURN;
-    }
+    JUMP_MARK;
     FUNEND;
 }
     FUNEND;
 }
-
-#define DEBUG_PR_MARKED_CAF \
-    if (SM_trace & 8)   \
-        fprintf(stderr, "PRMark CAF (Marked): 0x%lx -> 0x%lx, info 0x%lx\n", \
-               Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
-
-#define DEBUG_PR_MARKING_CAF \
-    if (SM_trace & 8)   \
-        fprintf(stderr, "PRMark CAF (Marking): 0x%lx -> 0x%lx, info 0x%lx\n", \
-               Mark, Mark, INFO_PTR(Mark))
-
-#define DEBUG_PRLAST_CAF \
-    if (SM_trace & 8)    \
-        fprintf(stderr, "PRRet  Last  (CAF ): 0x%lx -> 0x%lx, info 0x%lx -> 0x%lx ptrs 1\n", \
-                MStack, Mark, INFO_PTR(MStack), Caf_info)
-
-#endif /* 0 */
-
 \end{code}
 
 %****************************************************************************
 \end{code}
 
 %****************************************************************************
@@ -1432,10 +1368,24 @@ STGFUN(_Dummy_PRReturn_entry)
     FUNBEGIN;
     fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n");
     abort();
     FUNBEGIN;
     fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n");
     abort();
-    return(0);    /* won't happen; quiets compiler warnings */
     FUNEND;
 }
 
     FUNEND;
 }
 
+/* various ways to call _Dummy_PRReturn_entry: */
+
+INTFUN(_PRMarking_MarkNextRoot_entry)  { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#ifdef CONCURRENT
+INTFUN(_PRMarking_MarkNextSpark_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#endif
+#ifdef PAR
+INTFUN(_PRMarking_MarkNextGA_entry)    { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+#endif
+INTFUN(_PRMarking_MarkNextAStack_entry)        { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+INTFUN(_PRMarking_MarkNextBStack_entry)        { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+INTFUN(_PRMarking_MarkNextCAF_entry)   { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
+
+/* end of various ways to call _Dummy_PRReturn_entry */
+
 EXTFUN(_PRMarking_MarkNextRoot);
 EXTFUN(_PRMarking_MarkNextCAF);
 
 EXTFUN(_PRMarking_MarkNextRoot);
 EXTFUN(_PRMarking_MarkNextCAF);
 
@@ -1456,42 +1406,42 @@ CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN")
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure,
                       _PRMarking_MarkNextRoot_info,
                       _PRMarking_MarkNextRoot,
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure,
                       _PRMarking_MarkNextRoot_info,
                       _PRMarking_MarkNextRoot,
-                      _Dummy_PRReturn_entry);
+                      _PRMarking_MarkNextRoot_entry);
 
 #ifdef CONCURRENT
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure,
                       _PRMarking_MarkNextSpark_info,
                       _PRMarking_MarkNextSpark,
 
 #ifdef CONCURRENT
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure,
                       _PRMarking_MarkNextSpark_info,
                       _PRMarking_MarkNextSpark,
-                      _Dummy_PRReturn_entry);
+                      _PRMarking_MarkNextSpark_entry);
 #endif
 
 #ifdef PAR
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure,
                       _PRMarking_MarkNextGA_info,
                       _PRMarking_MarkNextGA,
 #endif
 
 #ifdef PAR
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure,
                       _PRMarking_MarkNextGA_info,
                       _PRMarking_MarkNextGA,
-                      _Dummy_PRReturn_entry);
+                      _PRMarking_MarkNextGA_entry);
 #else
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure,
                       _PRMarking_MarkNextAStack_info,
                       _PRMarking_MarkNextAStack,
 #else
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure,
                       _PRMarking_MarkNextAStack_info,
                       _PRMarking_MarkNextAStack,
-                      _Dummy_PRReturn_entry);
+                      _PRMarking_MarkNextAStack_entry);
 
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure,
                       _PRMarking_MarkNextBStack_info,
                       _PRMarking_MarkNextBStack,
 
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure,
                       _PRMarking_MarkNextBStack_info,
                       _PRMarking_MarkNextBStack,
-                      _Dummy_PRReturn_entry);
+                      _PRMarking_MarkNextBStack_entry);
 
 #endif /* PAR */
 
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure,
                       _PRMarking_MarkNextCAF_info,
                       _PRMarking_MarkNextCAF,
 
 #endif /* PAR */
 
 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure,
                       _PRMarking_MarkNextCAF_info,
                       _PRMarking_MarkNextCAF,
-                      _Dummy_PRReturn_entry);
+                      _PRMarking_MarkNextCAF_entry);
+
+extern P_ sm_roots_end;        /* &roots[rootno] -- one beyond the end */
 
 STGFUN(_PRMarking_MarkNextRoot)
 {
 
 STGFUN(_PRMarking_MarkNextRoot)
 {
-    extern P_ sm_roots_end;    /* &roots[rootno] -- one beyond the end */
-
     FUNBEGIN;
     /* Update root -- may have short circuited Ind */
     *MRoot = (W_) Mark;
     FUNBEGIN;
     /* Update root -- may have short circuited Ind */
     *MRoot = (W_) Mark;
@@ -1506,10 +1456,10 @@ STGFUN(_PRMarking_MarkNextRoot)
 }
 
 #ifdef CONCURRENT
 }
 
 #ifdef CONCURRENT
+extern P_ sm_roots_end;        /* PendingSparksTl[pool] */
+
 STGFUN(_PRMarking_MarkNextSpark)
 {
 STGFUN(_PRMarking_MarkNextSpark)
 {
-    extern P_ sm_roots_end;    /* PendingSparksTl[pool] */
-
     FUNBEGIN;
     /* Update root -- may have short circuited Ind */
     *MRoot = (W_) Mark;
     FUNBEGIN;
     /* Update root -- may have short circuited Ind */
     *MRoot = (W_) Mark;
@@ -1587,7 +1537,8 @@ Mark the next CAF in the CAF list.
 STGFUN(_PRMarking_MarkNextCAF)
 {
     FUNBEGIN;
 STGFUN(_PRMarking_MarkNextCAF)
 {
     FUNBEGIN;
-    /* Update root -- may have short circuted Ind */
+
+    /* Update root -- may have short circuited Ind */
     IND_CLOSURE_PTR(MRoot) = (W_) Mark;
 
     MRoot = (P_) IND_CLOSURE_LINK(MRoot);
     IND_CLOSURE_PTR(MRoot) = (W_) Mark;
 
     MRoot = (P_) IND_CLOSURE_LINK(MRoot);
@@ -1596,29 +1547,12 @@ STGFUN(_PRMarking_MarkNextCAF)
     if (MRoot == 0)
        RESUME_(miniInterpretEnd);
 
     if (MRoot == 0)
        RESUME_(miniInterpretEnd);
 
-    Mark = (P_) IND_CLOSURE_PTR(MRoot);
-    JUMP_MARK;
-    FUNEND;
-}
-\end{code}
-
-\begin{code}
-#if 0 /* Code to avoid explicit updating of CAF references */
+    GC_SHORT_CAF(); /* ticky (ToDo: wrong?) */
 
 
-STGFUN(_PRMarking_MarkNextCAF)
-{
-    FUNBEGIN;
-    MRoot = (P_) IND_CLOSURE_LINK(MRoot);
-
-    /* Is the next CAF the end of the list */
-    if (MRoot == 0)
-       RESUME_(miniInterpretEnd);
-
-    Mark = MRoot;
+    Mark = (P_) IND_CLOSURE_PTR(MRoot);
     JUMP_MARK;
     FUNEND;
 }
     JUMP_MARK;
     FUNEND;
 }
-#endif /* 0 */
 \end{code}
 
 Multi-slurp protection.
 \end{code}
 
 Multi-slurp protection.
index fccce1a..259429c 100644 (file)
@@ -239,65 +239,65 @@ a closure.
 Define some debugging macros.
 
 \begin{code}
 Define some debugging macros.
 
 \begin{code}
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 
 #define DEBUG_PRSTART(type, ptrsvar) \
 
 #define DEBUG_PRSTART(type, ptrsvar) \
-    if (SM_trace & 8)                         \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)                         \
         fprintf(stderr, "PRMark Start (%s): 0x%lx, info 0x%lx ptrs %ld\n", \
                 type, Mark, INFO_PTR(Mark), ptrsvar)
 
 #define DEBUG_PRIN(type, posvar) \
         fprintf(stderr, "PRMark Start (%s): 0x%lx, info 0x%lx ptrs %ld\n", \
                 type, Mark, INFO_PTR(Mark), ptrsvar)
 
 #define DEBUG_PRIN(type, posvar) \
-    if (SM_trace & 8)                     \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)                     \
         fprintf(stderr, "PRRet  In    (%s): 0x%lx, info 0x%lx pos %ld\n", \
                 type, MStack, INFO_PTR(MStack), posvar)
 
 #define DEBUG_PRLAST(type, ptrvar) \
         fprintf(stderr, "PRRet  In    (%s): 0x%lx, info 0x%lx pos %ld\n", \
                 type, MStack, INFO_PTR(MStack), posvar)
 
 #define DEBUG_PRLAST(type, ptrvar) \
-    if (SM_trace & 8)                       \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)                       \
         fprintf(stderr, "PRRet  Last  (%s): 0x%lx, info 0x%lx ptrs %ld\n", \
                 type, MStack, INFO_PTR(MStack), ptrvar)
 
 #define DEBUG_PR_MARKED \
         fprintf(stderr, "PRRet  Last  (%s): 0x%lx, info 0x%lx ptrs %ld\n", \
                 type, MStack, INFO_PTR(MStack), ptrvar)
 
 #define DEBUG_PR_MARKED \
-    if (SM_trace & 8)   \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)   \
         fprintf(stderr, "PRMark Marked      : 0x%lx, info 0x%lx\n", \
                Mark, INFO_PTR(Mark))
 
 #define DEBUG_PR_STAT \
         fprintf(stderr, "PRMark Marked      : 0x%lx, info 0x%lx\n", \
                Mark, INFO_PTR(Mark))
 
 #define DEBUG_PR_STAT \
-    if (SM_trace & 8) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \
         fprintf(stderr, "PRMark Static      : 0x%lx, info 0x%lx\n", \
                Mark, INFO_PTR(Mark))
 
 #define DEBUG_PR_IND  \
         fprintf(stderr, "PRMark Static      : 0x%lx, info 0x%lx\n", \
                Mark, INFO_PTR(Mark))
 
 #define DEBUG_PR_IND  \
-    if (SM_trace & 8) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \
         fprintf(stderr, "PRMark Ind : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \
                Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
 
 #define DEBUG_PR_CAF  \
         fprintf(stderr, "PRMark Ind : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \
                Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
 
 #define DEBUG_PR_CAF  \
-    if (SM_trace & 8) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \
         fprintf(stderr, "PRMark Caf : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \
                Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
 
 #define DEBUG_PR_CONST \
         fprintf(stderr, "PRMark Caf : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \
                Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
 
 #define DEBUG_PR_CONST \
-    if (SM_trace & 8)  \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)  \
         fprintf(stderr, "PRMark Const : 0x%lx -> 0x%lx, info 0x%lx\n", \
                Mark, CONST_STATIC_CLOSURE(INFO_PTR(Mark)), INFO_PTR(Mark))
 
 #define DEBUG_PR_CHARLIKE \
         fprintf(stderr, "PRMark Const : 0x%lx -> 0x%lx, info 0x%lx\n", \
                Mark, CONST_STATIC_CLOSURE(INFO_PTR(Mark)), INFO_PTR(Mark))
 
 #define DEBUG_PR_CHARLIKE \
-    if (SM_trace & 8)  \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)  \
         fprintf(stderr, "PRMark CharLike (%lx) : 0x%lx -> 0x%lx, info 0x%lx\n", \
                CHARLIKE_VALUE(Mark), Mark, CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark)), INFO_PTR(Mark))
 
 #define        DEBUG_PR_INTLIKE_TO_STATIC \
         fprintf(stderr, "PRMark CharLike (%lx) : 0x%lx -> 0x%lx, info 0x%lx\n", \
                CHARLIKE_VALUE(Mark), Mark, CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark)), INFO_PTR(Mark))
 
 #define        DEBUG_PR_INTLIKE_TO_STATIC \
-    if (SM_trace & 8)  \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)  \
         fprintf(stderr, "PRMark IntLike to Static (%ld) : 0x%lx -> 0x%lx, info 0x%lx\n", \
                INTLIKE_VALUE(Mark), Mark, INTLIKE_CLOSURE(INTLIKE_VALUE(Mark)), INFO_PTR(Mark))
 
 #define        DEBUG_PR_INTLIKE_IN_HEAP \
         fprintf(stderr, "PRMark IntLike to Static (%ld) : 0x%lx -> 0x%lx, info 0x%lx\n", \
                INTLIKE_VALUE(Mark), Mark, INTLIKE_CLOSURE(INTLIKE_VALUE(Mark)), INFO_PTR(Mark))
 
 #define        DEBUG_PR_INTLIKE_IN_HEAP \
-    if (SM_trace & 8)  \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING)  \
         fprintf(stderr, "PRMark IntLike in Heap   (%ld) : 0x%lx, info 0x%lx\n", \
                INTLIKE_VALUE(Mark), Mark, INFO_PTR(Mark))
 
 #define DEBUG_PR_OLDIND \
         fprintf(stderr, "PRMark IntLike in Heap   (%ld) : 0x%lx, info 0x%lx\n", \
                INTLIKE_VALUE(Mark), Mark, INFO_PTR(Mark))
 
 #define DEBUG_PR_OLDIND \
-    if (SM_trace & 8) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \
         fprintf(stderr, "PRMark OldRoot Ind : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \
                Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
 
         fprintf(stderr, "PRMark OldRoot Ind : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \
                Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
 
index 33d366e..ae92832 100644 (file)
@@ -9,8 +9,6 @@
 #define MARK_REG_MAP
 #include "SMinternal.h"
 
 #define MARK_REG_MAP
 #include "SMinternal.h"
 
-extern I_ doSanityChks; /* ToDo: move tidily */
-
 #if defined(_INFO_MARKING)
 
 #if defined (__STG_GCC_REGS__) /* If we are using registers load _SAVE */
 #if defined(_INFO_MARKING)
 
 #if defined (__STG_GCC_REGS__) /* If we are using registers load _SAVE */
@@ -62,37 +60,6 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
     int pool;
 #endif
 
     int pool;
 #endif
 
-#if 0 /* Code to avoid explicit updating of CAF references */
-
-    /* Before marking have to modify CAFs to auxillary info table */
-    P_ CAFptr;
-    DEBUG_STRING("Setting Mark & Upd CAFs:");
-    for (CAFptr = cafs1; CAFptr;
-        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
-       INFO_PTR(CAFptr) = (W_) Caf_Mark_Upd_info;
-    }
-    for (CAFptr = cafs2; CAFptr;
-        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
-       INFO_PTR(CAFptr) = (W_) Caf_Mark_Upd_info;
-    }
-    DEBUG_STRING("Marking CAFs:");
-    if (cafs1) {
-       MRoot = (P_) cafs1;
-       Mark = (P_) MRoot;
-       MStack = (P_) _PRMarking_MarkNextCAF_closure;
-       /*ToDo: debugify */
-       miniInterpret((StgFunPtr)_startMarkWorld);
-    }
-    if (cafs2) {
-       MRoot = (P_) cafs2;
-       Mark = (P_) MRoot;
-       MStack = (P_) _PRMarking_MarkNextCAF_closure;
-       /*ToDo: debugify */
-       miniInterpret((StgFunPtr)_startMarkWorld);
-    }
-
-#endif /* 0 */
-
     BitArray = bit_array;
     HeapBase = base;
     HeapLim = lim;
     BitArray = bit_array;
     HeapBase = base;
     HeapLim = lim;
@@ -103,14 +70,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
        MRoot = (P_) sm->roots;
        Mark = (P_) *MRoot;
        MStack = (P_) _PRMarking_MarkNextRoot_closure;
        MRoot = (P_) sm->roots;
        Mark = (P_) *MRoot;
        MStack = (P_) _PRMarking_MarkNextRoot_closure;
-#if defined(__STG_TAILJUMPS__)
-       miniInterpret((StgFunPtr)_startMarkWorld);
-#else
-    if (doSanityChks)
-       miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
-    else
+
        miniInterpret((StgFunPtr)_startMarkWorld);
        miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
     }
 
 #ifdef CONCURRENT
     }
 
 #ifdef CONCURRENT
@@ -120,14 +81,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
            MRoot = (P_) PendingSparksHd[pool];
            Mark = (P_) *MRoot;
            MStack = (P_) _PRMarking_MarkNextSpark_closure;
            MRoot = (P_) PendingSparksHd[pool];
            Mark = (P_) *MRoot;
            MStack = (P_) _PRMarking_MarkNextSpark_closure;
-#if defined(__STG_TAILJUMPS__)
-           miniInterpret((StgFunPtr)_startMarkWorld);
-#else
-       if (doSanityChks)
-           miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
-       else
+
            miniInterpret((StgFunPtr)_startMarkWorld);
            miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
         }
     }
 #endif
         }
     }
 #endif
@@ -140,14 +95,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
     if (MRoot != NULL) {
        Mark = ((GALA *)MRoot)->la;
        MStack = (P_) _PRMarking_MarkNextGA_closure;
     if (MRoot != NULL) {
        Mark = ((GALA *)MRoot)->la;
        MStack = (P_) _PRMarking_MarkNextGA_closure;
-#if defined(__STG_TAILJUMPS__)
+
        miniInterpret((StgFunPtr) _startMarkWorld);
        miniInterpret((StgFunPtr) _startMarkWorld);
-#else
-       if (doSanityChks)
-           miniInterpret_debug((StgFunPtr) _startMarkWorld, NULL);
-       else
-           miniInterpret((StgFunPtr) _startMarkWorld);
-#endif /* ! tail-jumping */
     }
 #else
     /* Note: no *external* stacks in parallel world */
     }
 #else
     /* Note: no *external* stacks in parallel world */
@@ -156,14 +105,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
        MRoot = (P_) MAIN_SpA;
        Mark = (P_) *MRoot;
        MStack = (P_) _PRMarking_MarkNextAStack_closure;
        MRoot = (P_) MAIN_SpA;
        Mark = (P_) *MRoot;
        MStack = (P_) _PRMarking_MarkNextAStack_closure;
-#if defined(__STG_TAILJUMPS__)
-       miniInterpret((StgFunPtr)_startMarkWorld);
-#else
-    if (doSanityChks)
-       miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
-    else
+
        miniInterpret((StgFunPtr)_startMarkWorld);
        miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
     }
 
     DEBUG_STRING("Marking B Stack:");
     }
 
     DEBUG_STRING("Marking B Stack:");
@@ -177,37 +120,25 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
 
     DEBUG_STRING("Marking & Updating CAFs:");
     if (cafs1) {
 
     DEBUG_STRING("Marking & Updating CAFs:");
     if (cafs1) {
-       MRoot = cafs1;
-       Mark = (P_) IND_CLOSURE_PTR(MRoot);
+       MRoot  = cafs1;
+       Mark   = (P_) IND_CLOSURE_PTR(MRoot);
        MStack = (P_) _PRMarking_MarkNextCAF_closure;
        MStack = (P_) _PRMarking_MarkNextCAF_closure;
-#if defined(__STG_TAILJUMPS__)
-       miniInterpret((StgFunPtr)_startMarkWorld);
-#else
-    if (doSanityChks)
-       miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
-    else
+
        miniInterpret((StgFunPtr)_startMarkWorld);
        miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
     }
 
     if (cafs2) {
     }
 
     if (cafs2) {
-       MRoot = cafs2;
-       Mark = (P_) IND_CLOSURE_PTR(MRoot);
+       MRoot  = cafs2;
+       Mark   = (P_) IND_CLOSURE_PTR(MRoot);
        MStack = (P_) _PRMarking_MarkNextCAF_closure;
        MStack = (P_) _PRMarking_MarkNextCAF_closure;
-#if defined(__STG_TAILJUMPS__)
-       miniInterpret((StgFunPtr)_startMarkWorld);
-#else
-    if (doSanityChks)
-       miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL);
-    else
+
        miniInterpret((StgFunPtr)_startMarkWorld);
        miniInterpret((StgFunPtr)_startMarkWorld);
-#endif /* ! tail-jumping */
     }
     }
+
     return 0;
 }
 
 #endif /* _INFO_MARKING */
     return 0;
 }
 
 #endif /* _INFO_MARKING */
-
 \end{code}
 
 
 \end{code}
 
 
index 35f1b05..35534bb 100644 (file)
@@ -61,7 +61,8 @@ Inplace_Compaction(base, lim, scanbase, scanlim, bit_array, bit_array_words
 #endif
 {
     BitWord *bit_array_ptr, *bit_array_end;
 #endif
 {
     BitWord *bit_array_ptr, *bit_array_end;
-    P_ scan_w_start, info; I_ size;
+    P_ scan_w_start, info;
+    I_ size;
 
     LinkLim = lim;  /* Only checked for generational collection */
 
 
     LinkLim = lim;  /* Only checked for generational collection */
 
@@ -118,12 +119,6 @@ Inplace_Compaction(base, lim, scanbase, scanlim, bit_array, bit_array_words
                    info = next;
                }
                INFO_PTR(Scan) = (W_) info;
                    info = next;
                }
                INFO_PTR(Scan) = (W_) info;
-/*
-if (SM_trace & 8) {
-    fprintf(stderr, "  Marked: word %ld, val 0x%lx, cur 0x%lx, Scan_w 0x%lx, Scan 0x%lx, Info 0x%lx, Code 0x%lx\n",
-           (bit_array_ptr-1) - bit_array, *(bit_array_ptr-1), w, scan_w_start, Scan, info,
-           SCAN_LINK_CODE(info)); };
-*/
 
                size = (*SCAN_LINK_CODE(info))();
 
 
                size = (*SCAN_LINK_CODE(info))();
 
@@ -175,29 +170,17 @@ if (SM_trace & 8) {
                w >>= 1;
 
            } else {    /* Bit Set -- Enter ScanMove for closure*/
                w >>= 1;
 
            } else {    /* Bit Set -- Enter ScanMove for closure*/
-/*HACK if (SM_trace&8) {fprintf(stderr,"Scan=%x\n",Scan);} */
                info = (P_) INFO_PTR(Scan);
                info = (P_) INFO_PTR(Scan);
-/*HACK if (SM_trace&8) {fprintf(stderr,"info=%x\n",info);} */
                while (MARKED_LOCATION(info)) {
                    P_ next;
                    info = UNMARK_LOCATION(info);
                     next = (P_) *info;
                while (MARKED_LOCATION(info)) {
                    P_ next;
                    info = UNMARK_LOCATION(info);
                     next = (P_) *info;
-/*HACK     if (SM_trace&8) {fprintf(stderr,"next=%x\n",next);} */
                    DEBUG_UNLINK_LOCATION(info, Scan, New);
                    DEBUG_UNLINK_LOCATION(info, Scan, New);
-/*HACK     if (SM_trace&8) {fprintf(stderr,"New=%x\n",New);} */
                    *info = (W_) New;
                    info = next;
                    *info = (W_) New;
                    info = next;
-/*HACK     if (SM_trace&8) {fprintf(stderr,"*info=%x,info=%x\n",*info,info);} */
                }
                }
-/*HACK if (SM_trace&8) {fprintf(stderr,"preNew info=%x\n",info);} */
                INFO_PTR(New) = (W_) info;
 
                INFO_PTR(New) = (W_) info;
 
-/*
-if (SM_trace & 8) {
-    fprintf(stderr, "  Marked: word %ld, cur 0x%lx, Scan_w 0x%lx, Scan 0x%lx, Info 0x%lx, Code 0x%lx\n",
-           (bit_array_ptr-1) - bit_array, w, scan_w_start, Scan, info, SCAN_MOVE_CODE(info)); };
-*/
-
                size = (*SCAN_MOVE_CODE(info))();
                New  += size;  /* set New address of next closure */
                Scan += size;  /* skip size bits */  
                size = (*SCAN_MOVE_CODE(info))();
                New  += size;  /* set New address of next closure */
                Scan += size;  /* skip size bits */  
@@ -356,15 +339,15 @@ LinkLim -- The limit of the heap requiring to be linked & moved
 #endif                               
 
 
 #endif                               
 
 
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 
 #define DEBUG_SCAN_LINK(type, sizevar, ptrvar) \
 
 #define DEBUG_SCAN_LINK(type, sizevar, ptrvar) \
-    if (SM_trace & 2)                  \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC)                  \
         fprintf(stderr, "Scan Link (%s): 0x%lx -> 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
                type, Scan, New, INFO_PTR(Scan), sizevar, ptrvar)
 
 #define DEBUG_SCAN_MOVE(type, sizevar) \
         fprintf(stderr, "Scan Link (%s): 0x%lx -> 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
                type, Scan, New, INFO_PTR(Scan), sizevar, ptrvar)
 
 #define DEBUG_SCAN_MOVE(type, sizevar) \
-    if (SM_trace & 2)            \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC)            \
         fprintf(stderr, "Scan Move (%s): 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \
                type, Scan, New, INFO_PTR(New), sizevar)
 
         fprintf(stderr, "Scan Move (%s): 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \
                type, Scan, New, INFO_PTR(New), sizevar)
 
@@ -378,106 +361,128 @@ LinkLim -- The limit of the heap requiring to be linked & moved
 
 /*** LINKING CLOSURES ***/
 
 
 /*** LINKING CLOSURES ***/
 
+#ifdef TICKY_TICKY
 I_
 I_
-_ScanLink_1_0(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 1, 0);
-    return(FIXED_HS + 1);      /* SPEC_VHS is defined to be 0, so "size" really is 1 */
+_ScanLink_0_0(STG_NO_ARGS) {
+    I_ size = 0; /* NB: SPEC_VHS is *defined* to be zero */
+    DEBUG_SCAN_LINK("SPEC", size, 0);
+    return(FIXED_HS + size);
 }
 }
+#endif
+
 I_
 I_
-_ScanLink_2_0(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 2, 0);
-    return(FIXED_HS + 2);
+_ScanLink_1_0(STG_NO_ARGS) {
+    I_ size = 1; /* NB: SPEC_VHS is *defined* to be zero */
+    DEBUG_SCAN_LINK("SPEC", size, 0);
+    return(FIXED_HS + size);
 }
 I_
 }
 I_
-_ScanLink_3_0(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 3, 0);
-    return(FIXED_HS + 3);
+_ScanLink_1_1(STG_NO_ARGS) {
+    I_ size = 1;
+    DEBUG_SCAN_LINK("SPEC", size, 1);
+    SPEC_LINK_LOCATION(1);
+    return(FIXED_HS + size);
 }
 I_
 }
 I_
-_ScanLink_4_0(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 4, 0);
-    return(FIXED_HS + 4);
+_ScanLink_2_0(STG_NO_ARGS) {
+    I_ size = 2;
+    DEBUG_SCAN_LINK("SPEC", size, 0);
+    return(FIXED_HS + size);
 }
 I_
 }
 I_
-_ScanLink_5_0(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 5, 0);
-    return(FIXED_HS + 5);
-}
-
-I_
 _ScanLink_2_1(STG_NO_ARGS) {
 _ScanLink_2_1(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 2, 1);
+    I_ size = 2;
+    DEBUG_SCAN_LINK("SPEC", size, 1);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(1);
-    return(FIXED_HS + 2);
+    return(FIXED_HS + size);
 }
 I_
 }
 I_
-_ScanLink_3_1(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 3, 1);
+_ScanLink_2_2(STG_NO_ARGS) {
+    I_ size = 2;
+    DEBUG_SCAN_LINK("SPEC", size, 2);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(1);
-    return(FIXED_HS + 3);
+    SPEC_LINK_LOCATION(2);
+    return(FIXED_HS + size);
 }
 I_
 }
 I_
-_ScanLink_3_2(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 3, 2);
-    SPEC_LINK_LOCATION(1);
-    SPEC_LINK_LOCATION(2);
-    return(FIXED_HS + 3);
+_ScanLink_3_0(STG_NO_ARGS) {
+    I_ size = 3;
+    DEBUG_SCAN_LINK("SPEC", size, 0);
+    return(FIXED_HS + size);
 }
 }
-
 I_
 I_
-_ScanLink_1_1(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 1, 1);
+_ScanLink_3_1(STG_NO_ARGS) {
+    I_ size = 3;
+    DEBUG_SCAN_LINK("SPEC", size, 1);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(1);
-    return(FIXED_HS + 1);
+    return(FIXED_HS + size);
 }
 I_
 }
 I_
-_ScanLink_2_2(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 2, 2);
+_ScanLink_3_2(STG_NO_ARGS) {
+    I_ size = 3;
+    DEBUG_SCAN_LINK("SPEC", size, 2);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
-    return(FIXED_HS + 2);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_3_3(STG_NO_ARGS) {
 }
 I_
 _ScanLink_3_3(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 3, 3);
+    I_ size = 3;
+    DEBUG_SCAN_LINK("SPEC", size, 3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
-    return(FIXED_HS + 3);
+    return(FIXED_HS + size);
+}
+I_
+_ScanLink_4_0(STG_NO_ARGS) {
+    I_ size = 4;
+    DEBUG_SCAN_LINK("SPEC", size, 0);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_4_4(STG_NO_ARGS) {
 }
 I_
 _ScanLink_4_4(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 4, 4);
+    I_ size = 4;
+    DEBUG_SCAN_LINK("SPEC", size, 4);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(4);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(4);
-    return(FIXED_HS + 4);
+    return(FIXED_HS + size);
+}
+I_
+_ScanLink_5_0(STG_NO_ARGS) {
+    I_ size = 5;
+    DEBUG_SCAN_LINK("SPEC", size, 0);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_5_5(STG_NO_ARGS) {
 }
 I_
 _ScanLink_5_5(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 5, 5);
+    I_ size = 5;
+    DEBUG_SCAN_LINK("SPEC", size, 5);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(4);
     SPEC_LINK_LOCATION(5);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(4);
     SPEC_LINK_LOCATION(5);
-    return(FIXED_HS + 5);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_6_6(STG_NO_ARGS) {
 }
 I_
 _ScanLink_6_6(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 6, 6);
+    I_ size = 6;
+    DEBUG_SCAN_LINK("SPEC", size, 6);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(4);
     SPEC_LINK_LOCATION(5);
     SPEC_LINK_LOCATION(6);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(4);
     SPEC_LINK_LOCATION(5);
     SPEC_LINK_LOCATION(6);
-    return(FIXED_HS + 6);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_7_7(STG_NO_ARGS) {
 }
 I_
 _ScanLink_7_7(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 7, 7);
+    I_ size = 7;
+    DEBUG_SCAN_LINK("SPEC", size, 7);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
@@ -485,11 +490,12 @@ _ScanLink_7_7(STG_NO_ARGS) {
     SPEC_LINK_LOCATION(5);
     SPEC_LINK_LOCATION(6);
     SPEC_LINK_LOCATION(7);
     SPEC_LINK_LOCATION(5);
     SPEC_LINK_LOCATION(6);
     SPEC_LINK_LOCATION(7);
-    return(FIXED_HS + 7);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_8_8(STG_NO_ARGS) {
 }
 I_
 _ScanLink_8_8(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 8, 8);
+    I_ size = 8;
+    DEBUG_SCAN_LINK("SPEC", size, 8);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
@@ -498,11 +504,12 @@ _ScanLink_8_8(STG_NO_ARGS) {
     SPEC_LINK_LOCATION(6);
     SPEC_LINK_LOCATION(7);
     SPEC_LINK_LOCATION(8);
     SPEC_LINK_LOCATION(6);
     SPEC_LINK_LOCATION(7);
     SPEC_LINK_LOCATION(8);
-    return(FIXED_HS + 8);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_9_9(STG_NO_ARGS) {
 }
 I_
 _ScanLink_9_9(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 9, 9);
+    I_ size = 9;
+    DEBUG_SCAN_LINK("SPEC", size, 9);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
@@ -512,11 +519,12 @@ _ScanLink_9_9(STG_NO_ARGS) {
     SPEC_LINK_LOCATION(7);
     SPEC_LINK_LOCATION(8);
     SPEC_LINK_LOCATION(9);
     SPEC_LINK_LOCATION(7);
     SPEC_LINK_LOCATION(8);
     SPEC_LINK_LOCATION(9);
-    return(FIXED_HS + 9);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_10_10(STG_NO_ARGS) {
 }
 I_
 _ScanLink_10_10(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 10, 10);
+    I_ size = 10;
+    DEBUG_SCAN_LINK("SPEC", size, 10);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
@@ -527,11 +535,12 @@ _ScanLink_10_10(STG_NO_ARGS) {
     SPEC_LINK_LOCATION(8);
     SPEC_LINK_LOCATION(9);
     SPEC_LINK_LOCATION(10);
     SPEC_LINK_LOCATION(8);
     SPEC_LINK_LOCATION(9);
     SPEC_LINK_LOCATION(10);
-    return(FIXED_HS + 10);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_11_11(STG_NO_ARGS) {
 }
 I_
 _ScanLink_11_11(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 11, 11);
+    I_ size = 11;
+    DEBUG_SCAN_LINK("SPEC", size, 11);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
@@ -543,11 +552,12 @@ _ScanLink_11_11(STG_NO_ARGS) {
     SPEC_LINK_LOCATION(9);
     SPEC_LINK_LOCATION(10);
     SPEC_LINK_LOCATION(11);
     SPEC_LINK_LOCATION(9);
     SPEC_LINK_LOCATION(10);
     SPEC_LINK_LOCATION(11);
-    return(FIXED_HS + 11);
+    return(FIXED_HS + size);
 }
 I_
 _ScanLink_12_12(STG_NO_ARGS) {
 }
 I_
 _ScanLink_12_12(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("SPEC", 12, 12);
+    I_ size = 12;
+    DEBUG_SCAN_LINK("SPEC", size, 12);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
     SPEC_LINK_LOCATION(1);
     SPEC_LINK_LOCATION(2);
     SPEC_LINK_LOCATION(3);
@@ -560,7 +570,7 @@ _ScanLink_12_12(STG_NO_ARGS) {
     SPEC_LINK_LOCATION(10);
     SPEC_LINK_LOCATION(11);
     SPEC_LINK_LOCATION(12);
     SPEC_LINK_LOCATION(10);
     SPEC_LINK_LOCATION(11);
     SPEC_LINK_LOCATION(12);
-    return(FIXED_HS + 12);
+    return(FIXED_HS + size);
 }
 \end{code}
 
 }
 \end{code}
 
@@ -572,94 +582,95 @@ Scan-linking revertible black holes with underlying @SPEC@ closures.
 I_ 
 _ScanLink_RBH_2_1(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_2_1(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 2, 1);
+    I_ size = 2 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
-    return(FIXED_HS + 2); /* ???? but SPEC_RBH_VHS is *not* zero! */
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_3_1(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_3_1(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 3, 1);
+    I_ size = 3 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
-    return(FIXED_HS + 3);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_3_3(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_3_3(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 3, 3);
+    I_ size = 3 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 3);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
-    return(FIXED_HS + 3);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_4_1(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_4_1(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 4, 1);
+    I_ size = 4 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
-    return(FIXED_HS + 4);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_4_4(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_4_4(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 4, 4);
+    I_ size = 4 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 4);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
-    return(FIXED_HS + 4);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_5_1(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_5_1(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 5, 1);
+    I_ size = 5 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
-    return(FIXED_HS + 5);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_5_5(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_5_5(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 5, 5);
+    I_ size = 5 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 5);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3);
-    return(FIXED_HS + 5);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_6_6(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_6_6(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 6, 6);
+    I_ size = 6 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 6);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4);
-    return(FIXED_HS + 6);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_7_7(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_7_7(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 7, 7);
+    I_ size = 7 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 7);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5);
-    return(FIXED_HS + 7);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_8_8(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_8_8(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 8, 8);
+    I_ size = 8 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 8);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
@@ -667,13 +678,13 @@ _ScanLink_RBH_8_8(STG_NO_ARGS)
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6);
-    return(FIXED_HS + 8);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_9_9(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_9_9(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 9, 9);
+    I_ size = 9 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 9);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
@@ -682,13 +693,13 @@ _ScanLink_RBH_9_9(STG_NO_ARGS)
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7);
-    return(FIXED_HS + 9);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_10_10(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_10_10(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 10, 10);
+    I_ size = 10 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 10);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
@@ -698,13 +709,13 @@ _ScanLink_RBH_10_10(STG_NO_ARGS)
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8);
-    return(FIXED_HS + 10);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_11_11(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_11_11(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 11, 11);
+    I_ size = 11 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 11);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
@@ -715,13 +726,13 @@ _ScanLink_RBH_11_11(STG_NO_ARGS)
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 9);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 9);
-    return(FIXED_HS + 11);
+    return(FIXED_HS + size);
 }
 }
-
 I_ 
 _ScanLink_RBH_12_12(STG_NO_ARGS)
 {
 I_ 
 _ScanLink_RBH_12_12(STG_NO_ARGS)
 {
-    DEBUG_SCAN_LINK("SRBH", 12, 12);
+    I_ size = 12 + SPEC_RBH_VHS;
+    DEBUG_SCAN_LINK("SRBH", size, 12);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2);
@@ -733,10 +744,9 @@ _ScanLink_RBH_12_12(STG_NO_ARGS)
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 9);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 10);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 9);
     LINK_LOCATION(SPEC_RBH_BQ_LOCN + 10);
-    return(FIXED_HS + 12);
+    return(FIXED_HS + size);
 }
 #endif
 }
 #endif
-
 \end{code}
 
 Scan-linking a MallocPtr is straightforward: exactly the same as
 \end{code}
 
 Scan-linking a MallocPtr is straightforward: exactly the same as
@@ -744,10 +754,11 @@ Scan-linking a MallocPtr is straightforward: exactly the same as
 
 \begin{code}
 #ifndef PAR
 
 \begin{code}
 #ifndef PAR
-StgInt
+I_
 _ScanLink_MallocPtr(STG_NO_ARGS) {
 _ScanLink_MallocPtr(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("MallocPtr", MallocPtr_SIZE, 0);
-    return(FIXED_HS + MallocPtr_SIZE);
+    I_ size = MallocPtr_SIZE;
+    DEBUG_SCAN_LINK("MallocPtr", size, 0);
+    return(FIXED_HS + size);
 }
 #endif /* !PAR */
 \end{code}
 }
 #endif /* !PAR */
 \end{code}
@@ -758,54 +769,69 @@ Back to the main feature...
 
 /*** MOVING CLOSURES ***/
 
 
 /*** MOVING CLOSURES ***/
 
+#ifdef TICKY_TICKY
+I_
+_ScanMove_0(STG_NO_ARGS) {
+    I_ size = 0; /* NB: SPEC_VHS defined to be zero, so 0 really is the "size" */
+    DEBUG_SCAN_MOVE("CONST", size);
+    SLIDE_FIXED_HDR;
+    return(FIXED_HS + size);
+}
+#endif
 I_
 _ScanMove_1(STG_NO_ARGS) {
 I_
 _ScanMove_1(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 1);
+    I_ size = 1; /* NB: SPEC_VHS defined to be zero, so 1 really is the "size" */
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
-    return(FIXED_HS + 1); /* NB: SPEC_VHS defined to be zero, so 1 really is the "size" */
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_2(STG_NO_ARGS) {
 }
 I_
 _ScanMove_2(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 2);
+    I_ size = 2;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
-    return(FIXED_HS + 2);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_3(STG_NO_ARGS) {
 }
 I_
 _ScanMove_3(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 3);
+    I_ size = 3;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SPEC_SLIDE_WORD(3);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SPEC_SLIDE_WORD(3);
-    return(FIXED_HS + 3);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_4(STG_NO_ARGS) {
 }
 I_
 _ScanMove_4(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 4);
+    I_ size = 4;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SPEC_SLIDE_WORD(3);
     SPEC_SLIDE_WORD(4);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SPEC_SLIDE_WORD(3);
     SPEC_SLIDE_WORD(4);
-    return(FIXED_HS + 4);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_5(STG_NO_ARGS) {
 }
 I_
 _ScanMove_5(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 5);
+    I_ size = 5;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SPEC_SLIDE_WORD(3);
     SPEC_SLIDE_WORD(4);
     SPEC_SLIDE_WORD(5);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SPEC_SLIDE_WORD(3);
     SPEC_SLIDE_WORD(4);
     SPEC_SLIDE_WORD(5);
-    return(FIXED_HS + 5);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_6(STG_NO_ARGS) {
 }
 I_
 _ScanMove_6(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 6);
+    I_ size = 6;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -813,11 +839,12 @@ _ScanMove_6(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(4);
     SPEC_SLIDE_WORD(5);
     SPEC_SLIDE_WORD(6);
     SPEC_SLIDE_WORD(4);
     SPEC_SLIDE_WORD(5);
     SPEC_SLIDE_WORD(6);
-    return(FIXED_HS + 6);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_7(STG_NO_ARGS) {
 }
 I_
 _ScanMove_7(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 7);
+    I_ size = 7;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -826,11 +853,12 @@ _ScanMove_7(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(5);
     SPEC_SLIDE_WORD(6);
     SPEC_SLIDE_WORD(7);
     SPEC_SLIDE_WORD(5);
     SPEC_SLIDE_WORD(6);
     SPEC_SLIDE_WORD(7);
-    return(FIXED_HS + 7);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_8(STG_NO_ARGS) {
 }
 I_
 _ScanMove_8(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 8);
+    I_ size = 8;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -840,11 +868,12 @@ _ScanMove_8(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(6);
     SPEC_SLIDE_WORD(7);
     SPEC_SLIDE_WORD(8);
     SPEC_SLIDE_WORD(6);
     SPEC_SLIDE_WORD(7);
     SPEC_SLIDE_WORD(8);
-    return(FIXED_HS + 8);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_9(STG_NO_ARGS) {
 }
 I_
 _ScanMove_9(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 9);
+    I_ size = 9;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -855,11 +884,12 @@ _ScanMove_9(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(7);
     SPEC_SLIDE_WORD(8);
     SPEC_SLIDE_WORD(9);
     SPEC_SLIDE_WORD(7);
     SPEC_SLIDE_WORD(8);
     SPEC_SLIDE_WORD(9);
-    return(FIXED_HS + 9);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_10(STG_NO_ARGS) {
 }
 I_
 _ScanMove_10(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 10);
+    I_ size = 10;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -871,11 +901,12 @@ _ScanMove_10(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(8);
     SPEC_SLIDE_WORD(9);
     SPEC_SLIDE_WORD(10);
     SPEC_SLIDE_WORD(8);
     SPEC_SLIDE_WORD(9);
     SPEC_SLIDE_WORD(10);
-    return(FIXED_HS + 10);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_11(STG_NO_ARGS) {
 }
 I_
 _ScanMove_11(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 11);
+    I_ size = 11;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -888,11 +919,12 @@ _ScanMove_11(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(9);
     SPEC_SLIDE_WORD(10);
     SPEC_SLIDE_WORD(11);
     SPEC_SLIDE_WORD(9);
     SPEC_SLIDE_WORD(10);
     SPEC_SLIDE_WORD(11);
-    return(FIXED_HS + 11);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_12(STG_NO_ARGS) {
 }
 I_
 _ScanMove_12(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SPEC", 12);
+    I_ size = 12;
+    DEBUG_SCAN_MOVE("SPEC", size);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
     SLIDE_FIXED_HDR;
     SPEC_SLIDE_WORD(1);
     SPEC_SLIDE_WORD(2);
@@ -906,13 +938,14 @@ _ScanMove_12(STG_NO_ARGS) {
     SPEC_SLIDE_WORD(10);
     SPEC_SLIDE_WORD(11);
     SPEC_SLIDE_WORD(12);
     SPEC_SLIDE_WORD(10);
     SPEC_SLIDE_WORD(11);
     SPEC_SLIDE_WORD(12);
-    return(FIXED_HS + 12);
+    return(FIXED_HS + size);
 }
 
 #if defined(PAR) && defined(GC_MUT_REQUIRED)
 I_
 _ScanMove_RBH_2(STG_NO_ARGS) {
 }
 
 #if defined(PAR) && defined(GC_MUT_REQUIRED)
 I_
 _ScanMove_RBH_2(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 2);
+    I_ size = 2 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
 
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
 
@@ -920,11 +953,12 @@ _ScanMove_RBH_2(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 2); /* ???? SPEC_RBH_VHS is *not* zero! */
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_3(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_3(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 3);
+    I_ size = 3 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -933,11 +967,12 @@ _ScanMove_RBH_3(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 3);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_4(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_4(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 4);
+    I_ size = 4 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -947,11 +982,12 @@ _ScanMove_RBH_4(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 4);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_5(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_5(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 5);
+    I_ size = 5 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -962,11 +998,12 @@ _ScanMove_RBH_5(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 5);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_6(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_6(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 6);
+    I_ size = 6 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -978,11 +1015,12 @@ _ScanMove_RBH_6(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 6);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_7(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_7(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 7);
+    I_ size = 7 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -995,11 +1033,12 @@ _ScanMove_RBH_7(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 7);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_8(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_8(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 8);
+    I_ size = 8 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -1013,11 +1052,12 @@ _ScanMove_RBH_8(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 8);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_9(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_9(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 9);
+    I_ size = 9 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -1032,11 +1072,12 @@ _ScanMove_RBH_9(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 9);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_10(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_10(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 10);
+    I_ size = 10 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -1052,11 +1093,12 @@ _ScanMove_RBH_10(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 10);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_11(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_11(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 11);
+    I_ size = 11 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -1073,11 +1115,12 @@ _ScanMove_RBH_11(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 11);
+    return(FIXED_HS + size);
 }
 I_
 _ScanMove_RBH_12(STG_NO_ARGS) {
 }
 I_
 _ScanMove_RBH_12(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("SRBH", 12);
+    I_ size = 12 + SPEC_RBH_VHS;
+    DEBUG_SCAN_MOVE("SRBH", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(SPEC_RBH_HS + 0);
     SLIDE_WORD(SPEC_RBH_HS + 1);
@@ -1095,7 +1138,7 @@ _ScanMove_RBH_12(STG_NO_ARGS) {
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
     MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables;
     StorageMgrInfo.OldMutables = (P_) New;
 
-    return(FIXED_HS + 12);
+    return(FIXED_HS + size);
 }
 #endif
 \end{code}
 }
 #endif
 \end{code}
@@ -1106,12 +1149,13 @@ new MallocPtr list.
 
 \begin{code}
 #ifndef PAR
 
 \begin{code}
 #ifndef PAR
-StgInt
+I_
 _ScanMove_MallocPtr(STG_NO_ARGS) {
 _ScanMove_MallocPtr(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("MallocPtr", MallocPtr_SIZE);
+    I_ size = MallocPtr_SIZE;
+    DEBUG_SCAN_MOVE("MallocPtr", size);
 
 
-#if defined(_GC_DEBUG)
-    if (SM_trace & 16) {
+#if defined(DEBUG)
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
       printf("Moving MallocPtr(%x)=<%x,%x,%x>", Scan, Scan[0], Scan[1], Scan[2]);
       printf(" Data = %x, Next = %x\n", 
             MallocPtr_CLOSURE_DATA(Scan), MallocPtr_CLOSURE_LINK(Scan) );
       printf("Moving MallocPtr(%x)=<%x,%x,%x>", Scan, Scan[0], Scan[1], Scan[2]);
       printf(" Data = %x, Next = %x\n", 
             MallocPtr_CLOSURE_DATA(Scan), MallocPtr_CLOSURE_LINK(Scan) );
@@ -1122,8 +1166,8 @@ _ScanMove_MallocPtr(STG_NO_ARGS) {
     MallocPtr_SLIDE_DATA;
     MallocPtr_RELINK;
 
     MallocPtr_SLIDE_DATA;
     MallocPtr_RELINK;
 
-#if defined(_GC_DEBUG)
-    if (SM_trace & 16) {
+#if defined(DEBUG)
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) {
       printf("Moved MallocPtr(%x)=<%x,_,%x,%x,%x>", New, New[0], New[1], New[2], New[3]);
       printf(" Data = %x, Next = %x", 
             MallocPtr_CLOSURE_DATA(New), MallocPtr_CLOSURE_LINK(New) );
       printf("Moved MallocPtr(%x)=<%x,_,%x,%x,%x>", New, New[0], New[1], New[2], New[3]);
       printf(" Data = %x, Next = %x", 
             MallocPtr_CLOSURE_DATA(New), MallocPtr_CLOSURE_LINK(New) );
@@ -1131,7 +1175,7 @@ _ScanMove_MallocPtr(STG_NO_ARGS) {
     }
 #endif
 
     }
 #endif
 
-    return(FIXED_HS + MallocPtr_SIZE);
+    return(FIXED_HS + size);
 }
 #endif /* !PAR */
 \end{code}
 }
 #endif /* !PAR */
 \end{code}
@@ -1373,48 +1417,50 @@ _ScanMove_Data(STG_NO_ARGS) {
 
 I_
 _ScanLink_BH_U(STG_NO_ARGS) {
 
 I_
 _ScanLink_BH_U(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("BH  ", MIN_UPD_SIZE, 0);
-    return(FIXED_HS + BH_U_SIZE); /* size includes _VHS */
-    /* NB: pretty intimate knowledge about BH closure layout */
+    I_ size = BH_U_SIZE;
+    DEBUG_SCAN_LINK("BH  ", size, 0);
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_BH_U(STG_NO_ARGS) {
 }
 
 I_
 _ScanMove_BH_U(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("BH  ", MIN_UPD_SIZE);
+    I_ size = BH_U_SIZE;
+    DEBUG_SCAN_MOVE("BH  ", size);
     SLIDE_FIXED_HDR;
     SLIDE_FIXED_HDR;
-    return(FIXED_HS  + BH_U_SIZE);
-    /* ditto */
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanLink_BH_N(STG_NO_ARGS) {
 }
 
 I_
 _ScanLink_BH_N(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("BH N", MIN_NONUPD_SIZE, 0);
-    return(FIXED_HS + BH_N_SIZE); /* size includes _VHS */
-    /* NB: pretty intimate knowledge about BH closure layout */
+    I_ size = BH_N_SIZE;
+    DEBUG_SCAN_LINK("BH N", size, 0);
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_BH_N(STG_NO_ARGS) {
 }
 
 I_
 _ScanMove_BH_N(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("BH N",MIN_NONUPD_SIZE);
+    I_ size = BH_N_SIZE;
+    DEBUG_SCAN_MOVE("BH N", size);
     SLIDE_FIXED_HDR;
     SLIDE_FIXED_HDR;
-    return(FIXED_HS + BH_N_SIZE);
-    /* ditto */
+    return(FIXED_HS + size);
 }
 
 }
 
-#ifdef USE_COST_CENTRES
+#if defined(PROFILING) || defined(TICKY_TICKY)
 I_
 _ScanLink_PI(STG_NO_ARGS) {
 I_
 _ScanLink_PI(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("PI  ", IND_CLOSURE_SIZE(dummy), 1);
+    I_ size = IND_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_LINK("PI  ", size, 1);
     LINK_LOCATION(IND_HS);
     LINK_LOCATION(IND_HS);
-    return(FIXED_HS + IND_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/);
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_PI(STG_NO_ARGS) {
 }
 
 I_
 _ScanMove_PI(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("PI  ", IND_CLOSURE_SIZE(dummy));
+    I_ size = IND_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_MOVE("PI  ", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(IND_HS);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(IND_HS);
-    return(FIXED_HS + IND_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/);
+    return(FIXED_HS + size);
 }
 #endif
 
 }
 #endif
 
@@ -1430,13 +1476,15 @@ Linking and Marking Routines for FetchMes and stack objects.
 
 I_
 _ScanLink_FetchMe(STG_NO_ARGS) {
 
 I_
 _ScanLink_FetchMe(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("FME ", MIN_UPD_SIZE, 0);
-    return(FIXED_HS + FETCHME_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/);
+    I_ size = FETCHME_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_LINK("FME ", size, 0);
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_FetchMe(STG_NO_ARGS) {
 }
 
 I_
 _ScanMove_FetchMe(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("FME ",MIN_UPD_SIZE);
+    I_ size = FETCHME_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_MOVE("FME ", size);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(FETCHME_GA_LOCN);
     ASSERT(GALAlookup(FETCHME_GA(New)) != NULL);
     SLIDE_FIXED_HDR;
     SLIDE_WORD(FETCHME_GA_LOCN);
     ASSERT(GALAlookup(FETCHME_GA(New)) != NULL);
@@ -1447,23 +1495,25 @@ _ScanMove_FetchMe(STG_NO_ARGS) {
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
-    return(FIXED_HS + FETCHME_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/);
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanLink_BF(STG_NO_ARGS) 
 {
 }
 
 I_
 _ScanLink_BF(STG_NO_ARGS) 
 {
-    DEBUG_SCAN_LINK("BF", BF_HS, 2 /*possibly wrong (WDP 95/07)*/);
+    I_ size = BF_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_LINK("BF", size, 2);
 
     LINK_LOCATION(BF_LINK_LOCN);
     LINK_LOCATION(BF_NODE_LOCN);
 
     LINK_LOCATION(BF_LINK_LOCN);
     LINK_LOCATION(BF_NODE_LOCN);
-    return(FIXED_HS + BF_CLOSURE_SIZE(dummy));
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_BF(STG_NO_ARGS) 
 {
     I_ count;
 }
 
 I_
 _ScanMove_BF(STG_NO_ARGS) 
 {
     I_ count;
+    I_ size = BF_CLOSURE_SIZE(dummy);
 
     SLIDE_FIXED_HDR;
     for (count = FIXED_HS; count < FIXED_HS + BF_VHS; count++) {
 
     SLIDE_FIXED_HDR;
     for (count = FIXED_HS; count < FIXED_HS + BF_VHS; count++) {
@@ -1481,21 +1531,23 @@ _ScanMove_BF(STG_NO_ARGS)
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
-    return(FIXED_HS + BF_CLOSURE_SIZE(dummy));
+    return(FIXED_HS + size);
 }
 
 #endif /* PAR */
 
 I_
 _ScanLink_BQ(STG_NO_ARGS) {
 }
 
 #endif /* PAR */
 
 I_
 _ScanLink_BQ(STG_NO_ARGS) {
-    DEBUG_SCAN_LINK("BQ  ", BQ_CLOSURE_SIZE(dummy), BQ_CLOSURE_NoPTRS(Scan));
+    I_ size = BQ_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_LINK("BQ  ", size, BQ_CLOSURE_NoPTRS(Scan));
     LINK_LOCATION(BQ_HS);
     LINK_LOCATION(BQ_HS);
-    return(FIXED_HS + BQ_CLOSURE_SIZE(dummy));
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_BQ(STG_NO_ARGS) {
 }
 
 I_
 _ScanMove_BQ(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("BQ  ", BQ_CLOSURE_SIZE(dummy));
+    I_ size = BQ_CLOSURE_SIZE(dummy);
+    DEBUG_SCAN_MOVE("BQ  ", size);
 
     SLIDE_FIXED_HDR;
     SLIDE_WORD(BQ_HS);
 
     SLIDE_FIXED_HDR;
     SLIDE_WORD(BQ_HS);
@@ -1506,7 +1558,7 @@ _ScanMove_BQ(STG_NO_ARGS) {
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
-    return(FIXED_HS + BQ_CLOSURE_SIZE(dummy));
+    return(FIXED_HS + size);
 }
 
 I_
 }
 
 I_
@@ -1515,8 +1567,9 @@ _ScanLink_TSO(STG_NO_ARGS)
     STGRegisterTable *r = TSO_INTERNAL_PTR(Scan);
     W_ liveness = r->rLiveness;
     I_ i;
     STGRegisterTable *r = TSO_INTERNAL_PTR(Scan);
     W_ liveness = r->rLiveness;
     I_ i;
+    I_ size = TSO_VHS + TSO_CTS_SIZE;
 
 
-    DEBUG_SCAN_LINK("TSO", TSO_HS + TSO_CTS_SIZE, 0/*wrong*/);
+    DEBUG_SCAN_LINK("TSO", size, 0/*wrong*/);
 
     LINK_LOCATION(TSO_LINK_LOCN);
     LINK_LOCATION(((P_) &r->rStkO) - Scan);
 
     LINK_LOCATION(TSO_LINK_LOCN);
     LINK_LOCATION(((P_) &r->rStkO) - Scan);
@@ -1525,13 +1578,14 @@ _ScanLink_TSO(STG_NO_ARGS)
            LINK_LOCATION(((P_) &r->rR[i].p) - Scan)
        }
     }
            LINK_LOCATION(((P_) &r->rR[i].p) - Scan)
        }
     }
-    return(TSO_HS + TSO_CTS_SIZE);
+    return(FIXED_HS + size);
 }
 
 I_
 _ScanMove_TSO(STG_NO_ARGS) 
 {
     I_ count;
 }
 
 I_
 _ScanMove_TSO(STG_NO_ARGS) 
 {
     I_ count;
+    I_ size = TSO_VHS + TSO_CTS_SIZE;
 
     SLIDE_FIXED_HDR;
     for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
 
     SLIDE_FIXED_HDR;
     for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
@@ -1548,7 +1602,7 @@ _ScanMove_TSO(STG_NO_ARGS)
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
-    return(TSO_HS + TSO_CTS_SIZE);
+    return(FIXED_HS + size);
 }
 
 I_
 }
 
 I_
@@ -1562,7 +1616,7 @@ _ScanLink_StkO(STG_NO_ARGS) {
     LINK_LOCATION(STKO_LINK_LOCN);
 
     /* Link the locations in the A stack */
     LINK_LOCATION(STKO_LINK_LOCN);
 
     /* Link the locations in the A stack */
-    DEBUG_SCAN_LINK("STKO", size, cts_size - STKO_SpA_OFFSET(SCAN) + 1);
+    DEBUG_SCAN_LINK("STKO", size, cts_size - STKO_SpA_OFFSET(Scan) + 1);
     for (count = STKO_SpA_OFFSET(Scan); count <= cts_size; count++) {
        STKO_LINK_LOCATION(count);
     }
     for (count = STKO_SpA_OFFSET(Scan); count <= cts_size; count++) {
        STKO_LINK_LOCATION(count);
     }
@@ -1576,10 +1630,8 @@ _ScanLink_StkO(STG_NO_ARGS) {
        sub = STKO_CLOSURE_OFFSET(Scan, subptr);
     }
 
        sub = STKO_CLOSURE_OFFSET(Scan, subptr);
     }
 
-    /*
-       I assume what's wanted is the size of the object 
-       rather the number of pointers in the object. KH 
-    */
+    ASSERT(sanityChk_StkO(Scan));
+
     return(FIXED_HS + size);
 }
 
     return(FIXED_HS + size);
 }
 
@@ -1600,7 +1652,7 @@ _ScanMove_StkO(STG_NO_ARGS) {
     DEBUG_SCAN_MOVE("STKO", size);
 
     SLIDE_FIXED_HDR;
     DEBUG_SCAN_MOVE("STKO", size);
 
     SLIDE_FIXED_HDR;
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
     SLIDE_WORD(STKO_ADEP_LOCN);
     SLIDE_WORD(STKO_BDEP_LOCN);
 #endif
     SLIDE_WORD(STKO_ADEP_LOCN);
     SLIDE_WORD(STKO_BDEP_LOCN);
 #endif
@@ -1640,6 +1692,8 @@ _ScanMove_StkO(STG_NO_ARGS) {
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
     StorageMgrInfo.OldMutables = (P_) New;
 #endif
 
+    /* ToDo: ASSERT(sanityChk_StkO(Scan or New)); ??? */
+
     return(FIXED_HS + size);
 }
 
     return(FIXED_HS + size);
 }
 
@@ -1648,19 +1702,6 @@ _ScanMove_StkO(STG_NO_ARGS) {
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-#if defined(GCgn)
-I_
-_ScanMove_OldRoot(STG_NO_ARGS) {
-    DEBUG_SCAN_MOVE("OLDR", 2);
-    SLIDE_FIXED_HDR;
-    IND_CLOSURE_PTR(New) = IND_CLOSURE_PTR(Scan);
-    IND_CLOSURE_LINK(New) = (W_) genInfo.OldInNew;
-    genInfo.OldInNew = New;
-    genInfo.OldInNewno++;
-    return(IND_HS + MIN_UPD_SIZE); /* this looks wrong (WDP 95/07) */
-}
-#endif /* GCgn */
-
 /*** Dummy Entries -- Should not be entered ***/
 
 /* Should not be in a .lc file either...  --JSM */
 /*** Dummy Entries -- Should not be entered ***/
 
 /* Should not be in a .lc file either...  --JSM */
@@ -1691,5 +1732,4 @@ STGFUN(_Dummy_CharLike_entry) {
 }
 
 #endif /* _INFO_COMPACTING */
 }
 
 #endif /* _INFO_COMPACTING */
-
 \end{code}
 \end{code}
index 2bc6ab2..118a8a0 100644 (file)
@@ -125,77 +125,82 @@ RegisterTable ScavRegTable;
 
 /*** DEBUGGING MACROS ***/
 
 
 /*** DEBUGGING MACROS ***/
 
-#if defined(_GC_DEBUG)
+#if defined(DEBUG)
 
 #define DEBUG_SCAV(s,p) \
 
 #define DEBUG_SCAV(s,p) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), s, p)
 
 #define DEBUG_SCAV_GEN(s,p) \
         fprintf(stderr, "Scav: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), s, p)
 
 #define DEBUG_SCAV_GEN(s,p) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, Gen info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), s, p)
 
 #define DEBUG_SCAV_DYN   \
         fprintf(stderr, "Scav: 0x%lx, Gen info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), s, p)
 
 #define DEBUG_SCAV_DYN   \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, Dyn info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), DYN_CLOSURE_SIZE(Scav), DYN_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_TUPLE \
         fprintf(stderr, "Scav: 0x%lx, Dyn info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), DYN_CLOSURE_SIZE(Scav), DYN_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_TUPLE \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, Tuple info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), TUPLE_CLOSURE_SIZE(Scav), TUPLE_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_MUTUPLE \
         fprintf(stderr, "Scav: 0x%lx, Tuple info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), TUPLE_CLOSURE_SIZE(Scav), TUPLE_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_MUTUPLE \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, MuTuple info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), MUTUPLE_CLOSURE_SIZE(Scav), MUTUPLE_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_DATA  \
         fprintf(stderr, "Scav: 0x%lx, MuTuple info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), MUTUPLE_CLOSURE_SIZE(Scav), MUTUPLE_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_DATA  \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, Data info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), DATA_CLOSURE_SIZE(Scav))
 
 #define DEBUG_SCAV_BH(s)  \
         fprintf(stderr, "Scav: 0x%lx, Data info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), DATA_CLOSURE_SIZE(Scav))
 
 #define DEBUG_SCAV_BH(s)  \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, BH info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), s)
 
 #define DEBUG_SCAV_IND \
         fprintf(stderr, "Scav: 0x%lx, BH info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), s)
 
 #define DEBUG_SCAV_IND \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, IND info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
 
 #define DEBUG_SCAV_PERM_IND \
         fprintf(stderr, "Scav: 0x%lx, IND info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
 
 #define DEBUG_SCAV_PERM_IND \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: 0x%lx, PI info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
 
 #define DEBUG_SCAV_OLDROOT(s) \
         fprintf(stderr, "Scav: 0x%lx, PI info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
 
 #define DEBUG_SCAV_OLDROOT(s) \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
         fprintf(stderr, "Scav: OLDROOT 0x%lx, info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), s)
 
 #ifdef CONCURRENT
 #define DEBUG_SCAV_BQ \
         fprintf(stderr, "Scav: OLDROOT 0x%lx, info 0x%lx, size %ld\n", \
                Scav, INFO_PTR(Scav), s)
 
 #ifdef CONCURRENT
 #define DEBUG_SCAV_BQ \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Scav: 0x%lx, BQ info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), BQ_CLOSURE_SIZE(Scav), BQ_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_TSO  \
         fprintf(stderr, "Scav: 0x%lx, BQ info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), BQ_CLOSURE_SIZE(Scav), BQ_CLOSURE_NoPTRS(Scav))
 
 #define DEBUG_SCAV_TSO  \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Scav TSO: 0x%lx\n", \
                Scav)
 
 #define DEBUG_SCAV_STKO  \
         fprintf(stderr, "Scav TSO: 0x%lx\n", \
                Scav)
 
 #define DEBUG_SCAV_STKO  \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Scav StkO: 0x%lx\n", \
                Scav)
 
 # ifdef PAR
         fprintf(stderr, "Scav StkO: 0x%lx\n", \
                Scav)
 
 # ifdef PAR
+#  define DEBUG_SCAV_RBH(s,p) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
+        fprintf(stderr, "Scav RBH: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
+               Scav, INFO_PTR(Scav), s, p)
+
 #  define DEBUG_SCAV_BF \
 #  define DEBUG_SCAV_BF \
-    if (SM_trace & 2) \
+    if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
         fprintf(stderr, "Scav: 0x%lx, BF info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), BF_CLOSURE_SIZE(dummy), 0)
 # endif
         fprintf(stderr, "Scav: 0x%lx, BF info 0x%lx, size %ld, ptrs %ld\n", \
                Scav, INFO_PTR(Scav), BF_CLOSURE_SIZE(dummy), 0)
 # endif
@@ -219,6 +224,7 @@ RegisterTable ScavRegTable;
 # define DEBUG_SCAV_TSO
 # define DEBUG_SCAV_STKO
 # ifdef PAR
 # define DEBUG_SCAV_TSO
 # define DEBUG_SCAV_STKO
 # ifdef PAR
+#  define DEBUG_SCAV_RBH(s,p)
 #  define DEBUG_SCAV_BF
 # endif
 #endif
 #  define DEBUG_SCAV_BF
 # endif
 #endif
@@ -226,52 +232,46 @@ RegisterTable ScavRegTable;
 #endif
 
 #define PROFILE_CLOSURE(closure,size) \
 #endif
 
 #define PROFILE_CLOSURE(closure,size) \
-    HEAP_PROFILE_CLOSURE(closure,size); \
-    LIFE_PROFILE_CLOSURE(closure,size)
+    HEAP_PROFILE_CLOSURE(closure,size)
 
 /*** SPECIALISED CODE ***/
 
 
 /*** SPECIALISED CODE ***/
 
+#ifdef TICKY_TICKY
 void
 void
-_Scavenge_1_0(STG_NO_ARGS)
+_Scavenge_0_0(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(1,0);
-    PROFILE_CLOSURE(Scav,1);
-    NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */
-    return;
-}
-void
-_Scavenge_2_0(STG_NO_ARGS)
-{
-    DEBUG_SCAV(2,0);
-    PROFILE_CLOSURE(Scav,2);
-    NEXT_Scav(2);
+    DEBUG_SCAV(0,0);
+    PROFILE_CLOSURE(Scav,0);
+    NEXT_Scav(0); /* because "size" is defined to be 0 (size SPEC_VHS == 0) */
     return;
 }
     return;
 }
+#endif
+
 void
 void
-_Scavenge_3_0(STG_NO_ARGS)
+_Scavenge_1_0(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(3,0);
-    PROFILE_CLOSURE(Scav,3);
-    NEXT_Scav(3);
+    DEBUG_SCAV(1,0);
+    PROFILE_CLOSURE(Scav,1);
+    NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */
     return;
 }
 void
     return;
 }
 void
-_Scavenge_4_0(STG_NO_ARGS)
+_Scavenge_1_1(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(4,0);
-    PROFILE_CLOSURE(Scav,4);
-    NEXT_Scav(4);
+    DEBUG_SCAV(1,1);
+    PROFILE_CLOSURE(Scav,1);
+    SPEC_DO_EVACUATE(1);
+    NEXT_Scav(1);
     return;
 }
 void
     return;
 }
 void
-_Scavenge_5_0(STG_NO_ARGS)
+_Scavenge_2_0(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(5,0);
-    PROFILE_CLOSURE(Scav,5);
-    NEXT_Scav(5);
+    DEBUG_SCAV(2,0);
+    PROFILE_CLOSURE(Scav,2);
+    NEXT_Scav(2);
     return;
 }
     return;
 }
-
 void
 _Scavenge_2_1(STG_NO_ARGS)
 {
 void
 _Scavenge_2_1(STG_NO_ARGS)
 {
@@ -281,44 +281,41 @@ _Scavenge_2_1(STG_NO_ARGS)
     NEXT_Scav(2);
     return;
 }
     NEXT_Scav(2);
     return;
 }
-
 void
 void
-_Scavenge_3_1(STG_NO_ARGS)
+_Scavenge_2_2(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(3,1);
-    PROFILE_CLOSURE(Scav,3);
+    DEBUG_SCAV(2,2);
+    PROFILE_CLOSURE(Scav,2);
     SPEC_DO_EVACUATE(1);
     SPEC_DO_EVACUATE(1);
-    NEXT_Scav(3);
+    SPEC_DO_EVACUATE(2);
+    NEXT_Scav(2);
     return;
 }
 void
     return;
 }
 void
-_Scavenge_3_2(STG_NO_ARGS)
+_Scavenge_3_0(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(3,2);
+    DEBUG_SCAV(3,0);
     PROFILE_CLOSURE(Scav,3);
     PROFILE_CLOSURE(Scav,3);
-    SPEC_DO_EVACUATE(1);
-    SPEC_DO_EVACUATE(2);
     NEXT_Scav(3);
     return;
 }
     NEXT_Scav(3);
     return;
 }
-
 void
 void
-_Scavenge_1_1(STG_NO_ARGS)
+_Scavenge_3_1(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(1,1);
-    PROFILE_CLOSURE(Scav,1);
+    DEBUG_SCAV(3,1);
+    PROFILE_CLOSURE(Scav,3);
     SPEC_DO_EVACUATE(1);
     SPEC_DO_EVACUATE(1);
-    NEXT_Scav(1);
+    NEXT_Scav(3);
     return;
 }
 void
     return;
 }
 void
-_Scavenge_2_2(STG_NO_ARGS)
+_Scavenge_3_2(STG_NO_ARGS)
 {
 {
-    DEBUG_SCAV(2,2);
-    PROFILE_CLOSURE(Scav,2);
+    DEBUG_SCAV(3,2);
+    PROFILE_CLOSURE(Scav,3);
     SPEC_DO_EVACUATE(1);
     SPEC_DO_EVACUATE(2);
     SPEC_DO_EVACUATE(1);
     SPEC_DO_EVACUATE(2);
-    NEXT_Scav(2);
+    NEXT_Scav(3);
     return;
 }
 void
     return;
 }
 void
@@ -333,6 +330,14 @@ _Scavenge_3_3(STG_NO_ARGS)
     return;
 }
 void
     return;
 }
 void
+_Scavenge_4_0(STG_NO_ARGS)
+{
+    DEBUG_SCAV(4,0);
+    PROFILE_CLOSURE(Scav,4);
+    NEXT_Scav(4);
+    return;
+}
+void
 _Scavenge_4_4(STG_NO_ARGS)
 {
     DEBUG_SCAV(4,4);
 _Scavenge_4_4(STG_NO_ARGS)
 {
     DEBUG_SCAV(4,4);
@@ -345,6 +350,14 @@ _Scavenge_4_4(STG_NO_ARGS)
     return;
 }
 void
     return;
 }
 void
+_Scavenge_5_0(STG_NO_ARGS)
+{
+    DEBUG_SCAV(5,0);
+    PROFILE_CLOSURE(Scav,5);
+    NEXT_Scav(5);
+    return;
+}
+void
 _Scavenge_5_5(STG_NO_ARGS)
 {
     DEBUG_SCAV(5,5);
 _Scavenge_5_5(STG_NO_ARGS)
 {
     DEBUG_SCAV(5,5);
@@ -491,31 +504,33 @@ closures.
 void                                   \
 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \
 {                                      \
 void                                   \
 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \
 {                                      \
+    I_ size = n + SPEC_RBH_VHS;                \
     P_ save_Scav;                      \
     P_ save_Scav;                      \
-    DEBUG_SCAV(n,1);                   \
+    DEBUG_SCAV_RBH(size,1);            \
     save_Scav = Scav;                  \
     Scav = OldGen + 1;                 \
     DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN);  \
     Scav = save_Scav;                  \
     save_Scav = Scav;                  \
     Scav = OldGen + 1;                 \
     DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN);  \
     Scav = save_Scav;                  \
-    PROFILE_CLOSURE(Scav,n);           \
-    NEXT_Scav(n); /* ToDo: dodgy size WDP 95/07 */                     \
+    PROFILE_CLOSURE(Scav,size);                \
+    NEXT_Scav(size);                   \
 }
 
 #  define SCAVENGE_SPEC_RBH_N_N(n)     \
 void                                   \
 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 {                                      \
 }
 
 #  define SCAVENGE_SPEC_RBH_N_N(n)     \
 void                                   \
 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 {                                      \
+    I_ size = n + SPEC_RBH_VHS;                \
     int i;                             \
     P_ save_Scav;                      \
     int i;                             \
     P_ save_Scav;                      \
-    DEBUG_SCAV(n,n-1);                 \
+    DEBUG_SCAV_RBH(size,size-1);       \
     save_Scav = Scav;                  \
     Scav = OldGen + 1;                 \
     for(i = 0; i < n - 1; i++) {       \
         DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN + i);  \
     }                                  \
     Scav = save_Scav;                  \
     save_Scav = Scav;                  \
     Scav = OldGen + 1;                 \
     for(i = 0; i < n - 1; i++) {       \
         DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN + i);  \
     }                                  \
     Scav = save_Scav;                  \
-    PROFILE_CLOSURE(Scav,n);           \
-    NEXT_Scav(n);                      \
+    PROFILE_CLOSURE(Scav,size);                \
+    NEXT_Scav(size);                   \
 }
 
 # else
 }
 
 # else
@@ -524,23 +539,25 @@ CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 void                                   \
 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \
 {                                      \
 void                                   \
 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \
 {                                      \
-    DEBUG_SCAV(n,1);                   \
+    I_ size = n + SPEC_RBH_VHS;                \
+    DEBUG_SCAV_RBH(size,1);            \
     DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN);\
     DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN);\
-    PROFILE_CLOSURE(Scav,n);           \
-    NEXT_Scav(n);                      \
+    PROFILE_CLOSURE(Scav,size);                \
+    NEXT_Scav(size);                   \
 }
 
 #  define SCAVENGE_SPEC_RBH_N_N(n)     \
 void                                   \
 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 {                                      \
 }
 
 #  define SCAVENGE_SPEC_RBH_N_N(n)     \
 void                                   \
 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 {                                      \
+    I_ size = n + SPEC_RBH_VHS;                \
     int i;                             \
     int i;                             \
-    DEBUG_SCAV(n,n-1);                 \
+    DEBUG_SCAV_RBH(size,size-1);       \
     for(i = 0; i < n - 1; i++) {       \
         DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN + i);    \
     }                                  \
     for(i = 0; i < n - 1; i++) {       \
         DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN + i);    \
     }                                  \
-    PROFILE_CLOSURE(Scav,n);           \
-    NEXT_Scav(n);                      \
+    PROFILE_CLOSURE(Scav,size);                \
+    NEXT_Scav(size);                   \
 }
 
 # endif
 }
 
 # endif
@@ -580,9 +597,10 @@ SCAVENGE_SPEC_RBH_N_N(12)
 void
 _Scavenge_MallocPtr(STG_NO_ARGS)
 {
 void
 _Scavenge_MallocPtr(STG_NO_ARGS)
 {
-    DEBUG_SCAV(MallocPtr_SIZE,0);
-    PROFILE_CLOSURE(Scav,MallocPtr_SIZE);
-    NEXT_Scav(MallocPtr_SIZE);
+    I_ size = MallocPtr_SIZE;
+    DEBUG_SCAV(size,0);
+    PROFILE_CLOSURE(Scav,size);
+    NEXT_Scav(size);
     return;
 }
 #endif /* !PAR */
     return;
 }
 #endif /* !PAR */
@@ -766,44 +784,51 @@ _Scavenge_MuTuple(STG_NO_ARGS)
 void
 _Scavenge_BH_U(STG_NO_ARGS)
 {
 void
 _Scavenge_BH_U(STG_NO_ARGS)
 {
-    DEBUG_SCAV_BH(BH_U_SIZE);
-    PROFILE_CLOSURE(Scav,BH_U_SIZE);
-    NEXT_Scav(BH_U_SIZE);
+    I_ size = BH_U_SIZE;
+    DEBUG_SCAV_BH(size);
+    PROFILE_CLOSURE(Scav,size);
+    NEXT_Scav(size);
     return;   
 }
 
 void
 _Scavenge_BH_N(STG_NO_ARGS)
 {
     return;   
 }
 
 void
 _Scavenge_BH_N(STG_NO_ARGS)
 {
-    DEBUG_SCAV_BH(BH_N_SIZE);
-    PROFILE_CLOSURE(Scav,BH_N_SIZE);
-    NEXT_Scav(BH_N_SIZE);
+    I_ size = BH_N_SIZE;
+    DEBUG_SCAV_BH(size);
+    PROFILE_CLOSURE(Scav,size);
+    NEXT_Scav(size);
     return;   
 }
 
     return;   
 }
 
-/* This is needed for scavenging the indirections on the OldMutables list */
-
+/* This is needed for scavenging indirections that "hang around";
+    e.g., because they are on the OldMutables list, or
+    because we have "turned off" shorting-out of indirections
+    (in SMevac.lc).
+*/
 void
 _Scavenge_Ind(STG_NO_ARGS)
 {
 void
 _Scavenge_Ind(STG_NO_ARGS)
 {
+    I_ size = IND_CLOSURE_SIZE(dummy);
     DEBUG_SCAV_IND;
     DEBUG_SCAV_IND;
-    PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy));
+    PROFILE_CLOSURE(Scav,size);
     DO_EVACUATE(Scav, IND_HS);
     DO_EVACUATE(Scav, IND_HS);
-    NEXT_Scav(IND_CLOSURE_SIZE(dummy));
+    NEXT_Scav(size);
     return;
 }
 
 void
 _Scavenge_Caf(STG_NO_ARGS)
 {
     return;
 }
 
 void
 _Scavenge_Caf(STG_NO_ARGS)
 {
+    I_ size = IND_CLOSURE_SIZE(dummy);
     DEBUG_SCAV_IND;
     DEBUG_SCAV_IND;
-    PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy));
+    PROFILE_CLOSURE(Scav,size);
     DO_EVACUATE(Scav, IND_HS);
     DO_EVACUATE(Scav, IND_HS);
-    NEXT_Scav(IND_CLOSURE_SIZE(dummy));
+    NEXT_Scav(size);
     return;
 }
 
     return;
 }
 
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING) || defined(TICKY_TICKY)
 
 /* Special permanent indirection for lexical scoping.
    As for _Scavenge_Ind but no PROFILE_CLOSURE.
 
 /* Special permanent indirection for lexical scoping.
    As for _Scavenge_Ind but no PROFILE_CLOSURE.
@@ -812,19 +837,21 @@ _Scavenge_Caf(STG_NO_ARGS)
 void
 _Scavenge_PI(STG_NO_ARGS)
 {
 void
 _Scavenge_PI(STG_NO_ARGS)
 {
+    I_ size = IND_CLOSURE_SIZE(dummy);
     DEBUG_SCAV_PERM_IND;
     DEBUG_SCAV_PERM_IND;
-    /* PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy)); */
+    /* PROFILE_CLOSURE(Scav,size); */
     DO_EVACUATE(Scav, IND_HS);
     DO_EVACUATE(Scav, IND_HS);
-    NEXT_Scav(IND_CLOSURE_SIZE(dummy));
+    NEXT_Scav(size);
     return;
 }
     return;
 }
-#endif /* USE_COST_CENTRES */
+#endif /* PROFILING or TICKY */
 
 #ifdef CONCURRENT
 
 void
 _Scavenge_BQ(STG_NO_ARGS)
 {
 
 #ifdef CONCURRENT
 
 void
 _Scavenge_BQ(STG_NO_ARGS)
 {
+    I_ size = BQ_CLOSURE_SIZE(dummy);
 #if defined(GCgn)
     P_ save_Scav;
 #endif
 #if defined(GCgn)
     P_ save_Scav;
 #endif
@@ -843,14 +870,15 @@ _Scavenge_BQ(STG_NO_ARGS)
     DO_EVACUATE(Scav, BQ_HS);
 #endif /* GCgn */
 
     DO_EVACUATE(Scav, BQ_HS);
 #endif /* GCgn */
 
-    PROFILE_CLOSURE(Scav,BQ_CLOSURE_SIZE(dummy));
-    NEXT_Scav(BQ_CLOSURE_SIZE(dummy));
+    PROFILE_CLOSURE(Scav,size);
+    NEXT_Scav(size);
     return;   
 }
 
 void
 _Scavenge_TSO(STG_NO_ARGS)
 {
     return;   
 }
 
 void
 _Scavenge_TSO(STG_NO_ARGS)
 {
+    I_ size = TSO_VHS + TSO_CTS_SIZE;
 #if defined(GCgn)
     P_ save_Scav;
 #endif
 #if defined(GCgn)
     P_ save_Scav;
 #endif
@@ -861,38 +889,74 @@ _Scavenge_TSO(STG_NO_ARGS)
     DEBUG_SCAV_TSO;
 
 #if defined(GCgn)
     DEBUG_SCAV_TSO;
 
 #if defined(GCgn)
-    /* No old generation roots should be created for mutable */
-    /* pointer fields as they will be explicitly collected   */ 
-    /* Ensure this by pointing Scav at the new generation    */ 
-    save_Scav = Scav;
-    Scav = OldGen + 1;
-
-    DO_EVACUATE(save_Scav, TSO_LINK_LOCN);
-    DO_EVACUATE(save_Scav, ((P_) &r->rStkO) - save_Scav);
-    for(i = 0; liveness != 0; liveness >>= 1, i++) {
-       if (liveness & 1) {
-           DO_EVACUATE(save_Scav, ((P_) &r->rR[i].p) - save_Scav)
-       }
-    }
-    Scav = save_Scav;
+    /* old and probably wrong -- deleted (WDP 95/12) */
 #else
     DO_EVACUATE(Scav, TSO_LINK_LOCN);
 #else
     DO_EVACUATE(Scav, TSO_LINK_LOCN);
+
     DO_EVACUATE(Scav, ((P_) &r->rStkO) - Scav);
     DO_EVACUATE(Scav, ((P_) &r->rStkO) - Scav);
-    for(i = 0; liveness != 0; liveness >>= 1, i++) {
+
+    for (i = 0; liveness != 0; liveness >>= 1, i++) {
        if (liveness & 1) {
            DO_EVACUATE(Scav, ((P_) &r->rR[i].p) - Scav)
        if (liveness & 1) {
            DO_EVACUATE(Scav, ((P_) &r->rR[i].p) - Scav)
-       }
+       }
     }
 #endif
 
     }
 #endif
 
-    PROFILE_CLOSURE(Scav, TSO_VHS + TSO_CTS_SIZE)
-    NEXT_Scav(TSO_VHS + TSO_CTS_SIZE);
+    PROFILE_CLOSURE(Scav, size);
+    NEXT_Scav(size);
     return;
 }
 
     return;
 }
 
+int /* ToDo: move? */
+sanityChk_StkO(P_ stko)
+{
+    I_ size = STKO_CLOSURE_SIZE(stko);
+    I_ cts_size = STKO_CLOSURE_CTS_SIZE(stko);
+    I_ count;
+    I_ sub = STKO_SuB_OFFSET(stko);    /* Offset of first update frame in B stack */
+    I_ prev_sub;
+    P_ begin_stko  = STKO_CLOSURE_ADDR(stko, 0);
+    P_ beyond_stko = STKO_CLOSURE_ADDR(stko, cts_size+1);
+
+    /*fprintf(stderr, "stko=%lx; SpA offset=%ld; first SuB=%ld, size=%ld; next=%lx\n",stko,STKO_SpA_OFFSET(stko),sub,STKO_CLOSURE_CTS_SIZE(stko),STKO_LINK(stko));*/
+
+    /* Evacuate the locations in the A stack */
+    for (count = STKO_SpA_OFFSET(stko); count <= cts_size; count++) {
+       ASSERT(count >= 0);
+    }
+
+    while(sub > 0) {
+       P_ subptr;
+       P_ suaptr;
+       P_ updptr;
+       P_ retptr;
+
+       ASSERT(sub >= 1);
+       ASSERT(sub <= cts_size);
+
+       retptr = GRAB_RET(STKO_CLOSURE_ADDR(stko,sub));
+       subptr = GRAB_SuB(STKO_CLOSURE_ADDR(stko,sub));
+       suaptr = GRAB_SuA(STKO_CLOSURE_ADDR(stko,sub));
+       updptr = GRAB_UPDATEE(STKO_CLOSURE_ADDR(stko,sub));
+
+       ASSERT(subptr >= begin_stko);
+       ASSERT(subptr <  beyond_stko);
+
+       ASSERT(suaptr >= begin_stko);
+       ASSERT(suaptr <=  beyond_stko);
+
+       /* ToDo: would be nice to chk that retptr is in text space */
+
+       sub = STKO_CLOSURE_OFFSET(stko, subptr);
+    }
+
+    return 1;
+}
+
 void
 _Scavenge_StkO(STG_NO_ARGS)
 {
 void
 _Scavenge_StkO(STG_NO_ARGS)
 {
+    I_ size = STKO_CLOSURE_SIZE(Scav);
 #if defined(GCgn)
     P_ save_Scav;
 #endif
 #if defined(GCgn)
     P_ save_Scav;
 #endif
@@ -902,31 +966,10 @@ _Scavenge_StkO(STG_NO_ARGS)
     DEBUG_SCAV_STKO;
 
 #if defined(GCgn)
     DEBUG_SCAV_STKO;
 
 #if defined(GCgn)
-    /* No old generation roots should be created for mutable */
-    /* pointer fields as they will be explicitly collected   */ 
-    /* Ensure this by pointing Scav at the new generation    */ 
-    save_Scav = Scav;
-    Scav = OldGen + 1;
-
-    /* Evacuate the link */
-    DO_EVACUATE(save_Scav, STKO_LINK_LOCN);
-
-    /* Evacuate the locations in the A stack */
-    for (count = STKO_SpA_OFFSET(save_Scav); 
-      count <= STKO_CLOSURE_CTS_SIZE(save_Scav); count++) {
-       STKO_DO_EVACUATE(count);
-    }
-
-    /* Now evacuate the updatees in the update stack */
-    while(sub > 0) {
-       P_ subptr;
-
-       STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
-       subptr = GRAB_SuB(STKO_CLOSURE_ADDR(save_Scav,sub));
-       sub = STKO_CLOSURE_OFFSET(save_Scav, subptr);
-    }
-    Scav = save_Scav;
+    /* deleted; probably wrong */
 #else
 #else
+    ASSERT(sanityChk_StkO(Scav));
+
     /* Evacuate the link */
     DO_EVACUATE(Scav, STKO_LINK_LOCN);
 
     /* Evacuate the link */
     DO_EVACUATE(Scav, STKO_LINK_LOCN);
 
@@ -941,11 +984,13 @@ _Scavenge_StkO(STG_NO_ARGS)
 
        STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
        subptr = GRAB_SuB(STKO_CLOSURE_ADDR(Scav,sub));
 
        STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
        subptr = GRAB_SuB(STKO_CLOSURE_ADDR(Scav,sub));
+
        sub = STKO_CLOSURE_OFFSET(Scav, subptr);
     }
        sub = STKO_CLOSURE_OFFSET(Scav, subptr);
     }
+
 #endif
 #endif
-    PROFILE_CLOSURE(Scav, STKO_CLOSURE_SIZE(Scav))
-    NEXT_Scav(STKO_CLOSURE_SIZE(Scav));
+    PROFILE_CLOSURE(Scav, size);
+    NEXT_Scav(size);
     return;
 }
 
     return;
 }
 
@@ -954,15 +999,17 @@ _Scavenge_StkO(STG_NO_ARGS)
 void
 _Scavenge_FetchMe(STG_NO_ARGS)
 {
 void
 _Scavenge_FetchMe(STG_NO_ARGS)
 {
-    DEBUG_SCAV(2,0);
-    PROFILE_CLOSURE(Scav,2);
-    NEXT_Scav(2);
+    I_ size = FETCHME_CLOSURE_SIZE(dummy);
+    DEBUG_SCAV(size,0);
+    PROFILE_CLOSURE(Scav,size);
+    NEXT_Scav(size);
     return;
 }
 
 void
 _Scavenge_BF(STG_NO_ARGS)
 {
     return;
 }
 
 void
 _Scavenge_BF(STG_NO_ARGS)
 {
+    I_ size = BF_CLOSURE_SIZE(dummy);
 #if defined(GCgn)
     P_ save_Scav;
 #endif
 #if defined(GCgn)
     P_ save_Scav;
 #endif
@@ -984,8 +1031,8 @@ _Scavenge_BF(STG_NO_ARGS)
     DO_EVACUATE(Scav, BF_NODE_LOCN);
 #endif
 
     DO_EVACUATE(Scav, BF_NODE_LOCN);
 #endif
 
-    PROFILE_CLOSURE(Scav, BF_CLOSURE_SIZE(dummy))
-    NEXT_Scav(BF_CLOSURE_SIZE(dummy));
+    PROFILE_CLOSURE(Scav, size);
+    NEXT_Scav(size);
     return;
 }
 
     return;
 }
 
@@ -1001,8 +1048,9 @@ _Scavenge_BF(STG_NO_ARGS)
 void
 _Scavenge_OldRoot(STG_NO_ARGS)
 {
 void
 _Scavenge_OldRoot(STG_NO_ARGS)
 {
-    DEBUG_SCAV_OLDROOT(MIN_UPD_SIZE); /* dodgy size (WDP 95/07) */
-    NEXT_Scav(MIN_UPD_SIZE);
+    I_ size = ?????
+    DEBUG_SCAV_OLDROOT(size);
+    NEXT_Scav(size);
     return;
 }
 
     return;
 }
 
index dc7452b..f00daa8 100644 (file)
@@ -16,42 +16,47 @@ EXTDATA_RO(StkO_static_info);
 P_ MainStkO;
 #endif
 
 P_ MainStkO;
 #endif
 
-I_
-initStacks(sm)
-smInfo *sm;
+rtsBool
+initStacks(smInfo *sm)
 {
     /*
      * Allocate them if they don't exist. One space does for both stacks, since they
      * grow towards each other
      */
     if (stks_space == 0) {
 {
     /*
      * Allocate them if they don't exist. One space does for both stacks, since they
      * grow towards each other
      */
     if (stks_space == 0) {
-#ifdef CONCURRENT
-       MainStkO = (P_) xmalloc((STKO_HS + SM_word_stk_size) * sizeof(W_));
+#ifndef CONCURRENT
+       stks_space = (P_) stgMallocWords(RTSflags.GcFlags.stksSize, "initStacks");
+#else
+       MainStkO = (P_) stgMallocWords(STKO_HS + RTSflags.GcFlags.stksSize, "initStacks");
        stks_space = MainStkO + STKO_HS;
         SET_STKO_HDR(MainStkO, StkO_static_info, CC_SUBSUMED);
        stks_space = MainStkO + STKO_HS;
         SET_STKO_HDR(MainStkO, StkO_static_info, CC_SUBSUMED);
-        STKO_SIZE(MainStkO) = SM_word_stk_size + STKO_VHS;
+        STKO_SIZE(MainStkO) = RTSflags.GcFlags.stksSize + STKO_VHS;
+        STKO_SpB(MainStkO) = STKO_SuB(MainStkO) = STKO_BSTK_BOT(MainStkO) + BREL(1);
+        STKO_SpA(MainStkO) = STKO_SuA(MainStkO) = STKO_ASTK_BOT(MainStkO) + AREL(1);
         STKO_LINK(MainStkO) = Nil_closure;
        STKO_RETURN(MainStkO) = NULL;
         STKO_LINK(MainStkO) = Nil_closure;
        STKO_RETURN(MainStkO) = NULL;
-#else
-       stks_space = (P_) xmalloc(SM_word_stk_size * sizeof(W_));
+
+       ASSERT(sanityChk_StkO(MainStkO));
 #endif
     }
 #endif
     }
+
 # if STACK_CHECK_BY_PAGE_FAULT
 # if STACK_CHECK_BY_PAGE_FAULT
-    unmapMiddleStackPage((char *) stks_space, SM_word_stk_size * sizeof(W_));
+    unmapMiddleStackPage((char *) stks_space, RTSflags.GcFlags.stksSize * sizeof(W_));
 # endif
 
     /* Initialise Stack Info and pointers */
 # endif
 
     /* Initialise Stack Info and pointers */
-    stackInfo.botA = STK_A_FRAME_BASE(stks_space, SM_word_stk_size);
-    stackInfo.botB = STK_B_FRAME_BASE(stks_space, SM_word_stk_size);
+    stackInfo.botA = STK_A_FRAME_BASE(stks_space, RTSflags.GcFlags.stksSize);
+    stackInfo.botB = STK_B_FRAME_BASE(stks_space, RTSflags.GcFlags.stksSize);
 
     MAIN_SuA = MAIN_SpA = stackInfo.botA + AREL(1);
     MAIN_SuB = MAIN_SpB = stackInfo.botB + BREL(1);
 
 
     MAIN_SuA = MAIN_SpA = stackInfo.botA + AREL(1);
     MAIN_SuB = MAIN_SpB = stackInfo.botB + BREL(1);
 
-    if (SM_trace)
+    if (RTSflags.GcFlags.trace)
        fprintf(stderr, "STACK init: botA, spa: 0x%lx, 0x%lx\n            botB, spb: 0x%lx, 0x%lx\n",
          (W_) stackInfo.botA, (W_) MAIN_SpA, (W_) stackInfo.botB, (W_) MAIN_SpB);
 
        fprintf(stderr, "STACK init: botA, spa: 0x%lx, 0x%lx\n            botB, spb: 0x%lx, 0x%lx\n",
          (W_) stackInfo.botA, (W_) MAIN_SpA, (W_) stackInfo.botB, (W_) MAIN_SpB);
 
-    return 0;
+    return rtsTrue;
 }
 }
+
 #endif /* not parallel */
 \end{code}
 #endif /* not parallel */
 \end{code}
index 2f953f1..7355893 100644 (file)
@@ -317,6 +317,6 @@ static const W_ INTLIKE_closures_def[] = {
     INTLIKE_HDR(16)    /* MAX_INTLIKE == 16 */
 };
 
     INTLIKE_HDR(16)    /* MAX_INTLIKE == 16 */
 };
 
-P_ INTLIKE_closures = (P_) __INTLIKE_CLOSURE(0);
+const P_ INTLIKE_closures = (const P_) __INTLIKE_CLOSURE(0);
 
 \end{code}
 
 \end{code}
index 3f6dfc3..37e4895 100644 (file)
@@ -19,7 +19,7 @@ stat_exit
 
 #define NULL_REG_MAP
 #include "SMinternal.h"
 
 #define NULL_REG_MAP
 #include "SMinternal.h"
-#include "RednCounts.h"
+#include "Ticky.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -70,14 +70,7 @@ static ullong GC_tot_alloc = 0;        /* Total heap allocated -- 64 bits? */
 static I_ GC_start_faults = 0, GC_end_faults = 0;
 
 char *
 static I_ GC_start_faults = 0, GC_end_faults = 0;
 
 char *
-#ifdef __STDC__ 
 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 ullong_format_string(ullong x, char *s, rtsBool with_commas)
-#else
-ullong_format_string(x, s, with_commas)
-    ullong x;
-    char  *s;
-    rtsBool with_commas;
-#endif
 {
     if (x < (ullong)1000) 
        sprintf(s, "%ld", (I_)x);
 {
     if (x < (ullong)1000) 
        sprintf(s, "%ld", (I_)x);
@@ -226,52 +219,54 @@ pagefaults(STG_NO_ARGS)
 /* Called at the beginning of execution of the program */
 /* Writes the command line and inits stats header */
 
 /* Called at the beginning of execution of the program */
 /* Writes the command line and inits stats header */
 
-void stat_init(collector, comment1, comment2)
-char *collector, *comment1, *comment2;
+void
+stat_init(char *collector, char *comment1, char *comment2)
 {
 {
-    if (SM_statsfile != NULL) {
+    FILE *sf = RTSflags.GcFlags.statsFile;
+
+    if (sf != NULL) {
        char temp[BIG_STRING_LEN];
        char temp[BIG_STRING_LEN];
-       ullong_format_string( (ullong)SM_word_heap_size*sizeof(W_), temp, rtsTrue/*commas*/);
-       fprintf(SM_statsfile, "\nCollector: %s  HeapSize: %s (bytes)\n\n", collector, temp);
-       if (SM_stats_verbose) {
+       ullong_format_string( (ullong)RTSflags.GcFlags.heapSize*sizeof(W_), temp, rtsTrue/*commas*/);
+       fprintf(sf, "\nCollector: %s  HeapSize: %s (bytes)\n\n", collector, temp);
+       if (RTSflags.GcFlags.giveStats) {
 #if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS
 #if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS
-           fprintf(SM_statsfile, "NOTE: `pagefaults' does nothing!\n");
+           fprintf(sf, "NOTE: `pagefaults' does nothing!\n");
 #endif
 #endif
-           fprintf(SM_statsfile,
+           fprintf(sf,
 /*######## ####### #######  ##.#  ##.## ##.## ####.## ####.## #### ####*/
  "  Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts  %s\n",
                    comment1);
 /*######## ####### #######  ##.#  ##.## ##.## ####.## ####.## #### ####*/
  "  Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts  %s\n",
                    comment1);
-           fprintf(SM_statsfile,
+           fprintf(sf,
  "  bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  %s\n",
                    comment2);
        }
 
 #if defined(GCap) || defined(GCgn)
         else {
  "  bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  %s\n",
                    comment2);
        }
 
 #if defined(GCap) || defined(GCgn)
         else {
-           fprintf(SM_statsfile,
+           fprintf(sf,
 /*######## #######  ##.#  #######  ##.#   ###  ##.## ##.## ##.## ##.## ####.## ####.## #### ####*/
  "  Alloc  Promote  Promo   Live   Resid Minor Minor Minor Major Major    TOT     TOT  Page Flts\n");
 /*######## #######  ##.#  #######  ##.#   ###  ##.## ##.## ##.## ##.## ####.## ####.## #### ####*/
  "  Alloc  Promote  Promo   Live   Resid Minor Minor Minor Major Major    TOT     TOT  Page Flts\n");
-           fprintf(SM_statsfile,
+           fprintf(sf,
  "  bytes   bytes    ted    bytes   ency   No   user  elap  user  elap    user    elap  MUT Major\n");
        }
 #endif /* generational */
 
  "  bytes   bytes    ted    bytes   ency   No   user  elap  user  elap    user    elap  MUT Major\n");
        }
 #endif /* generational */
 
-       fflush(SM_statsfile);
+       fflush(sf);
     }
 }
 
     }
 }
 
-
 /* Called at the beginning of each GC */
 static I_ rub_bell = 0;
 
 void
 /* Called at the beginning of each GC */
 static I_ rub_bell = 0;
 
 void
-stat_startGC(alloc)
-  I_ alloc;
+stat_startGC(I_ alloc)
 {
 {
+    FILE *sf = RTSflags.GcFlags.statsFile;
+
 #if defined(GCap) || defined(GCgn)
 #if defined(GCap) || defined(GCgn)
-    I_ bell = alloc == 0 ? SM_ring_bell : 0;
+    I_ bell = alloc == 0 ? RTSflags.GcFlags.ringBell : 0;
 #else  /* ! generational */
 #else  /* ! generational */
-    I_ bell = SM_ring_bell;
+    I_ bell = RTSflags.GcFlags.ringBell;
 #endif /* ! generational */
 
     if (bell) {
 #endif /* ! generational */
 
     if (bell) {
@@ -283,16 +278,16 @@ stat_startGC(alloc)
        }
     }
 
        }
     }
 
-    if (SM_statsfile != NULL) {
+    if (sf != NULL) {
        GC_start_time = usertime();
        GCe_start_time = elapsedtime();
        
 #if defined(GCap) || defined(GCgn)
        GC_start_time = usertime();
        GCe_start_time = elapsedtime();
        
 #if defined(GCap) || defined(GCgn)
-        if (SM_stats_verbose || alloc == 0) {
+        if (RTSflags.GcFlags.giveStats || alloc == 0) {
            GC_start_faults = pagefaults();
        }
 #else  /* ! generational */
            GC_start_faults = pagefaults();
        }
 #else  /* ! generational */
-       if (SM_stats_verbose) {
+       if (RTSflags.GcFlags.giveStats) {
            GC_start_faults = pagefaults();
        }
 #endif /* ! generational */
            GC_start_faults = pagefaults();
        }
 #endif /* ! generational */
@@ -300,24 +295,23 @@ stat_startGC(alloc)
     }
 }
 
     }
 }
 
-
 /* Called at the end of each GC */
 
 void
 /* Called at the end of each GC */
 
 void
-stat_endGC(alloc, collect, live, comment)
-  I_ alloc, collect, live;
-  char *comment;
+stat_endGC(I_ alloc, I_ collect, I_ live, char *comment)
 {
 {
-    if (SM_statsfile != NULL) {
+    FILE *sf = RTSflags.GcFlags.statsFile;
+
+    if (sf != NULL) {
        StgDouble time = usertime();
        StgDouble etime = elapsedtime();
 
        StgDouble time = usertime();
        StgDouble etime = elapsedtime();
 
-       if (SM_stats_verbose){
+       if (RTSflags.GcFlags.giveStats) {
            I_ faults = pagefaults();
 
            I_ faults = pagefaults();
 
-           fprintf(SM_statsfile, "%8ld %7ld %7ld %5.1f%%",
-                   alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_), collect == 0 ? 0.0 : (live / (StgFloat) collect * 100));
-           fprintf(SM_statsfile, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld  %s\n", 
+           fprintf(sf, "%8ld %7ld %7ld %5.1f%%",
+                   alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_), collect == 0 ? 0.0 : (live / (StgDouble) collect * 100));
+           fprintf(sf, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld  %s\n", 
                    (time-GC_start_time), 
                    (etime-GCe_start_time), 
                    time,
                    (time-GC_start_time), 
                    (etime-GCe_start_time), 
                    time,
@@ -327,18 +321,18 @@ stat_endGC(alloc, collect, live, comment)
                    comment);
 
            GC_end_faults = faults;
                    comment);
 
            GC_end_faults = faults;
-           fflush(SM_statsfile);
+           fflush(sf);
        }
 
 #if defined(GCap) || defined(GCgn)
         else if(alloc == 0 && collect != 0) {
            I_ faults = pagefaults();
 
        }
 
 #if defined(GCap) || defined(GCgn)
         else if(alloc == 0 && collect != 0) {
            I_ faults = pagefaults();
 
-           fprintf(SM_statsfile, "%8ld %7ld %5.1f%% %7ld %5.1f%%",
+           fprintf(sf, "%8ld %7ld %5.1f%% %7ld %5.1f%%",
                    GC_alloc_since_maj*sizeof(W_), (collect - GC_live_maj)*sizeof(W_),
                    GC_alloc_since_maj*sizeof(W_), (collect - GC_live_maj)*sizeof(W_),
-                   (collect - GC_live_maj) / (StgFloat) GC_alloc_since_maj * 100,
-                   live*sizeof(W_), live / (StgFloat) SM_word_heap_size * 100);
-           fprintf(SM_statsfile, "  %3ld  %5.2f %5.2f %5.2f %5.2f %7.2f %7.2f %4ld %4ld\n",
+                   (collect - GC_live_maj) / (StgDouble) GC_alloc_since_maj * 100,
+                   live*sizeof(W_), live / (StgDouble) RTSflags.GcFlags.heapSize * 100);
+           fprintf(sf, "  %3ld  %5.2f %5.2f %5.2f %5.2f %7.2f %7.2f %4ld %4ld\n",
                    GC_min_since_maj, GC_min_time, GCe_min_time,
                    (time-GC_start_time), 
                    (etime-GCe_start_time), 
                    GC_min_since_maj, GC_min_time, GCe_min_time,
                    (time-GC_start_time), 
                    (etime-GCe_start_time), 
@@ -349,7 +343,7 @@ stat_endGC(alloc, collect, live, comment)
                    );
 
            GC_end_faults = faults;
                    );
 
            GC_end_faults = faults;
-           fflush(SM_statsfile);
+           fflush(sf);
        }
 #endif /* generational */
 
        }
 #endif /* generational */
 
@@ -386,27 +380,27 @@ stat_endGC(alloc, collect, live, comment)
     }
 }
 
     }
 }
 
-
 /* Called at the end of execution -- to print a summary of statistics */
 
 void
 /* Called at the end of execution -- to print a summary of statistics */
 
 void
-stat_exit(alloc)
-  I_ alloc;
+stat_exit(I_ alloc)
 {
 {
-    if (SM_statsfile != NULL){
+    FILE *sf = RTSflags.GcFlags.statsFile;
+
+    if (sf != NULL){
        char temp[BIG_STRING_LEN];
        StgDouble time = usertime();
        StgDouble etime = elapsedtime();
 
        char temp[BIG_STRING_LEN];
        StgDouble time = usertime();
        StgDouble etime = elapsedtime();
 
-       if (SM_stats_verbose) {
-           fprintf(SM_statsfile, "%8ld\n\n", alloc*sizeof(W_));
+       if (RTSflags.GcFlags.giveStats) {
+           fprintf(sf, "%8ld\n\n", alloc*sizeof(W_));
        }
 
 #if defined(GCap) || defined (GCgn)
        else {
        }
 
 #if defined(GCap) || defined (GCgn)
        else {
-           fprintf(SM_statsfile, "%8ld %7.7s %6.6s %7.7s %6.6s",
+           fprintf(sf, "%8ld %7.7s %6.6s %7.7s %6.6s",
                    (GC_alloc_since_maj + alloc)*sizeof(W_), "", "", "", "");
                    (GC_alloc_since_maj + alloc)*sizeof(W_), "", "", "", "");
-           fprintf(SM_statsfile, "  %3ld  %5.2f %5.2f\n\n",
+           fprintf(sf, "  %3ld  %5.2f %5.2f\n\n",
                    GC_min_since_maj, GC_min_time, GCe_min_time);
        }
        GC_min_no    += GC_min_since_maj;
                    GC_min_since_maj, GC_min_time, GCe_min_time);
        }
        GC_min_no    += GC_min_since_maj;
@@ -414,55 +408,54 @@ stat_exit(alloc)
        GCe_tot_time += GCe_min_time;
        GC_tot_alloc += (ullong) (GC_alloc_since_maj + alloc);
        ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
        GCe_tot_time += GCe_min_time;
        GC_tot_alloc += (ullong) (GC_alloc_since_maj + alloc);
        ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
-       fprintf(SM_statsfile, "%11s bytes allocated in the heap\n", temp);
+       fprintf(sf, "%11s bytes allocated in the heap\n", temp);
        if ( ResidencySamples > 0 ) {
            ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
        if ( ResidencySamples > 0 ) {
            ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
-           fprintf(SM_statsfile, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n",
+           fprintf(sf, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n",
                              temp,
                              temp,
-                             MaxResidency / (StgFloat) SM_word_heap_size * 100,
+                             MaxResidency / (StgDouble) RTSflags.GcFlags.heapSize * 100,
                              ResidencySamples);
        }
                              ResidencySamples);
        }
-       fprintf(SM_statsfile, "%11ld garbage collections performed (%ld major, %ld minor)\n\n",
+       fprintf(sf, "%11ld garbage collections performed (%ld major, %ld minor)\n\n",
                GC_maj_no + GC_min_no, GC_maj_no, GC_min_no);
 
 #else  /* ! generational */
 
        GC_tot_alloc += (ullong) alloc;
        ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
                GC_maj_no + GC_min_no, GC_maj_no, GC_min_no);
 
 #else  /* ! generational */
 
        GC_tot_alloc += (ullong) alloc;
        ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
-       fprintf(SM_statsfile, "%11s bytes allocated in the heap\n", temp);
+       fprintf(sf, "%11s bytes allocated in the heap\n", temp);
        if ( ResidencySamples > 0 ) {
            ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
        if ( ResidencySamples > 0 ) {
            ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
-           fprintf(SM_statsfile, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n",
+           fprintf(sf, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n",
                              temp,
                              temp,
-                             MaxResidency / (StgFloat) SM_word_heap_size * 100,
+                             MaxResidency / (StgDouble) RTSflags.GcFlags.heapSize * 100,
                              ResidencySamples);
        }
                              ResidencySamples);
        }
-       fprintf(SM_statsfile, "%11ld garbage collections performed\n\n", GC_maj_no);
+       fprintf(sf, "%11ld garbage collections performed\n\n", GC_maj_no);
 
 #endif /* ! generational */
 
 
 #endif /* ! generational */
 
-       fprintf(SM_statsfile, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
+       fprintf(sf, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
                InitUserTime, InitElapsedTime);
                InitUserTime, InitElapsedTime);
-       fprintf(SM_statsfile, "  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
+       fprintf(sf, "  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
                time - GC_tot_time - InitUserTime, 
                 etime - GCe_tot_time - InitElapsedTime);
                time - GC_tot_time - InitUserTime, 
                 etime - GCe_tot_time - InitElapsedTime);
-       fprintf(SM_statsfile, "  GC    time  %6.2fs  (%6.2fs elapsed)\n",
+       fprintf(sf, "  GC    time  %6.2fs  (%6.2fs elapsed)\n",
                GC_tot_time, GCe_tot_time);
                GC_tot_time, GCe_tot_time);
-       fprintf(SM_statsfile, "  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
+       fprintf(sf, "  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
                time, etime);
 
                time, etime);
 
-       fprintf(SM_statsfile, "  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
+       fprintf(sf, "  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
                GC_tot_time*100./time, GCe_tot_time*100./etime);
 
        ullong_format_string((ullong)(GC_tot_alloc*sizeof(W_)/(time - GC_tot_time)), temp, rtsTrue/*commas*/);
                GC_tot_time*100./time, GCe_tot_time*100./etime);
 
        ullong_format_string((ullong)(GC_tot_alloc*sizeof(W_)/(time - GC_tot_time)), temp, rtsTrue/*commas*/);
-       fprintf(SM_statsfile, "  Alloc rate    %s bytes per MUT second\n\n", temp);
+       fprintf(sf, "  Alloc rate    %s bytes per MUT second\n\n", temp);
 
 
-       fprintf(SM_statsfile, "  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
+       fprintf(sf, "  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
                (time - GC_tot_time - InitUserTime) * 100. / time, 
                 (time - GC_tot_time - InitUserTime) * 100. / etime);
                (time - GC_tot_time - InitUserTime) * 100. / time, 
                 (time - GC_tot_time - InitUserTime) * 100. / etime);
-       fflush(SM_statsfile);
-       fclose(SM_statsfile);
+       fflush(sf);
+       fclose(sf);
     }
 }
     }
 }
-
 \end{code}
 \end{code}
index 8c50a6e..a27199f 100644 (file)
@@ -65,7 +65,7 @@ int size;
     }
     if (mprotect(middle, pagesize, PROT_NONE) == -1) {
        perror("mprotect");
     }
     if (mprotect(middle, pagesize, PROT_NONE) == -1) {
        perror("mprotect");
-       exit(1);
+       EXIT(EXIT_FAILURE);
     }
     if (install_segv_handler()) {
        fprintf(stderr, "Can't install SIGSEGV handler for stack overflow check.\n");
     }
     if (install_segv_handler()) {
        fprintf(stderr, "Can't install SIGSEGV handler for stack overflow check.\n");
index 4b0b693..d7e22d6 100644 (file)
@@ -1,10 +1,11 @@
 #define IHaveSubdirs
 
 #define IHaveSubdirs
 
-SUBDIRS = hp2ps \
-         hscpp \
-         unlit \
-         hstags \
-         mkdependHS \
-         parallel \
-         ugen \
-         stat2resid
+SUBDIRS = heap-view    \
+         hp2ps         \
+         hscpp         \
+         hstags        \
+         mkdependHS    \
+         parallel      \
+         stat2resid    \
+         ugen          \
+         unlit
diff --git a/ghc/utils/heap-view/Graph.lhs b/ghc/utils/heap-view/Graph.lhs
new file mode 100644 (file)
index 0000000..b8e08db
--- /dev/null
@@ -0,0 +1,165 @@
+Started 29/11/93: 
+
+> module Main where
+> import PreludeGlaST
+> import LibSystem
+
+Program to draw a graph of last @n@ pieces of data from standard input
+continuously.
+
+> n :: Int
+> n = 40
+
+> max_sample :: Int
+> max_sample = 100
+
+> screen_size :: Int
+> screen_size = 200
+
+Version of grapher that can handle the output of ghc's @+RTS -Sstderr@
+option.  
+
+Nice variant would be to take a list of numbers from the commandline
+and display several graphs at once.
+
+> main :: IO ()
+> main =
+>      getArgs                         >>= \ r ->
+>      case r of 
+>        [select] -> 
+>              let selection = read select
+>              in
+>              xInitialise [] screen_size screen_size  >>
+>              hGetContents stdin                      >>= \ input ->
+>              graphloop2 (parseGCData selection input) [] 
+>        _ -> 
+>              error "usage: graph <number in range 0..17>\n"
+
+The format of glhc18's stderr stuff is:
+
+-- start of example (view in 120 column window)
+graph +RTS -Sstderr -H500 
+
+Collector: APPEL  HeapSize: 500 (bytes)
+
+  Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts   No of Roots  Caf  Mut-  Old  Collec  Resid
+  bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  Astk Bstk Reg  No  able  Gen   tion   %heap
+     248     248      60  24.2%  0.00  0.04    0.05    0.23    1    1     1    0   0   1     0    0   Minor
+-- end of example
+     0       1      2       3      4    5      6       7       8    9    10   11  12  13    14   15      16     17
+
+That is: 6 header lines followed by 17-18 columns of integers,
+percentages, floats and text.
+
+The scaling in the following is largely based on guesses about likely
+values - needs tuned.  
+
+@gcParsers@ is a list of functions which parse the corresponding
+column and attempts to scale the numbers into the range $0.0 .. 1.0$.
+(But may return a number avove $1.0$ which graphing part will scale to
+fit screen...)
+
+(Obvious optimisation - replace by list of scaling information!)
+
+(Obvious improvement - return (x,y) pair based on elapsed (or user) time.)
+
+> gcParsers :: [ String -> Float ]
+> gcParsers = [ heap, heap, heap, percent, time, time, time, time, flts, flts, stk, stk, reg, caf, caf, heap, text, percent ]
+>  where
+>   heap = scale 100000.0 . fromInt . check 0 . readDec
+>   stk  = scale  25000.0 . fromInt . check 0 . readDec
+>   int  = scale   1000.0 . fromInt . check 0 . readDec
+>   reg = scale   10.0 . fromInt . check 0 . readDec
+>   caf = scale  100.0 . fromInt . check 0 . readDec
+>   flts = scale  100.0 . fromInt . check 0 . readDec
+>   percent = scale 100.0 . check 0.0 . readFloat
+>   time   = scale  20.0 . check 0.0 . readFloat
+>   text s = 0.0
+
+> check :: a -> [(a,String)] -> a
+> check error_value parses = 
+>      case parses of
+>        []            -> error_value
+>        ((a,s):_)     -> a
+
+> scale :: Float -> Float -> Float
+> scale max n = n / max
+
+> parseGCData :: Int -> String -> [Float]
+> parseGCData column input = 
+>      map ((gcParsers !! column) . (!! column) . words) (drop 6 (lines input))
+
+Hmmm, how to add logarithmic scaling neatly?  Do I still need to?
+
+Note: unpleasant as it is, the code cannot be simplified to something
+like the following.  The problem is that the graph won't start to be
+drawn until the first @n@ values are available. (Is there also a
+danger of clearing the screen while waiting for the next input value?)
+A possible alternative solution is to keep count of how many values
+have actually been received.
+
+< graphloop2 :: [Float] -> [Float] -> IO ()
+< graphloop2 [] =
+<      return ()
+< graphloop2 ys =
+<      let ys' = take n ys
+<          m = maximum ys'
+<          y_scale = (floor m) + 1
+<          y_scale' = fromInt y_scale
+<      in
+<      xCls                                            >>
+<      drawScales y_scale                              >>
+<      draw x_coords [ x / y_scale' | x <- ys' ]       >>
+<      xHandleEvent                                    >>
+<      graphloop2 (tail ys)
+
+
+> graphloop2 :: [Float] -> [Float] -> IO ()
+> graphloop2 (y:ys) xs =
+>      let xs' = take n (y:xs)
+>          m = maximum xs'
+>          y_scale = (floor m) + 1
+>          y_scale' = fromInt y_scale
+>      in
+>      xCls                                            >>
+>      drawScales y_scale                              >>
+>      draw x_coords [ x / y_scale' | x <- xs' ]       >>
+>      xHandleEvent                                    >>
+>      graphloop2 ys xs'
+> graphloop2 [] xs =
+>      return ()
+
+> x_coords :: [Float]
+> x_coords = [ 0.0, 1 / (fromInt n) .. ]
+
+Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
+
+> draw :: [Float] -> [Float] -> IO ()
+> draw xs ys = drawPoly (zip xs' (reverse ys'))
+>  where
+>   xs' = [ floor (x * sz) | x <- xs ]
+>   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
+>   sz = fromInt screen_size
+
+> drawPoly :: [(Int, Int)] -> IO ()
+> drawPoly ((x1,y1):(x2,y2):poly) =
+>      xDrawLine x1 y1 x2 y2           >>
+>      drawPoly ((x2,y2):poly)
+> drawPoly _ = return ()
+
+Draw horizontal line at major points on y-axis.
+
+> drawScales :: Int -> IO ()
+> drawScales y_scale =
+>      sequence (map drawScale ys)     >>
+>      return ()
+>  where
+>   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
+
+> drawScale :: Float -> IO ()
+> drawScale y =
+>      let y' = floor ((1.0 - y) * (fromInt screen_size))
+>      in
+>      xDrawLine 0 y' screen_size y'
+
+>#include "common-bits"
diff --git a/ghc/utils/heap-view/HaskXLib.c b/ghc/utils/heap-view/HaskXLib.c
new file mode 100644 (file)
index 0000000..b6cf1f1
--- /dev/null
@@ -0,0 +1,297 @@
+/*----------------------------------------------------------------------*
+ *  X from Haskell (PicoX)
+ *
+ * (c) 1993 Andy Gill
+ *
+ *----------------------------------------------------------------------*/
+
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <X11/Xatom.h>
+#include <stdio.h>
+#include <strings.h>
+
+/*----------------------------------------------------------------------*/
+
+/* First the X Globals */
+
+Display *MyDisplay;
+int     MyScreen;
+Window   MyWindow;
+XEvent   MyWinEvent;
+GC       DrawGC;
+GC       UnDrawGC;
+
+/* and the Haskell globals */
+
+typedef struct {
+  int HaskButtons[5];
+  int HaskPointerX,HaskPointerY;
+  int PointMoved;
+} HaskGlobType;
+
+HaskGlobType HaskGlob;
+
+/*----------------------------------------------------------------------*/
+
+/*
+ * Now the access functions into the haskell globals
+ */
+
+int haskGetButtons(int n)
+{
+  return(HaskGlob.HaskButtons[n]);
+}
+
+int haskGetPointerX(void)
+{
+  return(HaskGlob.HaskPointerX);
+}
+
+int haskGetPointerY(void)
+{
+  return(HaskGlob.HaskPointerY);
+}
+
+/*----------------------------------------------------------------------*/
+
+/*
+ *The (rather messy) initiualisation
+ */
+
+haskXBegin(int x,int y,int sty)
+{
+ /*
+  *  later include these via interface hacks
+  */
+
+ /* (int argc, char **argv) */
+  int argc = 0;
+  char **argv = 0;
+
+  XSizeHints XHints;
+  int MyWinFG, MyWinBG,tmp;
+  if ((MyDisplay = XOpenDisplay("")) == NULL) {
+      fprintf(stderr, "Cannot connect to X server '%s'\n", XDisplayName(""));
+      exit(1);
+  }
+
+  MyScreen = DefaultScreen(MyDisplay);
+
+  MyWinBG = WhitePixel(MyDisplay, MyScreen);
+  MyWinFG = BlackPixel(MyDisplay, MyScreen);
+  XHints.x      = x;
+  XHints.y      = y;
+  XHints.width  = x;
+  XHints.height = y;
+  XHints.flags  = PPosition | PSize;
+  MyWindow =
+      XCreateSimpleWindow(
+                         MyDisplay,
+                         DefaultRootWindow(MyDisplay),
+                         x,y, x, y,
+                         5,
+                         MyWinFG,
+                         MyWinBG
+                         );
+  XSetStandardProperties(
+                        MyDisplay,
+                        MyWindow,
+                        "XLib for Glasgow Haskell",
+                        "XLib for Glasgow Haskell",
+                        None,
+                        argv,
+                        argc,
+                        &XHints
+                        );
+  /* Create drawing and erasing GC */
+  DrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
+  XSetBackground(MyDisplay,DrawGC,MyWinBG);
+  XSetForeground(MyDisplay,DrawGC,MyWinFG);
+
+  UnDrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
+  XSetBackground(MyDisplay,UnDrawGC,MyWinFG);
+  XSetForeground(MyDisplay,UnDrawGC,MyWinBG);
+
+  XSetGraphicsExposures(MyDisplay,DrawGC,False);
+  XSetGraphicsExposures(MyDisplay,UnDrawGC,False);
+  XMapRaised(MyDisplay,MyWindow);
+  /* the user should be able to choose which are tested for
+   */
+
+  XSelectInput(
+              MyDisplay,
+              MyWindow,
+                  ButtonPressMask | ButtonReleaseMask | PointerMotionMask 
+              );
+
+  /*  later have more drawing styles
+   */
+
+  switch (sty)
+    {
+    case 0:   
+      /* Andy, this used to be GXor not much use for Undrawing so I
+         changed it. (Not much use for colour either - see next
+         comment */
+      XSetFunction(MyDisplay,DrawGC,GXcopy);
+      XSetFunction(MyDisplay,UnDrawGC,GXcopy);
+      break;
+    case 1:   
+      /* Andy, this can have totally bogus results on a colour screen */
+      XSetFunction(MyDisplay,DrawGC,GXxor);
+      XSetFunction(MyDisplay,UnDrawGC,GXxor);
+      break;
+    default:
+      /* Andy, is this really a good error message? */
+      printf(stderr,"Wrong Argument to XSet function\n");
+    }
+ /*
+  *  reset the (Haskell) globals
+  */
+
+ for(tmp=0;tmp<5;tmp++)
+   {
+     HaskGlob.HaskButtons[tmp] = 0;
+   }
+  HaskGlob.HaskPointerX = 0;
+  HaskGlob.HaskPointerY = 0;
+  HaskGlob.PointMoved = 0;
+
+  XFlush(MyDisplay);
+
+} 
+
+/*----------------------------------------------------------------------*/
+
+/* Boring X ``Do Something'' functions
+ */
+
+haskXClose(void)
+{
+  XFreeGC( MyDisplay, DrawGC);
+  XFreeGC( MyDisplay, UnDrawGC);
+  XDestroyWindow( MyDisplay, MyWindow);
+  XCloseDisplay( MyDisplay);
+  return(0);
+}
+
+haskXDraw(x,y,x1,y1)
+int x,y,x1,y1;
+{
+  XDrawLine(MyDisplay,
+           MyWindow,
+           DrawGC,
+           x,y,x1,y1);
+  return(0);
+}
+
+
+haskXPlot(c,x,y)
+int c;
+int x,y;
+{
+  XDrawPoint(MyDisplay,
+           MyWindow,
+           (c?DrawGC:UnDrawGC), 
+           x,y);
+  return(0);
+}
+
+haskXFill(c,x,y,w,h)
+int c;
+int x, y;
+int w, h;
+{
+  XFillRectangle(MyDisplay,
+           MyWindow,
+           (c?DrawGC:UnDrawGC),
+           x, y, w, h);
+  return(0);
+}
+
+/*----------------------------------------------------------------------*/
+ /* This has to be called every time round the loop,
+  * it flushed the buffer and handles input from the user
+  */
+
+haskHandleEvent()
+{
+  XFlush( MyDisplay);
+  while (XEventsQueued( MyDisplay, QueuedAfterReading) != 0) {
+    XNextEvent( MyDisplay, &MyWinEvent);
+    switch (MyWinEvent.type) {
+    case ButtonPress:
+      switch (MyWinEvent.xbutton.button) 
+       {
+       case Button1: HaskGlob.HaskButtons[0] = 1; break;
+       case Button2: HaskGlob.HaskButtons[1] = 1; break;
+       case Button3: HaskGlob.HaskButtons[2] = 1; break;
+       case Button4: HaskGlob.HaskButtons[3] = 1; break;
+       case Button5: HaskGlob.HaskButtons[4] = 1; break;
+       }
+      break;
+    case ButtonRelease:
+      switch (MyWinEvent.xbutton.button) 
+       {
+       case Button1: HaskGlob.HaskButtons[0] = 0; break;
+       case Button2: HaskGlob.HaskButtons[1] = 0; break;
+       case Button3: HaskGlob.HaskButtons[2] = 0; break;
+       case Button4: HaskGlob.HaskButtons[3] = 0; break;
+       case Button5: HaskGlob.HaskButtons[4] = 0; break;
+       }
+      break;
+    case MotionNotify: 
+        HaskGlob.HaskPointerX = MyWinEvent.xmotion.x;
+        HaskGlob.HaskPointerY = MyWinEvent.xmotion.y;
+        HaskGlob.PointMoved = 1;
+      break;
+    default:
+    printf("UNKNOWN INTERUPT ???? (%d) \n",MyWinEvent.type); 
+      break;
+    } /*switch*/
+  } /*if*/
+  return(0);
+} 
+
+
+/*----------------------------------------------------------------------*/
+
+ /* A function to clear the screen 
+  */
+
+haskXCls(void)
+{
+  XClearWindow(MyDisplay,MyWindow);
+}
+
+/*----------------------------------------------------------------------*/
+
+ /* A function to write a string
+  */
+
+haskXDrawString(int x,int y,char *str)
+{
+  return(0);
+/*  printf("GOT HERE %s %d %d",str,x,y); 
+  XDrawString(MyDisplay,MyWindow,DrawGC,x,y,str,strlen(str));
+*/
+}
+
+/*----------------------------------------------------------------------*/
+
+extern int prog_argc;
+extern char **prog_argv;
+
+haskArgs()
+{
+  return(prog_argc > 1 ? atoi(prog_argv[1]) : 0);
+}
diff --git a/ghc/utils/heap-view/HpView.lhs b/ghc/utils/heap-view/HpView.lhs
new file mode 100644 (file)
index 0000000..a7b4cbb
--- /dev/null
@@ -0,0 +1,296 @@
+> module Main where
+> import PreludeGlaST
+> import LibSystem
+
+> import Parse
+
+Program to interpret a heap profile.
+
+Started 28/11/93: parsing of profile
+Tweaked 28/11/93: parsing fiddled till it worked and graphical backend added
+
+To be done:
+
+0) think about where I want to go with this
+1) further processing... sorting, filtering, ...
+2) get dynamic display
+3) maybe use widgets
+
+Here's an example heap profile
+
+          JOB "a.out -p"
+          DATE "Fri Apr 17 11:43:45 1992"
+          SAMPLE_UNIT "seconds"
+          VALUE_UNIT "bytes"
+          BEGIN_SAMPLE 0.00
+            SYSTEM 24
+          END_SAMPLE 0.00
+          BEGIN_SAMPLE 1.00
+            elim 180
+            insert 24
+            intersect 12
+            disin 60
+            main 12
+            reduce 20
+            SYSTEM 12
+          END_SAMPLE 1.00
+          MARK 1.50
+          MARK 1.75
+          MARK 1.80
+          BEGIN_SAMPLE 2.00
+            elim 192
+            insert 24
+            intersect 12
+            disin 84
+            main 12
+            SYSTEM 24
+          END_SAMPLE 2.00
+          BEGIN_SAMPLE 2.82
+          END_SAMPLE 2.82
+
+By inspection, the format seems to be:
+
+profile :== header { sample }
+header :== job date { unit }
+job :== "JOB" command
+date :== "DATE" dte
+unit :== "SAMPLE_UNIT" string | "VALUE_UNIT" string
+
+sample :== samp | mark
+samp :== "BEGIN_SAMPLE" time {pairs} "END_SAMPLE" time
+pairs :== identifer count
+mark :== "MARK" time
+
+command :== string
+dte :== string
+time :== float
+count :== integer
+
+But, this doesn't indicate the line structure.  The simplest way to do
+this is to treat each line as a single token --- for which the
+following parser is useful:
+
+Special purpose parser that recognises a string if it matches a given
+prefix and returns the remainder.
+
+> prefixP :: String -> P String String
+> prefixP p =
+>      itemP                   `thenP` \ a -> 
+>      let (p',a') = splitAt (length p) a
+>      in      if p == p'
+>              then unitP a'
+>              else zeroP
+
+
+To begin with I want to parse a profile into a list of readings for
+each identifier at each time.
+
+> type Sample = (Float, [(String, Int)])
+
+> type Line = String
+
+
+> profile :: P Line [Sample]
+> profile = 
+>      header                  `thenP_`
+>      zeroOrMoreP sample      
+
+> header :: P Line ()
+> header =
+>      job                     `thenP_`
+>      date                    `thenP_`
+>      zeroOrMoreP unit        `thenP_`
+>      unitP ()
+
+> job :: P Line String
+> job =        prefixP "JOB "
+
+> date :: P Line String
+> date = prefixP "DATE "
+
+> unit :: P Line String
+> unit =
+>      ( prefixP "SAMPLE_UNIT " )
+>      `plusP`
+>      ( prefixP "VALUE_UNIT " )
+
+> sample :: P Line Sample
+> sample =
+>      samp `plusP` mark
+
+> mark :: P Line Sample
+> mark =
+>      prefixP "MARK "         `thenP` \ time ->
+>      unitP (read time, [])
+
+ToDo: check that @time1 == time2@
+
+> samp :: P Line Sample
+> samp = 
+>      prefixP "BEGIN_SAMPLE "         `thenP` \ time1 ->
+>      zeroOrMoreP pair                `thenP` \ pairs ->
+>      prefixP "END_SAMPLE "           `thenP` \ time2 ->
+>      unitP (read time1, pairs)
+
+> pair :: P Line (String, Int)
+> pair =
+>      prefixP "  "                    `thenP` \ sample_line ->
+>      let [identifier,count] = words sample_line
+>      in unitP (identifier, read count)
+
+This test works fine
+
+> {-
+> test :: String -> String
+> test str = ppSamples (theP profile (lines str))
+
+> test1 = test example
+
+> test2 :: String -> Dialogue
+> test2 file =
+>      readFile file                           exit
+>      (\ hp -> appendChan stdout (test hp)    exit
+>      done)
+> -}
+
+Inefficient pretty-printer (uses ++ excessively)
+
+> ppSamples :: [ Sample ] -> String
+> ppSamples = unlines . map ppSample
+
+> ppSample :: Sample -> String
+> ppSample (time, samps) = 
+>      (show time) ++ unwords (map ppSamp samps)
+
+> ppSamp :: (String, Int) -> String
+> ppSamp (identifier, count) = identifier ++ ":" ++ show count
+
+To get the test1 to work in gofer, you need to fiddle with the input
+a bit to get over Gofer's lack of string-parsing code.
+
+> example =
+>  "JOB \"a.out -p\"\n" ++
+>  "DATE \"Fri Apr 17 11:43:45 1992\"\n" ++
+>  "SAMPLE_UNIT \"seconds\"\n" ++
+>  "VALUE_UNIT \"bytes\"\n" ++
+>  "BEGIN_SAMPLE 0.00\n" ++
+>  "  SYSTEM 24\n" ++
+>  "END_SAMPLE 0.00\n" ++
+>  "BEGIN_SAMPLE 1.00\n" ++
+>  "  elim 180\n" ++
+>  "  insert 24\n" ++
+>  "  intersect 12\n" ++
+>  "  disin 60\n" ++
+>  "  main 12\n" ++
+>  "  reduce 20\n" ++
+>  "  SYSTEM 12\n" ++
+>  "END_SAMPLE 1.00\n" ++
+>  "MARK 1.50\n" ++
+>  "MARK 1.75\n" ++
+>  "MARK 1.80\n" ++
+>  "BEGIN_SAMPLE 2.00\n" ++
+>  "  elim 192\n" ++
+>  "  insert 24\n" ++
+>  "  intersect 12\n" ++
+>  "  disin 84\n" ++
+>  "  main 12\n" ++
+>  "  SYSTEM 24\n" ++
+>  "END_SAMPLE 2.00\n" ++
+>  "BEGIN_SAMPLE 2.82\n" ++
+>  "END_SAMPLE 2.82"
+
+
+
+Hack to let me test this code... Gofer doesn't have integer parsing built in.
+
+> {-
+> read :: String -> Int
+> read s = 0
+> -}
+
+> screen_size = 200
+
+ToDo: 
+
+1) the efficiency of finding slices can probably be dramatically
+   improved... if it matters.
+
+2) the scaling should probably depend on the slices used
+
+3) labelling graphs, colour, ...
+
+4) responding to resize events
+
+> main :: IO ()
+> main =
+>      getArgs                         >>= \ r ->
+>      case r of 
+>        filename:idents -> 
+>              readFile filename       >>= \ hp ->
+>              let samples = theP profile (lines hp)
+>
+>                  times = [ t | (t,ss) <- samples ]
+>                  names = [ n | (t,ss) <- samples, (n,c) <- ss ]
+>                  counts = [ c | (t,ss) <- samples, (n,c) <- ss ]
+>
+>                  time = maximum times
+>                  x_scale = (fromInt screen_size) / time
+>
+>                  max_count = maximum counts
+>                  y_scale = (fromInt screen_size) / (fromInt max_count)
+>
+>                  slices = map (slice samples) idents
+>              in
+>              xInitialise [] screen_size screen_size              >>
+> --           drawHeap x_scale y_scale samples                    >>
+>              sequence (map (drawSlice x_scale y_scale) slices)   >>
+>              freeze
+>        _ -> error "usage: hpView filename identifiers\n"
+
+> freeze :: IO ()
+> freeze =
+>      xHandleEvent                            >>
+>      usleep 100                              >>
+>      freeze
+
+
+Slice drawing stuff... shows profile for each identifier
+
+> slice :: [Sample] -> String -> [(Float,Int)]
+> slice samples ident =
+>      [ (t,c) | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
+
+> lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
+> lookupPairs ((a', b') : hs) a b =
+>      if a == a' then b' else lookupPairs hs a b
+> lookupPairs [] a b = b
+
+> drawSlice :: Float -> Float -> [(Float,Int)] -> IO ()
+> drawSlice x_scale y_scale slc = 
+>      drawPoly 
+>      [ (round (x*x_scale), screen_size - (round ((fromInt y)*y_scale))) | (x,y) <- slc ]
+
+> drawPoly :: [(Int, Int)] -> IO ()
+> drawPoly ((x1,y1):(x2,y2):poly) =
+>      xDrawLine x1 y1 x2 y2           >>
+>      drawPoly ((x2,y2):poly)
+> drawPoly _ = return ()
+
+
+Very simple heap profiler... doesn't do a proper job at all.  Good for
+testing.
+
+> drawHeap :: Float -> Float -> [Sample] -> IO ()
+> drawHeap x_scale y_scale samples =
+>      sequence (map xBar 
+>              [ (t*x_scale, (fromInt c)*y_scale) 
+>              | (t,ss) <- samples, (n,c) <- ss ])     >>      
+>      return ()
+
+> xBar :: (Float, Float) -> IO ()
+> xBar (x, y) = 
+>      let {x' = round x; y' = round y} 
+>      in xDrawLine x' screen_size x' (screen_size - y')
+
+>#include "common-bits"
diff --git a/ghc/utils/heap-view/HpView2.lhs b/ghc/utils/heap-view/HpView2.lhs
new file mode 100644 (file)
index 0000000..fa8044b
--- /dev/null
@@ -0,0 +1,225 @@
+> module Main where
+> import PreludeGlaST
+> import LibSystem
+
+> import Parse
+
+Program to do continuous heap profile.
+
+Bad News: 
+
+    The ghc runtime system writes its heap profile information to a
+    named file (<progname>.hp).  The program merrily reads its input
+    from a named file but has no way of synchronising with the program
+    generating the file.
+
+Good News 0:
+
+    You can save the heap profile to a file:
+
+           <progname> <parameters> +RTS -h -i0.1 -RTS
+
+    and then run:
+
+           hpView2 <progname>.hp Main:<functionname>
+
+    This is very like using hp2ps but much more exciting because you
+    never know what's going to happen next :-)
+
+
+Good News 1:
+
+    The prophet Stallman has blessed us with the shell command @mkfifo@
+    (is there a standard Unix version?) which creates a named pipe.  If we
+    instead run:
+
+           mkfifo <progname>.hp
+           hpView2 <progname>.hp Main:<functionname> &
+           <progname> <parameters> +RTS -h -i0.1 -RTS
+           rm <progname>.hp
+
+    Good Things happen.
+
+    NB If you don't delete the pipe, Bad Things happen: the program
+    writes profiling info to the pipe until the pipe fills up then it
+    blocks...
+
+
+Right, on with the program:
+
+Here's an example heap profile
+
+          JOB "a.out -p"
+          DATE "Fri Apr 17 11:43:45 1992"
+          SAMPLE_UNIT "seconds"
+          VALUE_UNIT "bytes"
+          BEGIN_SAMPLE 0.00
+            SYSTEM 24
+          END_SAMPLE 0.00
+          BEGIN_SAMPLE 1.00
+            elim 180
+            insert 24
+            intersect 12
+            disin 60
+            main 12
+            reduce 20
+            SYSTEM 12
+          END_SAMPLE 1.00
+          MARK 1.50
+          MARK 1.75
+          MARK 1.80
+          BEGIN_SAMPLE 2.00
+            elim 192
+            insert 24
+            intersect 12
+            disin 84
+            main 12
+            SYSTEM 24
+          END_SAMPLE 2.00
+          BEGIN_SAMPLE 2.82
+          END_SAMPLE 2.82
+
+In HpView.lhs, I had a fancy parser to handle all this - but it was
+immensely inefficient.  We can produce something a lot more efficient
+and robust very easily by noting that the only lines we care about
+have precisely two entries on them.
+
+> type Line = String
+> type Word = String
+> type Sample = (Float, [(String, Int)])
+
+> parseProfile :: [[Word]] -> [Sample]
+> parseProfile [] = []
+> parseProfile ([keyword, time]:lines) | keyword == "BEGIN_SAMPLE" =
+>      let (sample,rest) = parseSample lines
+>      in
+>      (read time, sample) : parseProfile rest
+> parseProfile (_:xs) = parseProfile xs
+
+> parseSample :: [[Word]] -> ([(String,Int)],[[Word]])
+> parseSample ([word, count]:lines) =
+>      if word == "END_SAMPLE" 
+>      then ([], lines)
+>      else let (samples, rest) = parseSample lines
+>           in ( (word, read count):samples,  rest )
+> parseSample duff_lines = ([],duff_lines)
+
+> screen_size = 200
+
+> main :: IO ()
+> main =
+>      getArgs                                 >>= \ r ->
+>      case r of 
+>        [filename, ident] -> 
+>              xInitialise [] screen_size screen_size  >>
+>              readFile filename                       >>= \ hp ->
+>              let samples = parseProfile (map words (lines hp))
+>                  totals = [ sum [ s | (_,s) <- ss ] | (t,ss) <- samples ]
+>
+>                  ts = map scale totals
+>                  is = map scale (slice samples ident)
+>              in
+>              graphloop2 (is, []) (ts, [])
+>        _ -> error "usage: hpView2 file identifier\n"
+
+For the example I'm running this on, the following scale does nicely.
+
+> scale :: Int -> Float
+> scale n = (fromInt n) / 10000.0
+
+Slice drawing stuff... shows profile for each identifier (Ignores time
+info in this version...)
+
+> slice :: [Sample] -> String -> [Int]
+> slice samples ident =
+>      [ c | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
+
+> lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
+> lookupPairs ((a', b') : hs) a b =
+>      if a == a' then b' else lookupPairs hs a b
+> lookupPairs [] a b = b
+
+Number of samples to display on screen
+
+> n :: Int
+> n = 40
+
+Graph-drawing loop.  Get's the data for the particular identifier and
+the total usage, scales to get total to fit screen and draws them.
+
+> graphloop2 :: ([Float], [Float]) -> ([Float], [Float]) -> IO ()
+> graphloop2 (i:is,is') (t:ts, ts') =
+>      let is'' = take n (i:is')
+>          ts'' = take n (t:ts')
+>
+>          -- scaling information:
+>          m = maximum ts''
+>          y_scale = (floor m) + 1
+>          y_scale' = fromInt y_scale
+>      in
+>      xCls                                            >>
+>      drawScales y_scale                              >>
+>      draw x_coords [ x / y_scale' | x <- is'' ]      >>
+>      draw x_coords [ x / y_scale' | x <- ts'' ]      >>
+>      xHandleEvent                                    >>
+>      graphloop2 (is,is'') (ts, ts'')
+> graphloop2 _ _ =
+>      return ()
+
+> x_coords :: [Float]
+> x_coords = [ 0.0, 1 / (fromInt n) .. ]
+
+Note: unpleasant as it is, the code cannot be simplified to something
+like the following (which has scope for changing draw to take a list
+of pairs).  The problem is that the graph won't start to be drawn
+until the first @n@ values are available. (Is there also a danger of
+clearing the screen while waiting for the next input value?)  A
+possible alternative solution is to keep count of how many values have
+actually been received.
+
+< graphloop2 :: [Float] -> [Float] -> IO ()
+< graphloop2 [] =
+<      return ()
+< graphloop2 ys =
+<      let ys' = take n ys
+<          m = maximum ys'
+<          y_scale = (floor m) + 1
+<          y_scale' = fromInt y_scale
+<      in
+<      xCls                                            >>
+<      drawScales y_scale                              >>
+<      draw x_coords [ x / y_scale' | x <- ys' ]       >>
+<      xHandleEvent                                    >>
+<      graphloop2 (tail ys)
+
+Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
+
+> draw :: [Float] -> [Float] -> IO ()
+> draw xs ys = drawPoly (zip xs' (reverse ys'))
+>  where
+>   xs' = [ floor (x * sz) | x <- xs ]
+>   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
+>   sz = fromInt screen_size
+
+> drawPoly :: [(Int, Int)] -> IO ()
+> drawPoly ((x1,y1):(x2,y2):poly) =
+>      xDrawLine x1 y1 x2 y2           >>
+>      drawPoly ((x2,y2):poly)
+> drawPoly _ = return ()
+
+Draw horizontal line at major points on y-axis.
+
+> drawScales :: Int -> IO ()
+> drawScales y_scale =
+>      sequence (map drawScale ys)     >>
+>      return ()
+>  where
+>   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
+
+> drawScale :: Float -> IO ()
+> drawScale y =
+>      let y' = floor ((1.0 - y) * (fromInt screen_size))
+>      in
+>      xDrawLine 0 y' screen_size y'
+
+>#include "common-bits"
diff --git a/ghc/utils/heap-view/Jmakefile b/ghc/utils/heap-view/Jmakefile
new file mode 100644 (file)
index 0000000..c3d6b5f
--- /dev/null
@@ -0,0 +1,21 @@
+PROGRAMS =  graph hpView hpView2
+
+OBJS_graph   = Graph.o           HaskXLib.o
+OBJS_hpView  = HpView.o  Parse.o HaskXLib.o
+OBJS_hpView2 = HpView2.o Parse.o HaskXLib.o
+
+HC_OPTS = -hi-diffs -fglasgow-exts -fhaskell-1.3 -O -L/usr/X11/lib -cpp
+CC_OPTS = -ansi -I/usr/X11/include
+
+HaskellSuffixRules()
+
+all :: $(PROGRAMS)
+
+BuildPgmFromHaskellModules(graph,  $(OBJS_graph),  -lX11,)
+BuildPgmFromHaskellModules(hpView, $(OBJS_hpView), -lX11,)
+BuildPgmFromHaskellModules(hpView2,$(OBJS_hpView2),-lX11,)
+
+HaskXLib.o : HaskXLib.c
+       $(CC) -c $(CFLAGS) HaskXLib.c
+
+HaskellDependTarget(Graph.lhs HpView.lhs HpView2.lhs Parse.lhs)
diff --git a/ghc/utils/heap-view/MAIL b/ghc/utils/heap-view/MAIL
new file mode 100644 (file)
index 0000000..966fcdc
--- /dev/null
@@ -0,0 +1,67 @@
+To: partain@dcs.gla.ac.uk
+cc: areid@dcs.gla.ac.uk, andy@dcs.gla.ac.uk
+Subject: Heap profiling programs
+Date: Thu, 09 Dec 93 17:33:09 +0000
+From: Alastair Reid <areid@dcs.gla.ac.uk>
+
+
+I've hacked up a couple of programs which it might be worth putting in
+the next ghc distribution.  They are:
+
+graph: 
+
+  Draws a continuous graph of any one column of the statistics
+  produced using the "+RTS -Sstderr" option.
+
+  I'm not convinced this is astonishingly useful since I'm yet to
+  learn anything useful from (manually) examining these statistics.
+  (Although I do vaguely remember asking Patrick if the heap profiler
+  could do stack profiles too.)
+
+  A typical usage is:
+
+    slife 2 Unis/gardenofeden +RTS -Sstderr -H1M -RTS |& graph 2
+
+  which draws a graph of the third column (ie column 2!) of the
+  stats.
+
+  (btw is there a neater way of connecting stderr to graph's stdin?)
+
+hpView2:       
+
+  Draws a continuous graph of the statistics reported by the "+RTS -h"
+  option.
+
+  Since I understand what the figures mean, this seems to be the more
+  useful program.
+
+  A typical usage is:
+
+    mkfifo slife.hp
+    hpView2 slife.hp Main:mkQuad &
+    slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS 
+    rm slife.hp
+
+  which draws a graph of the total heap usage and the usage for Main:mkQuad.
+
+
+Minor problems:
+
+The code is a gross hack... but it works.  (Maybe distribute in rot13
+format so that you don't get accidentally get exposed to obscene code
+:-))
+
+The code uses a variant of Andy's picoXlibrary (which he was talking
+about releasing but maybe isn't ready to do yet.)
+
+Also, there are lots of obvious extensions etc which could be made but
+haven't yet...  (The major one is being able to set the initial
+scale-factor for displaying the graphs or being able to graph several
+stats at once without having to tee.)
+
+
+Hope you find them interesting.
+
+Alastair
+
+ps Code is in ~areid/hask/Life and should be readable/executable.
diff --git a/ghc/utils/heap-view/Makefile.original b/ghc/utils/heap-view/Makefile.original
new file mode 100644 (file)
index 0000000..1e35bc2
--- /dev/null
@@ -0,0 +1,48 @@
+CC=gcc
+GLHC18 = glhc18
+GLHC19 = /users/fp/partain/bin/sun4/glhc
+HC= ghc -hi-diffs -fglasgow-exts -fhaskell-1.3
+HC_FLAGS = -O -prof -auto-all
+#HC_FLAGS = -O
+LIBS=-lX11
+FILES2 = Life2.o HaskXLib.o
+FILESS = LifeWithStability.o HaskXLib.o
+FILES = Life.o HaskXLib.o
+
+all : hpView hpView2
+
+# ADR's heap profile viewer
+hpView:        HpView.o Parse.o HaskXLib.o
+       $(HC) -o hpView $(HC_FLAGS) HpView.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib
+clean::
+       rm -f hpView
+
+# ADR's continuous heap profile viewer (handles output of -p)
+hpView2:       HpView2.o Parse.o HaskXLib.o
+       $(HC) -o hpView2 $(HC_FLAGS) HpView2.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib
+clean::
+       rm -f hpView2
+
+
+# ADR's continuous graph program (handles output of -Sstderr)
+graph: Graph.o HaskXLib.o
+       $(HC) -o graph $(HC_FLAGS) Graph.o HaskXLib.o $(LIBS) -L/usr/X11/lib
+clean::
+       rm -f graph
+
+# ADR's continuous graph program (part of heap profile viewer) that
+# crashes the compiler
+bugGraph:      bugGraph.o HaskXLib.o
+       $(HC) -o bugGraph $(HC_FLAGS) bugGraph.o HaskXLib.o $(LIBS) -L/usr/X11/lib
+clean::
+       rm -f bugGraph
+
+%.o:%.c
+       $(CC) -c -ansi -traditional -g -I/usr/X11/include/ $< $(INC)
+
+%.o:%.lhs
+       $(HC) $(HC_FLAGS) -c $< $(INC)
+       
+clean::
+       rm -f core *.o *% #* 
+       rm -f *.hc
diff --git a/ghc/utils/heap-view/Parse.lhs b/ghc/utils/heap-view/Parse.lhs
new file mode 100644 (file)
index 0000000..9d7652f
--- /dev/null
@@ -0,0 +1,92 @@
+> module Parse where
+
+The Parser monad in "Comprehending Monads"
+
+> infixr 9 `thenP`
+> infixr 9 `thenP_`
+> infixr 9 `plusP`
+
+> type P t a = [t] -> [(a,[t])]
+
+> unitP :: a -> P t a
+> unitP a = \i -> [(a,i)]
+
+> thenP :: P t a -> (a -> P t b) -> P t b
+> m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1]
+
+> thenP_ :: P t a -> P t b -> P t b
+> m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1]
+
+zeroP is the parser that always fails to parse its input
+
+> zeroP :: P t a
+> zeroP = \i -> []
+
+plusP combines two parsers in parallel
+(called "alt" in "Comprehending Monads")
+
+> plusP :: P t a -> P t a -> P t a
+> a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i)
+
+itemP is the parser that parses a single token
+(called "next" in "Comprehending Monads")
+
+> itemP :: P t t
+> itemP = \i -> [(head i, tail i) | not (null i)]
+
+force successful parse
+
+> cutP :: P t a -> P t a
+> cutP p = \u -> let l = p u in if null l then [] else [head l]
+
+find all complete parses of a given string
+
+> useP :: P t a -> [t] -> [a]
+> useP m =  \x -> [ a | (a,[]) <- m x ]
+
+find first complete parse
+
+> theP :: P t a -> [t] -> a
+> theP m = head . (useP m)
+
+
+Some standard parser definitions
+
+mapP applies f to all current parse trees
+
+> mapP :: (a -> b) -> P t a -> P t b
+> f `mapP` m =  m `thenP` (\a -> unitP (f a))
+
+filter is the parser that parses a single token if it satisfies a
+predicate and fails otherwise.
+
+> filterP :: (a -> Bool) -> P t a -> P t a
+> p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP))
+
+lit recognises literals
+
+> litP :: Eq t => t -> P t ()
+> litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () )
+
+> showP :: (Text a) => P t a -> [t] -> String
+> showP m xs = show (theP m xs)
+
+
+Simon Peyton Jones adds some useful operations:
+
+> zeroOrMoreP :: P t a -> P t [a]
+> zeroOrMoreP p = oneOrMoreP p `plusP` unitP []
+
+> oneOrMoreP :: P t a -> P t [a]
+> oneOrMoreP p = seq p
+>  where seq p = p             `thenP` (\a ->
+>              (seq p          `thenP` (\as -> unitP (a:as)))
+>              `plusP`
+>              unitP [a] )
+
+> oneOrMoreWithSepP :: P t a -> P t b -> P t [a]
+> oneOrMoreWithSepP p1 p2 = seq1 p1 p2
+>   where seq1 p1 p2 = p1 `thenP` (\a -> seq2 p1 p2 a `plusP`  unitP [a])
+>         seq2 p1 p2 a =       p2              `thenP` (\_ ->
+>                              seq1 p1 p2      `thenP` (\as -> unitP (a:as) ))
+
diff --git a/ghc/utils/heap-view/README b/ghc/utils/heap-view/README
new file mode 100644 (file)
index 0000000..db9503a
--- /dev/null
@@ -0,0 +1,62 @@
+@HpView.lhs@ is a very primitive heap profile viewer written in
+Haskell.  It feeds off the same files as hp2ps.  It needs a lot of
+tidying up and would be far more useful as a continuous display.
+(It's in this directory `cos there happens to be a heap profile here
+and I couldn't be bothered setting up a new directory, Makefile, etc.)
+
+@Graph.lhs@ is a continuous heap viewer that "parses" the output of
+the +RTS -Sstderr option.  Typical usage:
+
+   slife 1 r4 +RTS -Sstderr |& graph 2
+
+(You might also try 
+
+   cat data | graph 2
+
+ to see it in action on some sample data.
+)
+
+Things to watch:
+
+  1) Scaling varies from column to column - consult the source.
+
+  2) The horizontal scale is not time - it is garbage collections.
+
+  3) The graph is of the (n+1)st column of the -Sstderr output. 
+
+     The data is not always incredibly useful: For example, when using
+     the (default) Appel 2-space garbage collector, the 3rd column
+     displays the amount of "live" data in the minor space.  A program
+     with a constant data usage will appear to have a sawtooth usage
+     as minor data gradually transfers to the major space and then,
+     suddenly, all gets transferred back at major collections.
+     Decreasing heap size decreases the size of the minor collections
+     and increases major collections exaggerating the sawtooth.
+
+  4) The program is not as robust as it might be.
+
+
+@HpView2.lhs@ is the result of a casual coupling of @Graph.lhs@ and
+@HpView.lhs@ which draws continuous graphs of the heap consisting of:
+total usage and usage by one particular cost centre.  For example:
+
+    mkfifo slife.hp
+    hpView2 slife.hp Main:mkQuad &
+    slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS 
+    rm slife.hp
+
+draws a graph of total usage and usage by the function @mkQuad@.  
+
+(You might also try 
+
+       hpView2 slife.old-hp Main:mkQuad
+
+ to see it in action on some older data)
+
+The business with named pipes (mkfifo) is a little unfortunate - it
+would be nicer if the Haskell runtime system could output to stderr
+(say) which I could pipe into hpView which could just graph it's stdin
+(like graph does).  It's probably worth wrapping the whole thing up in
+a little shell-script.
+
+
diff --git a/ghc/utils/heap-view/common-bits b/ghc/utils/heap-view/common-bits
new file mode 100644 (file)
index 0000000..f41223b
--- /dev/null
@@ -0,0 +1,35 @@
+ -----------------------------------------------------------------------------
+
+ xInitialise :: [String] -> Int -> Int -> IO ()
+ xInitialise str x y = 
+        _ccall_ haskXBegin x y (0::Int)        `seqPrimIO`
+        return ()
+
+ xHandleEvent :: IO ()
+ xHandleEvent = 
+        _ccall_ haskHandleEvent                `thenPrimIO` \ n ->
+        case (n::Int) of
+                0 -> return ()
+                _ -> error "Unknown Message back from Handle Event"
+
+ xClose :: IO ()
+ xClose =
+         _ccall_ haskXClose            `seqPrimIO`
+         return ()
+
+ xCls :: IO ()
+ xCls = 
+        _ccall_ haskXCls               `seqPrimIO`
+        return ()
+
+ xDrawLine :: Int -> Int -> Int -> Int -> IO ()
+ xDrawLine x1 y1 x2 y2 =
+        _ccall_ haskXDraw x1 y1 x2 y2  `seqPrimIO`
+        return ()
+
+ ----------------------------------------------------------------
+
+ usleep :: Int -> IO ()
+ usleep t =
+        _ccall_ usleep t               `seqPrimIO`
+        return ()
index e915bca..bfc309f 100644 (file)
@@ -146,8 +146,11 @@ foreach $sf (@Src_files) {
     # a de-commenter (not implemented);
     # builds up @Depend_lines
     print STDERR "Here we go for source file: $sf\n" if $Verbose;
     # a de-commenter (not implemented);
     # builds up @Depend_lines
     print STDERR "Here we go for source file: $sf\n" if $Verbose;
-    ($of = $sf) =~ s/\.l?hs$/$Obj_suffix/;
-    push(@Depend_lines, "$of : $sf\n");
+    ($bf = $sf) =~ s/\.l?hs$//;
+    push(@Depend_lines, "$bf$Obj_suffix : $sf\n");
+    foreach $suff (@File_suffix) {
+        push(@Depend_lines, "$bf$suff$Obj_suffix : $sf\n");
+    }
 
     # if it's a literate file, .lhs, then we de-literatize it:
     if ( $sf !~ /\.lhs$/ ) {
 
     # if it's a literate file, .lhs, then we de-literatize it:
     if ( $sf !~ /\.lhs$/ ) {
@@ -220,6 +223,9 @@ sub mangle_command_line_args {
                $Makefile       = &grab_arg_arg('-f',$1);
            } elsif ( /^-o(.*)/ ) {
                $Obj_suffix     = &grab_arg_arg('-o',$1);
                $Makefile       = &grab_arg_arg('-f',$1);
            } elsif ( /^-o(.*)/ ) {
                $Obj_suffix     = &grab_arg_arg('-o',$1);
+           } elsif ( /^-s(.*)/ ) {
+               local($suff)    =  &grab_arg_arg('-s',$1);
+               $File_suffix{$suff} = $suff;
            } elsif ( /^-bs(.*)/ ) {
                $Begin_magic_str = &grab_arg_arg('-bs',$1) . "\n";
            } elsif ( /^-es(.*)/ ) {
            } elsif ( /^-bs(.*)/ ) {
                $Begin_magic_str = &grab_arg_arg('-bs',$1) . "\n";
            } elsif ( /^-es(.*)/ ) {
@@ -236,6 +242,7 @@ sub mangle_command_line_args {
            push(@Src_files,$_) if ! /^-/;
        }
     }
            push(@Src_files,$_) if ! /^-/;
        }
     }
+    @File_suffix = sort (keys %File_suffix);
 }
 
 sub grab_arg_arg {
 }
 
 sub grab_arg_arg {
@@ -263,9 +270,9 @@ sub slurp_file_for_imports {
     # we mangle #include's so they will also leave something
     # behind to indicate the dependency on _them_
 
     # we mangle #include's so they will also leave something
     # behind to indicate the dependency on _them_
 
-    print STDERR "sed -e '/^# *include/{p;s/^# *include/!include/;};s/'\\''//g;s/\"//g' $file_to_read | $Cpp $Include_dirs -I$last_seen_dir @Defines |\n" if $Verbose;
+    print STDERR "/usr/bin/sed -e '/^# *include/{p;s/^# *include/!include/;};s/'\\''//g;s/\"//g' $file_to_read | $Cpp $Include_dirs -I$last_seen_dir @Defines |\n" if $Verbose;
 
 
-    open(SRCFILE, "sed -e '/^# *include/{p;s/^# *include/!include/;};s/'\\''//g;s/\"//g' $file_to_read | $Cpp $Include_dirs -I$last_seen_dir @Defines |")
+    open(SRCFILE, "/usr/bin/sed -e '/^# *include/{p;s/^# *include/!include/;};s/'\\''//g;s/\"//g' $file_to_read | $Cpp $Include_dirs -I$last_seen_dir @Defines |")
        || die "$Pgm: Can't open $file_to_read: $!\n";
 
     while (<SRCFILE>) {
        || die "$Pgm: Can't open $file_to_read: $!\n";
 
     while (<SRCFILE>) {
@@ -281,9 +288,22 @@ sub slurp_file_for_imports {
 
                if ($follow_file ne '__syslib__') {
                    local($int_file);
 
                if ($follow_file ne '__syslib__') {
                    local($int_file);
-                   ($int_file = $follow_file) =~ s/\.l?hs$/\.hi/;
-
-                   push(@Depend_lines, "$of : $int_file\n");
+                   $int_file = $follow_file;
+                   if ( $int_file !~ /\.(l?hs|hi)$/ ) {
+                       push(@Depend_lines, "$bf$Obj_suffix : $int_file\n");
+                       foreach $suff (@File_suffix) {
+                           push(@Depend_lines, "$bf$suff$Obj_suffix : $int_file\n");
+                       }
+
+                   } else {
+                       $int_file =~ s/\.l?hs$//;
+                       $int_file =~ s/\.hi$//;
+
+                       push(@Depend_lines, "$bf$Obj_suffix : $int_file.hi\n");
+                       foreach $suff (@File_suffix) {
+                           push(@Depend_lines, "$bf$suff$Obj_suffix : $int_file$suff.hi\n");
+                       }
+                   }
                }
             } else {
                 die "$orig_src_file: Couldn't handle: $_\n";
                }
             } else {
                 die "$orig_src_file: Couldn't handle: $_\n";
index 2ba9cc3..f57489d 100644 (file)
@@ -188,6 +188,9 @@ g_tagfun(typid)
 {
     fprintf(fh, "#ifdef __GNUC__\n");
 
 {
     fprintf(fh, "#ifdef __GNUC__\n");
 
+    /* to satisfy GCC when in really-picky mode: */
+    fprintf(fh, "T%s t%s(%s t);\n", typid, typid, typid);
+    /* the real thing: */
     fprintf(fh, "extern __inline__ T%s t%s(%s t)\n{\n\treturn(t -> tag);\n}\n",
                typid, typid, typid);
 
     fprintf(fh, "extern __inline__ T%s t%s(%s t)\n{\n\treturn(t -> tag);\n}\n",
                typid, typid, typid);
 
@@ -238,19 +241,37 @@ gencons(typid, t)
   id typid;
   tree t; /* of kind 'def'. */
 {
   id typid;
   tree t; /* of kind 'def'. */
 {
+       tree itemlist = gditemlist(t);
+
        fprintf(fh, "extern %s mk%s PROTO((", typid, gdid(t));
        fprintf(fh, "extern %s mk%s PROTO((", typid, gdid(t));
-       genmkprotodekl(gditemlist(t));
+       switch (ttree(itemlist)) {
+         case emitemlist: /* empty list */
+           fprintf(fh, "void");
+           break;
+         default:
+           genmkprotodekl(itemlist);
+           break;
+       }
        fprintf(fh, "));\n");
 
        fprintf(fc, "%s mk%s(", typid, gdid(t));
        fprintf(fh, "));\n");
 
        fprintf(fc, "%s mk%s(", typid, gdid(t));
-       genmkparamlist(gditemlist(t));
+       switch (ttree(itemlist)) {
+         case emitemlist: /* empty list */
+           fprintf(fc, "void");
+           break;
+         default:
+           genmkparamlist(itemlist);
+           break;
+       }
        fprintf(fc, ")\n");
        fprintf(fc, ")\n");
-       genmkparamdekl(gditemlist(t));
+
+       genmkparamdekl(itemlist);
+
        fprintf(fc, "{\n\tregister struct S%s *pp =\n", gdid(t));
        fprintf(fc, "\t\t(struct S%s *) malloc(sizeof(struct S%s));\n",
                    gdid(t), gdid(t));
        fprintf(fc, "\tpp -> tag = %s;\n", gdid(t));
        fprintf(fc, "{\n\tregister struct S%s *pp =\n", gdid(t));
        fprintf(fc, "\t\t(struct S%s *) malloc(sizeof(struct S%s));\n",
                    gdid(t), gdid(t));
        fprintf(fc, "\tpp -> tag = %s;\n", gdid(t));
-       genmkfillin(gditemlist(t));
+       genmkfillin(itemlist);
        fprintf(fc, "\treturn((%s)pp);\n", typid);
        fprintf(fc, "}\n");
 }
        fprintf(fc, "\treturn((%s)pp);\n", typid);
        fprintf(fc, "}\n");
 }
@@ -354,6 +375,10 @@ gensels(typid, variantid, t)
          case item:
                fprintf(fh, "#ifdef __GNUC__\n");
 
          case item:
                fprintf(fh, "#ifdef __GNUC__\n");
 
+               /* to satisfy GCC when in extremely-picky mode: */
+               fprintf(fh, "\n%s *R%s PROTO((struct S%s *));\n", 
+                            gitemtypid(t), gitemfunid(t), variantid);
+               /* the real thing: */
                fprintf(fh, "\nextern __inline__ %s *R%s(struct S%s *t)\n{\n", 
                             gitemtypid(t), gitemfunid(t), variantid);
                fprintf(fh, "#ifdef UGEN_DEBUG\n");
                fprintf(fh, "\nextern __inline__ %s *R%s(struct S%s *t)\n{\n", 
                             gitemtypid(t), gitemfunid(t), variantid);
                fprintf(fh, "#ifdef UGEN_DEBUG\n");
index bd97381..4ba2f09 100644 (file)
@@ -40,7 +40,8 @@ $DefaultStdoutFile = "$TmpPrefix/no_stdout$$"; # can't use /dev/null (e.g. Alpha
 $DefaultStderrFile = "$TmpPrefix/no_stderr$$";
 @PgmStdoutFile = ();
 @PgmStderrFile = ();
 $DefaultStderrFile = "$TmpPrefix/no_stderr$$";
 @PgmStdoutFile = ();
 @PgmStderrFile = ();
-$AltScript = '';
+$PreScript = '';
+$PostScript = '';
 $TimeCmd = '';
 $StatsFile = "$TmpPrefix/stats$$";
 $SysSpecificTiming = '';
 $TimeCmd = '';
 $StatsFile = "$TmpPrefix/stats$$";
 $SysSpecificTiming = '';
@@ -72,10 +73,10 @@ arg: while ($_ = $ARGV[0]) {
     /^-o2(.*)/ && do { $out_file = &grab_arg_arg('-o2',$1);
                        push(@PgmStderrFile, $out_file);
                        next arg; };
     /^-o2(.*)/ && do { $out_file = &grab_arg_arg('-o2',$1);
                        push(@PgmStderrFile, $out_file);
                        next arg; };
-    /^-script(.*)/ && do { $AltScript = &grab_arg_arg('-script',$1);
-                          @PgmStdoutFile = (); # re-init
-                          @PgmStderrFile = (); # ditto
-                          next arg; };
+    /^-prescript(.*)/  && do { $PreScript = &grab_arg_arg('-prescript',$1);
+                               next arg; };
+    /^-postscript(.*)/ && do { $PostScript = &grab_arg_arg('-postscript',$1);
+                               next arg; };
     /^-(ghc|hbc)-timing$/ && do { $SysSpecificTiming = $1;
                                  next arg; };
     /^-spix-timing$/ && do { $SysSpecificTiming = 'ghcspix';
     /^-(ghc|hbc)-timing$/ && do { $SysSpecificTiming = $1;
                                  next arg; };
     /^-spix-timing$/ && do { $SysSpecificTiming = 'ghcspix';
@@ -129,19 +130,6 @@ if ( $SysSpecificTiming =~ /^ghc/ ) {
     $TimingMagic = "-S$StatsFile";
 }
 
     $TimingMagic = "-S$StatsFile";
 }
 
-if ($AltScript ne '') {
-    local($to_do);
-    $to_do = `cat $AltScript`;
-    # glue in pgm to run...
-    $* = 1;
-    $to_do =~ s/^\$1 /$ToRun /;
-    &run_something($to_do);
-    exit 0;
-#    exec "$AltScript $ToRun";
-#    print STDERR "Failed to exec!!! $AltScript $ToRun\n";
-#    exit 1;
-}
-
 $ToRunOrig = $ToRun;
 if ( $SpixTiming eq 'yes' ) {
     $ToRun .= '.spix';
 $ToRunOrig = $ToRun;
 if ( $SpixTiming eq 'yes' ) {
     $ToRun .= '.spix';
@@ -159,11 +147,32 @@ if ( $SpixTiming eq 'yes' ) {
     }
     close(SPIXNM); # || die "nm -n $ToRunOrig close failed!\n";
 
     }
     close(SPIXNM); # || die "nm -n $ToRunOrig close failed!\n";
 
-    $SpixifyLine = "spix -o $ToRun -t$FirstSpix,$LastSpix $ToRunOrig";
-    $SpixstatsLine = "spixstats -b $TmpPrefix/runtest$$.3 $ToRunOrig > $ToRunOrig.spixstats";
+    $SpixifyLine1 = "spix -o $ToRun -t$FirstSpix,$LastSpix $ToRunOrig";
+    $SpixstatsLine1 = "spixstats -b $TmpPrefix/runtest$$.3 $ToRunOrig > $ToRunOrig.spixstats1";
+    $SpixifyLine2 = "spix -o $ToRun +t$FirstSpix,$LastSpix $ToRunOrig";
+    $SpixstatsLine2 = "spixstats -b $TmpPrefix/runtest$$.3 $ToRunOrig > $ToRunOrig.spixstats2";
+} else {
+    $SpixifyLine1 = '';
+    $SpixstatsLine1 = '';
+    $SpixifyLine2 = '';
+    $SpixstatsLine2 = '';
+}
+
+if ($PreScript ne '') {
+    local($to_do);
+    $PreScriptLines = `cat $PreScript`;
+} else {
+    $PreScriptLines = '';
+}
+
+if ($PostScript ne '') {
+    local($to_do);
+    $PostScriptLines = `cat $PostScript`;
+    $* = 1;
+    $PostScriptLines =~ s#\$o1#$TmpPrefix/runtest$$.1#g;
+    $PostScriptLines =~ s#\$o2#$TmpPrefix/runtest$$.2#g;
 } else {
 } else {
-    $SpixifyLine = '';
-    $SpixstatsLine = '';
+    $PostScriptLines = '';
 }
 
 # OK, so we're gonna do the normal thing...
 }
 
 # OK, so we're gonna do the normal thing...
@@ -175,7 +184,8 @@ diffsShown=0
 rm -f $DefaultStdoutFile $DefaultStderrFile
 cat /dev/null > $DefaultStdoutFile
 cat /dev/null > $DefaultStderrFile
 rm -f $DefaultStdoutFile $DefaultStderrFile
 cat /dev/null > $DefaultStdoutFile
 cat /dev/null > $DefaultStderrFile
-$SpixifyLine
+$PreScriptLines
+$SpixifyLine1
 $TimeCmd /bin/sh -c \'$ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\'
 progexit=\$?
 if [ \$progexit -ne $PgmExitStatus ]; then
 $TimeCmd /bin/sh -c \'$ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\'
 progexit=\$?
 if [ \$progexit -ne $PgmExitStatus ]; then
@@ -183,6 +193,7 @@ if [ \$progexit -ne $PgmExitStatus ]; then
     echo expected exit status $PgmExitStatus not seen \\; got \$progexit
     myexit=1
 else
     echo expected exit status $PgmExitStatus not seen \\; got \$progexit
     myexit=1
 else
+    $PostScriptLines
     hit='NO'
     for out_file in @PgmStdoutFile ; do
        if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then
     hit='NO'
     for out_file in @PgmStdoutFile ; do
        if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then
@@ -213,7 +224,14 @@ if [ \$hit = 'NO' ] ; then
     myexit=1
     diffsShown=1
 fi
     myexit=1
     diffsShown=1
 fi
-$SpixstatsLine
+$SpixstatsLine1
+
+if [ $SpixTiming = 'yes' -a \$myexit = 0 ] ; then
+    $SpixifyLine2
+    $TimeCmd /bin/sh -c \'$ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> /dev/null 2> /dev/null 3> $TmpPrefix/runtest$$.3\'
+    $SpixstatsLine2
+fi
+
 $(RM) core $ToRunOrig.spix $DefaultStdoutFile $DefaultStderrFile $TmpPrefix/runtest$$.1 $TmpPrefix/runtest$$.2 $TmpPrefix/runtest$$.3
 exit \$myexit
 EOSCRIPT
 $(RM) core $ToRunOrig.spix $DefaultStdoutFile $DefaultStderrFile $TmpPrefix/runtest$$.1 $TmpPrefix/runtest$$.2 $TmpPrefix/runtest$$.3
 exit \$myexit
 EOSCRIPT
@@ -235,16 +253,16 @@ if ( $SysSpecificTiming eq '' ) {
 }
 
 &process_stats_file();
 }
 
 &process_stats_file();
-&process_spixstats_file() if $SpixTiming eq 'yes';
+&process_spixstats_files() if $SpixTiming eq 'yes';
 
 # print out what we found
 if ( $SpixTiming ne 'yes' ) {
     print STDERR "<<$SysSpecificTiming: ",
 
 # print out what we found
 if ( $SpixTiming ne 'yes' ) {
     print STDERR "<<$SysSpecificTiming: ",
-       "$BytesAlloc bytes, $GCs GCs, $MaxResidency bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
+       "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
        " :$SysSpecificTiming>>\n";
 } else {
     print STDERR "<<$SysSpecificTiming: ",
        " :$SysSpecificTiming>>\n";
 } else {
     print STDERR "<<$SysSpecificTiming: ",
-       "$BytesAlloc bytes, $GCs GCs, $MaxResidency bytes residency ($ResidencySamples samples), $TotalInsns instructions, $LoadInsns loads, $StoreInsns stores, $BranchInsns branches, $OtherInsns others",
+       "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $TotalInsns[1]/$TotalInsns[2] instructions, $LoadInsns[1]/$LoadInsns[2] loads, $StoreInsns[1]/$StoreInsns[2] stores, $BranchInsns[1]/$BranchInsns[2] branches, $OtherInsns[1]/$OtherInsns[2] others",
        " :$SysSpecificTiming>>\n";
 }
 
        " :$SysSpecificTiming>>\n";
 }
 
@@ -297,7 +315,11 @@ sub process_stats_file {
        #NB: nearly the same as in GHC driver's -ghc-timing stuff
 
        open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
        #NB: nearly the same as in GHC driver's -ghc-timing stuff
 
        open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
+       local($tot_live) = 0; # for calculating avg residency
+
        while (<STATS>) {
        while (<STATS>) {
+           $tot_live += $1 if /^\s*\d+\s+\d+\s+\d+\.\d+\%\s+(\d+)\s+\d+\.\d+\%/;
+
            $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
 
            if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
            $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
 
            if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
@@ -315,6 +337,9 @@ sub process_stats_file {
            }
        }
        close(STATS) || die "Failed when closing $StatsFile\n";
            }
        }
        close(STATS) || die "Failed when closing $StatsFile\n";
+       if ( defined($ResidencySamples) && $ResidencySamples > 0 ) {
+           $AvgResidency = int ($tot_live / $ResidencySamples) ;
+       }
 
     } elsif ( $SysSpecificTiming eq 'hbc' ) {
 
 
     } elsif ( $SysSpecificTiming eq 'hbc' ) {
 
@@ -352,6 +377,7 @@ sub process_stats_file {
 
     # things we didn't necessarily expect to find
     $MaxResidency     = 0 unless defined($MaxResidency);
 
     # things we didn't necessarily expect to find
     $MaxResidency     = 0 unless defined($MaxResidency);
+    $AvgResidency     = 0 unless defined($AvgResidency);
     $ResidencySamples = 0 unless defined($ResidencySamples);
 
     # a bit of tidying
     $ResidencySamples = 0 unless defined($ResidencySamples);
 
     # a bit of tidying
@@ -366,44 +392,47 @@ sub process_stats_file {
     $GcElapsed =~ s/,//g;
 }
 
     $GcElapsed =~ s/,//g;
 }
 
-sub process_spixstats_file {
+sub process_spixstats_files { # 2 of them; one for mutator, one for GC
 
 
-    $TotalInsns = 0;
-    $LoadInsns  = 0;
-    $StoreInsns = 0;
-    $BranchInsns= 0;
-    $OtherInsns = 0;
+    @TotalInsns = ();
+    @LoadInsns  = ();
+    @StoreInsns = ();
+    @BranchInsns= ();
+    @OtherInsns = ();
 
 
-    open(STATS, "< $ToRunOrig.spixstats") || die "Failed when opening $ToRunOrig.spixstats\n";
-    while (<STATS>) {
-       last if /^OPCODES \(STATIC\):/; # party over
+    foreach $f (1, 2) {
 
 
-       next if /^OPCODES \(DYNAMIC\):/;
-       next if /^$/;
-       next if /^opcode\s+#executed/;
-       next if /^SUBTOTAL/;
+      open(STATS, "< $ToRunOrig.spixstats$f") || die "Failed when opening $ToRunOrig.spixstats$f\n";
+      while (<STATS>) {
+         last if /^OPCODES \(STATIC\):/; # party over
 
 
-       if ( /^ld\S*\s+(\d+)/ ) {
-           $LoadInsns += $1;
+         next if /^OPCODES \(DYNAMIC\):/;
+         next if /^$/;
+         next if /^opcode\s+#executed/;
+         next if /^SUBTOTAL/;
 
 
-       } elsif ( /^st\S*\s+(\d+)/ ) {
-           $StoreInsns += $1;
+         if ( /^ld\S*\s+(\d+)/ ) {
+             $LoadInsns[$f] += $1;
 
 
-       } elsif ( /^(jmpl|call|b\S*)\s+(\d+)/ ) {
-           $BranchInsns += $2;
+         } elsif ( /^st\S*\s+(\d+)/ ) {
+             $StoreInsns[$f] += $1;
 
 
-       } elsif ( /^TOTAL\s+(\d+)/ ) {
-           $TotalInsns = $1;
-           print STDERR "TotalInsns doesn't match categories total!\n"
-               if $TotalInsns !=
-                  ($LoadInsns + $StoreInsns + $BranchInsns + $OtherInsns);
+         } elsif ( /^(jmpl|call|b\S*)\s+(\d+)/ ) {
+             $BranchInsns[$f] += $2;
 
 
-       } elsif ( /^\S+\s+(\d+)/ ) {
-           $OtherInsns += $1;
+         } elsif ( /^TOTAL\s+(\d+)/ ) {
+             $TotalInsns[$f] = $1;
+             print STDERR "TotalInsns doesn't match categories total!\n"
+                 if $TotalInsns[$f] !=
+                    ($LoadInsns[$f] + $StoreInsns[$f] + $BranchInsns[$f] + $OtherInsns[$f]);
 
 
-       } else {
-           die "Funny line?? $_";
-       }
+         } elsif ( /^\S+\s+(\d+)/ ) {
+             $OtherInsns[$f] += $1;
+
+         } else {
+             die "Funny line?? $_";
+         }
+      }
+      close(STATS) || die "Failed when closing $ToRunOrig.spixstats\n";
     }
     }
-    close(STATS) || die "Failed when closing $ToRunOrig.spixstats\n";
 }
 }