Remove ext-core

It is now a separately maintained package, available from hackage:
http://hackage.haskell.org/package/extcore

diff --git a/utils/Makefile b/utils/Makefile
index 84df51e..881d7d5 100644 (file)
--- a/utils/Makefile
+++ b/utils/Makefile
@@ -29,7 +29,6 @@ endif
 # Utils that are old and/or bitrotted:
 #      stat2resid
 #      debugNCG
 # Utils that are old and/or bitrotted:
 #      stat2resid
 #      debugNCG

-#      ext-core

 #      genargs
 #      heap-view
 #      pvm
 #      genargs
 #      heap-view
 #      pvm

diff --git a/utils/ext-core/Driver.hs b/utils/ext-core/Driver.hs
deleted file mode 100644 (file)
index c2eee43..0000000
--- a/utils/ext-core/Driver.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-{-# OPTIONS -Wall #-}
-{- A simple driver that loads, typechecks, prepares, re-typechecks, and interprets the 
-    GHC standard Prelude modules and an application module called Main. 
-
-   Note that, if compiled under GHC, this requires a very large heap to run!
--}
-
-import Control.Exception
-import Data.List
-import Data.Maybe
-import Monad
-import Prelude hiding (catch)
-import System.Cmd
-import System.Console.GetOpt
-import System.Environment
-import System.Exit
-import System.FilePath
-
-import Language.Core.Core
-import Language.Core.Dependencies
-import Language.Core.Overrides
-import Language.Core.Prims
-import Language.Core.Check
-import Language.Core.Prep
-import Language.Core.Interp
-import Language.Core.ParsecParser
-
--- You may need to change this.
-baseDir :: FilePath
-baseDir = "../../libraries/"
--- change to True to typecheck library files as well as reading type signatures
-typecheckLibs :: Bool
-typecheckLibs = False
-
--- You shouldn't *need* to change anything below this line...                  
-
--- Code to check that the external and GHC printers print the same results
-validateResults :: FilePath -> Module -> IO ()
-validateResults origFile m = do
-  let genFile = origFile </> "parsed"
-  writeFile genFile (show m) 
-  resultCode <- system $ "diff -u " ++ origFile ++ " " ++ genFile
-  putStrLn $ case resultCode of
-    ExitSuccess   -> "Parse validated for " ++ origFile
-    ExitFailure 1 -> "Parse failed to validate for " ++ origFile
-    _             -> "Error diffing files: " ++ origFile ++ " " ++ genFile
-------------------------------------------------------------------------------
-
-data Flag = Test | NoDeps
-  deriving Eq
-
-options :: [OptDescr Flag]
-options =
-  [Option ['t'] ["test"] (NoArg Test) "validate prettyprinted code",
-   Option ['n'] ["no-deps"] (NoArg NoDeps) "don't compute dependencies automatically"
-  ]
-
-process :: Bool -> (Menv,[Module]) -> (FilePath, Module)
-             -> IO (Menv,[Module])
-process _ (senv,modules) p@(f,m) | isLib p && not typecheckLibs = do
-  -- if it's a library and we set typecheckLibs to False:
-  -- prep, but don't typecheck
-  m' <- prepM senv m f
-  return (senv, modules ++ [m'])
-    where isLib (fp,_) = baseDir `isPrefixOf` fp
-process doTest (senv,modules) (f, m@(Module mn _ _)) = catch (do
-        when doTest $ validateResults f m
-       (case checkModule senv m of
-           OkC senv' ->
-            do putStrLn $ "Check succeeded for " ++ show mn
-                m' <- prepM senv' m f
-               case checkModule senv' m' of
-                  OkC senv'' ->
-                     do putStrLn "Recheck succeeded"
-                         return (senv'',modules ++ [m'])
-                 FailC s -> 
-                     do putStrLn ("Recheck failed: " ++ s)
-                        error "quit"
-          FailC s -> error ("Typechecking failed: " ++ s))) handler
-   where handler e = do
-           putStrLn ("WARNING: we caught an exception " ++ show e 
-                     ++ " while processing " ++ f)
-           return (senv, modules)
-
-prepM :: Menv -> Module -> FilePath -> IO Module
-prepM senv' m _f = do
-  let m' = prepModule senv' m
-  --writeFile (f </> ".prepped") (show m')
-  return m'
-
-main :: IO ()
-main = do
-  args <- getArgs
-  case getOpt Permute options args of
-    (opts, fnames@(_:_), _) ->
-       let doTest      = Test `elem` opts
-           computeDeps = NoDeps `notElem` opts in
-         doOneProgram computeDeps doTest fnames
-    _ -> error "usage: ./Driver [filename]"
-  where  doOneProgram :: Bool -> Bool -> [FilePath] -> IO ()
-         doOneProgram computeDeps doTest fns = do
-               putStrLn $ "========== Program " ++ (show fns) ++ " ============="
-               deps <- if computeDeps 
-                         then
-                           getDependencies fns
-                         else (liftM catMaybes) (mapM findModuleDirect fns)
-               putStrLn $ "deps = " ++ show (fst (unzip deps))
-               {-
-                 Note that we scan over the libraries twice:
-                 first to gather together all type sigs, then to typecheck them
-                 (the latter of which doesn't necessarily have to be done every time.)
-                 This is a hack to avoid dealing with circular dependencies. 
-                -}
-               -- notice: scan over libraries *and* input modules first, not just libs
-               topEnv <- mkInitialEnv (snd (unzip deps))
-               (_,modules) <- foldM (process doTest) (topEnv,[]) deps
-               let succeeded = length modules
-               putStrLn ("Finished typechecking. Successfully checked " 
-                          ++ show succeeded)
-               overridden <- override modules
-               result <- evalProgram overridden
-               putStrLn ("Result = " ++ show result)
-               putStrLn "All done\n============================================="
-
-         mkInitialEnv :: [Module] -> IO Menv
-         mkInitialEnv libs = foldM mkTypeEnv initialEnv libs
-
-         mkTypeEnv :: Menv -> Module -> IO Menv
-         mkTypeEnv globalEnv m@(Module mn _ _) = 
-                catch (return (envsModule globalEnv m)) handler
-                  where handler e = do
-                          putStrLn ("WARNING: mkTypeEnv caught an exception " ++ show e 
-                                    ++ " while processing " ++ show mn)
-                          return globalEnv
-
-findModuleDirect :: FilePath -> IO (Maybe (FilePath, Module))
--- kludge to let us run "make libtest" -- 
--- this module (in the Cabal package) causes an uncaught exception
--- from Prelude.chr, which I haven't been able to track down
-findModuleDirect fn | "PackageDescription.hcr" `isSuffixOf` fn = return Nothing
-findModuleDirect fn = do
-  putStrLn $ "Finding " ++ show fn
-  res <- parseCore fn
-  case res of
-    Left err -> error (show err)
-    Right m -> return $ Just (fn,m)
\ No newline at end of file

diff --git a/utils/ext-core/LICENSE b/utils/ext-core/LICENSE
deleted file mode 100644 (file)
index 66231da..0000000
--- a/utils/ext-core/LICENSE
+++ /dev/null
@@ -1 +0,0 @@
-See the Glasgow Haskell Compiler license.

diff --git a/utils/ext-core/Language/Core/Check.hs b/utils/ext-core/Language/Core/Check.hs
deleted file mode 100644 (file)
index 3ae94e3..0000000
--- a/utils/ext-core/Language/Core/Check.hs
+++ /dev/null
@@ -1,649 +0,0 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-module Language.Core.Check(
-  checkModule, envsModule,
-  checkExpr, checkType, 
-  primCoercionError, 
-  Menv, Venv, Tvenv, Envs(..),
-  CheckRes(..), splitTy, substl,
-  mkTypeEnvsNoChecking, NtEnv, mkNtEnv) where
-
---import Debug.Trace
-
-import Language.Core.Core
-import Language.Core.CoreUtils
-import Language.Core.Printer()
-import Language.Core.PrimEnv
-import Language.Core.Env
-import Language.Core.Environments
-
-import Control.Monad.Reader
-import Data.List
-import qualified Data.Map as M
-import Data.Maybe
-
-{- Checking is done in a simple error monad.  In addition to
-   allowing errors to be captured, this makes it easy to guarantee
-   that checking itself has been completed for an entire module. -}
-
-{- We use the Reader monad transformer in order to thread the 
-   top-level module name throughout the computation simply.
-   This is so that checkExp can also be an entry point (we call it
-   from Prep.) -}
-data CheckRes a = OkC a | FailC String
-type CheckResult a = ReaderT (AnMname, Menv) CheckRes a
-getMname :: CheckResult AnMname
-getMname     = ask >>= (return . fst)
-getGlobalEnv :: CheckResult Menv
-getGlobalEnv = ask >>= (return . snd)
-
-instance Monad CheckRes where
-  OkC a >>= k = k a
-  FailC s >>= _ = fail s
-  return = OkC
-  fail = FailC
-
-require :: Bool -> String -> CheckResult ()
-require False s = fail s
-require True  _ = return ()
-
-
-extendM :: (Ord a, Show a) => Bool -> EnvType -> Env a b -> (a,b) -> CheckResult (Env a b)
-extendM checkNameShadowing envType env (k,d) = 
-   case elookup env k of
-     Just _ | envType == NotTv && checkNameShadowing -> fail ("multiply-defined identifier: " 
-                                      ++ show k)
-     _ -> return (eextend env (k,d))
-
-extendVenv :: (Ord a, Show a) => Bool -> Env a b -> (a,b) -> CheckResult (Env a b)
-extendVenv check = extendM check NotTv
-
-extendTvenv :: (Ord a, Show a) => Env a b -> (a,b) -> CheckResult (Env a b)
-extendTvenv = extendM True Tv
-
-lookupM :: (Ord a, Show a) => Env a b -> a -> CheckResult (Maybe b)
-lookupM env k = return $ elookup env k
-          
-{- Main entry point. -}
-checkModule :: Menv -> Module -> CheckRes Menv
-checkModule globalEnv (Module mn tdefs vdefgs) = 
-  runReaderT 
-    (do (tcenv, cenv) <- mkTypeEnvs tdefs
-        (e_venv,_) <- foldM (checkVdefg True (tcenv,eempty,cenv))
-                              (eempty,eempty) 
-                              vdefgs
-        return (eextend globalEnv 
-            (mn,Envs{tcenv_=tcenv,cenv_=cenv,venv_=e_venv})))
-    (mn, globalEnv)
-
--- Like checkModule, but doesn't typecheck the code, instead just
--- returning declared types for top-level defns.
--- This is necessary in order to handle circular dependencies, but it's sort
--- of unpleasant.
-envsModule :: Menv -> Module -> Menv
-envsModule globalEnv (Module mn tdefs vdefgs) = 
-   let (tcenv, cenv) = mkTypeEnvsNoChecking tdefs
-       e_venv               = foldr vdefgTypes eempty vdefgs in
-     eextend globalEnv (mn, 
-             (Envs{tcenv_=tcenv,cenv_=cenv,venv_=e_venv}))
-        where vdefgTypes :: Vdefg -> Venv -> Venv
-              vdefgTypes (Nonrec (Vdef (v,t,_))) e =
-                             add [(v,t)] e
-              vdefgTypes (Rec vds) e = 
-                             add (map (\ (Vdef (v,t,_)) -> (v,t)) vds) e
-              add :: [(Qual Var,Ty)] -> Venv -> Venv
-              add pairs e = foldr addOne e pairs
-              addOne :: (Qual Var, Ty) -> Venv -> Venv
-              addOne ((_,v),t) e  = eextend e (v,t)
-
-checkTdef0 :: Tcenv -> Tdef -> CheckResult Tcenv
-checkTdef0 tcenv tdef = ch tdef
-      where 
-       ch (Data (m,c) tbs _) = 
-           do mn <- getMname
-               requireModulesEq m mn "data type declaration" tdef False
-              extendM True NotTv tcenv (c, Kind k)
-           where k = foldr Karrow Klifted (map snd tbs)
-       ch (Newtype (m,c) coVar tbs rhs) = 
-           do mn <- getMname
-               requireModulesEq m mn "newtype declaration" tdef False
-              tcenv' <- extendM True NotTv tcenv (c, Kind k)
-               -- add newtype axiom to env
-               tcenv'' <- envPlusNewtype tcenv' (m,c) coVar tbs rhs
-              return tcenv''
-           where k = foldr Karrow Klifted (map snd tbs)
-
-processTdef0NoChecking :: Tcenv -> Tdef -> Tcenv
-processTdef0NoChecking tcenv tdef = ch tdef
-      where 
-       ch (Data (_,c) tbs _) = eextend tcenv (c, Kind k)
-           where k = foldr Karrow Klifted (map snd tbs)
-       ch (Newtype tc@(_,c) coercion tbs rhs) = 
-           let tcenv' = eextend tcenv (c, Kind k) in
-                -- add newtype axiom to env
-                eextend tcenv'
-                  (snd coercion, Coercion $ DefinedCoercion tbs
-                    (foldl Tapp (Tcon tc) (map Tvar (fst (unzip tbs))), rhs))
-           where k = foldr Karrow Klifted (map snd tbs)
-
-envPlusNewtype :: Tcenv -> Qual Tcon -> Qual Tcon -> [Tbind] -> Ty
-  -> CheckResult Tcenv
-envPlusNewtype tcenv tyCon coVar tbs rep = extendM True NotTv tcenv
-                  (snd coVar, Coercion $ DefinedCoercion tbs
-                            (foldl Tapp (Tcon tyCon) 
-                                       (map Tvar (fst (unzip tbs))),
-                                       rep))
-    
-checkTdef :: Tcenv -> Cenv -> Tdef -> CheckResult Cenv
-checkTdef tcenv cenv = ch
-       where 
-        ch (Data (_,c) utbs cdefs) = 
-           do cbinds <- mapM checkCdef cdefs
-              foldM (extendM True NotTv) cenv cbinds
-           where checkCdef (cdef@(Constr (m,dcon) etbs ts)) =
-                   do mn <- getMname
-                       requireModulesEq m mn "constructor declaration" cdef 
-                         False 
-                      tvenv <- foldM (extendM True Tv) eempty tbs 
-                      ks <- mapM (checkTy (tcenv,tvenv)) ts
-                      mapM_ (\k -> require (baseKind k)
-                                           ("higher-order kind in:\n" ++ show cdef ++ "\n" ++
-                                            "kind: " ++ show k) ) ks
-                      return (dcon,t mn) 
-                   where tbs = utbs ++ etbs
-                         t mn = foldr Tforall 
-                                 (foldr tArrow
-                                         (foldl Tapp (Tcon (Just mn,c))
-                                                (map (Tvar . fst) utbs)) ts) tbs
-         ch (tdef@(Newtype tc _ tbs t)) =  
-           do tvenv <- foldM (extendM True Tv) eempty tbs
-              kRhs <- checkTy (tcenv,tvenv) t
-               require (kRhs `eqKind` Klifted) ("bad kind:\n" ++ show tdef)
-               kLhs <- checkTy (tcenv,tvenv) 
-                         (foldl Tapp (Tcon tc) (map Tvar (fst (unzip tbs))))
-               require (kLhs `eqKind` kRhs) 
-                  ("Kind mismatch in newtype axiom types: " ++ show tdef 
-                    ++ " kinds: " ++
-                   (show kLhs) ++ " and " ++ (show kRhs))
-              return cenv
-
-processCdef :: Cenv -> Tdef -> Cenv
-processCdef cenv = ch
-  where
-    ch (Data (_,c) utbs cdefs) = do 
-       let cbinds = map checkCdef cdefs
-       foldl eextend cenv cbinds
-     where checkCdef (Constr (mn,dcon) etbs ts) =
-             (dcon,t mn) 
-            where tbs = utbs ++ etbs
-                  t mn = foldr Tforall 
-                         (foldr tArrow
-                           (foldl Tapp (Tcon (mn,c))
-                               (map (Tvar . fst) utbs)) ts) tbs
-    ch _ = cenv
-
-mkTypeEnvs :: [Tdef] -> CheckResult (Tcenv, Cenv)
-mkTypeEnvs tdefs = do
-  tcenv <- foldM checkTdef0 eempty tdefs
-  cenv <- foldM (checkTdef tcenv) eempty tdefs
-  return (tcenv, cenv)
-
-mkTypeEnvsNoChecking :: [Tdef] -> (Tcenv, Cenv)
-mkTypeEnvsNoChecking tdefs = 
-  let tcenv = foldl processTdef0NoChecking eempty tdefs
-      cenv  = foldl processCdef eempty tdefs in
-    (tcenv, cenv)
-
-requireModulesEq :: Show a => Mname -> AnMname -> String -> a 
-                          -> Bool -> CheckResult ()
-requireModulesEq (Just mn) m msg t _      = require (mn == m) (mkErrMsg msg t)
-requireModulesEq Nothing _ msg t emptyOk  = require emptyOk (mkErrMsg msg t)
-
-mkErrMsg :: Show a => String -> a -> String
-mkErrMsg msg t = "wrong module name in " ++ msg ++ ":\n" ++ show t    
-
-checkVdefg :: Bool -> (Tcenv,Tvenv,Cenv) -> (Venv,Venv)
-               -> Vdefg -> CheckResult (Venv,Venv)
-checkVdefg top_level (tcenv,tvenv,cenv) (e_venv,l_venv) vdefg = do
-      mn <- getMname
-      case vdefg of
-       Rec vdefs ->
-           do (e_venv', l_venv') <- makeEnv mn vdefs
-               let env' = (tcenv,tvenv,cenv,e_venv',l_venv')
-               mapM_ (checkVdef (\ vdef k -> require (k `eqKind` Klifted) 
-                        ("unlifted kind in:\n" ++ show vdef)) env') 
-                     vdefs
-               return (e_venv', l_venv')
-       Nonrec vdef ->
-           do let env' = (tcenv, tvenv, cenv, e_venv, l_venv)
-               checkVdef (\ vdef k -> do
-                     require (not (k `eqKind` Kopen)) ("open kind in:\n" ++ show vdef)
-                    require ((not top_level) || (not (k `eqKind` Kunlifted))) 
-                       ("top-level unlifted kind in:\n" ++ show vdef)) env' vdef
-               makeEnv mn [vdef]
-
-  where makeEnv mn vdefs = do
-             ev <- foldM (extendVenv False) e_venv e_vts
-             lv <- foldM (extendVenv False) l_venv l_vts
-             return (ev, lv)
-           where e_vts = [ (v,t) | Vdef ((Just m,v),t,_) <- vdefs,
-                                     not (vdefIsMainWrapper mn (Just m))]
-                 l_vts = [ (v,t) | Vdef ((Nothing,v),t,_) <- vdefs]
-        checkVdef checkKind env (vdef@(Vdef ((m,_),t,e))) = do
-          mn <- getMname
-          let isZcMain = vdefIsMainWrapper mn m
-          unless isZcMain $
-             requireModulesEq m mn "value definition" vdef True
-         k <- checkTy (tcenv,tvenv) t
-         checkKind vdef k
-         t' <- checkExp env e
-         require (t == t')
-                  ("declared type doesn't match expression type in:\n"  
-                    ++ show vdef ++ "\n" ++  
-                   "declared type: " ++ show t ++ "\n" ++
-                   "expression type: " ++ show t')
-    
-vdefIsMainWrapper :: AnMname -> Mname -> Bool
-vdefIsMainWrapper enclosing defining = 
-   enclosing == mainMname && defining == wrapperMainAnMname
-
-checkExpr :: AnMname -> Menv -> Tcenv -> Cenv -> Venv -> Tvenv 
-               -> Exp -> Ty
-checkExpr mn menv _tcenv _cenv venv tvenv e = case runReaderT (do
-  --(tcenv, cenv) <- mkTypeEnvs tdefs
-  -- Since the preprocessor calls checkExpr after code has been
-  -- typechecked, we expect to find the external env in the Menv.
-  case (elookup menv mn) of
-     Just thisEnv ->
-       checkExp ({-tcenv-}tcenv_ thisEnv, tvenv, {-cenv-}cenv_ thisEnv, (venv_ thisEnv), venv) e
-     Nothing -> reportError e ("checkExpr: Environment for " ++ 
-                  show mn ++ " not found")) (mn,menv) of
-         OkC t -> t
-         FailC s -> reportError e s
-
-checkType :: AnMname -> Menv -> Tcenv -> Tvenv -> Ty -> Kind
-checkType mn menv _tcenv tvenv t = 
- case runReaderT (checkTy (tcenv_ (fromMaybe (error "checkType") (elookup menv mn)), tvenv) t) (mn, menv) of
-      OkC k -> k
-      FailC s -> reportError tvenv (s ++ "\n " ++ show menv ++ "\n mname =" ++ show mn)
-
-checkExp :: (Tcenv,Tvenv,Cenv,Venv,Venv) -> Exp -> CheckResult Ty
-checkExp (tcenv,tvenv,cenv,e_venv,l_venv) = ch
-      where 
-       ch e0 =
-         case e0 of
-           Var qv -> 
-             qlookupM venv_ e_venv l_venv qv
-           Dcon qc ->
-             qlookupM cenv_ cenv eempty qc
-           Lit l -> 
-             checkLit l
-           Appt e t -> 
-             do t' <- ch e
-                k' <- checkTy (tcenv,tvenv) t
-                case t' of
-                  Tforall (tv,k) t0 ->
-                    do require (k' `subKindOf` k) 
-                               ("kind doesn't match at type application in:\n" ++ show e0 ++ "\n" ++
-                                "operator kind: " ++ show k ++ "\n" ++
-                                "operand kind: " ++ show k') 
-                       return (substl [tv] [t] t0)
-                  _ -> fail ("bad operator type in type application:\n" ++ show e0 ++ "\n" ++
-                              "operator type: " ++ show t')
-           App e1 e2 -> 
-             do t1 <- ch e1
-                t2 <- ch e2
-                case t1 of
-                  Tapp(Tapp(Tcon tc) t') t0 | tc == tcArrow ->
-                       do require (t2 == t')
-                                   ("type doesn't match at application in:\n" ++ show e0 ++ "\n" ++ 
-                                    "operator type: " ++ show t' ++ "\n" ++ 
-                                    "operand type: " ++ show t2) 
-                          return t0
-                  _ -> fail ("bad operator type at application in:\n" ++ show e0 ++ "\n" ++
-                              "operator type: " ++ show t1)
-           Lam (Tb tb) e ->
-             do tvenv' <- extendTvenv tvenv tb 
-                t <- checkExp (tcenv,tvenv',cenv,e_venv,l_venv) e 
-                return (Tforall tb t)
-           Lam (Vb (vb@(_,vt))) e ->
-             do k <- checkTy (tcenv,tvenv) vt
-                require (baseKind k)   
-                        ("higher-order kind in:\n" ++ show e0 ++ "\n" ++
-                         "kind: " ++ show k) 
-                l_venv' <- extendVenv True l_venv vb
-                t <- checkExp (tcenv,tvenv,cenv,e_venv,l_venv') e
-                require (not (isUtupleTy vt)) ("lambda-bound unboxed tuple in:\n" ++ show e0) 
-                return (tArrow vt t)
-           Let vdefg e ->
-             do (e_venv',l_venv') <- checkVdefg False (tcenv,tvenv,cenv)
-                                        (e_venv,l_venv) vdefg
-                checkExp (tcenv,tvenv,cenv,e_venv',l_venv') e
-           Case e (v,t) resultTy alts ->
-             do t' <- ch e 
-                checkTy (tcenv,tvenv) t
-                require (t == t')
-                         ("scrutinee declared type doesn't match expression type in:\n" ++ show e0 ++ "\n" ++
-                          "declared type: " ++ show t ++ "\n" ++
-                          "expression type: " ++ show t') 
-                case (reverse alts) of
-                  (Acon c _ _ _):as ->
-                     let ok ((Acon c _ _ _):as) cs = do require (notElem c cs)
-                                                                ("duplicate alternative in case:\n" ++ show e0) 
-                                                        ok as (c:cs)
-                         ok ((Alit _ _):_)      _  = fail ("invalid alternative in constructor case:\n" ++ show e0)
-                         ok [Adefault _]        _  = return ()
-                         ok (Adefault _:_)      _  = fail ("misplaced default alternative in case:\n" ++ show e0)
-                         ok []                  _  = return () 
-                     in ok as [c] 
-                  (Alit l _):as -> 
-                     let ok ((Acon _ _ _ _):_) _  = fail ("invalid alternative in literal case:\n" ++ show e0)
-                         ok ((Alit l _):as)    ls = do require (notElem l ls)
-                                                               ("duplicate alternative in case:\n" ++ show e0) 
-                                                       ok as (l:ls)
-                         ok [Adefault _]       _  = return ()
-                         ok (Adefault _:_)     _  = fail ("misplaced default alternative in case:\n" ++ show e0)
-                         ok []                 _  = fail ("missing default alternative in literal case:\n" ++ show e0)
-                     in ok as [l] 
-                  [Adefault _] -> return ()
-                  _ -> fail ("no alternatives in case:\n" ++ show e0) 
-                l_venv' <- extendVenv True l_venv (v,t)
-                t:ts <- mapM (checkAlt (tcenv,tvenv,cenv,e_venv,l_venv') t) alts
-                require (all (== t) ts)
-                        ("alternative types don't match in:\n" ++ show e0 ++ "\n" ++
-                         "types: " ++ show (t:ts))
-                 checkTy (tcenv,tvenv) resultTy
-                 require (t == resultTy) ("case alternative type doesn't " ++
-                   " match case return type in:\n" ++ show e0 ++ "\n" ++
-                   "alt type: " ++ show t ++ " return type: " ++ show resultTy)
-                return t
-           c@(Cast e t) -> 
-             do eTy <- ch e 
-                (fromTy, toTy) <- checkTyCo (tcenv,tvenv) t
-                 require (eTy == fromTy) ("Type mismatch in cast: c = "
-                             ++ show c ++ "\nand eTy = " ++ show eTy
-                             ++ "\n and " ++ show fromTy)
-                 return toTy
-           Note _ e -> 
-             ch e
-           External _ t -> 
-             do checkTy (tcenv,eempty) t {- external types must be closed -}
-                return t
-    
-checkAlt :: (Tcenv,Tvenv,Cenv,Venv,Venv) -> Ty -> Alt -> CheckResult Ty
-checkAlt (env@(tcenv,tvenv,cenv,e_venv,l_venv)) t0 = ch
-      where 
-       ch a0 = 
-         case a0 of 
-           Acon qc etbs vbs e ->
-             do let uts = f t0                                      
-                      where f (Tapp t0 t) = f t0 ++ [t]
-                            f _ = []
-                ct <- qlookupM cenv_ cenv eempty qc
-                let (tbs,ct_args0,ct_res0) = splitTy ct
-                {- get universals -}
-                let (utbs,etbs') = splitAt (length uts) tbs
-                let utvs = map fst utbs
-                {- check existentials -}
-                let (etvs,eks) = unzip etbs
-                let (etvs',eks') = unzip etbs'
-                require (all (uncurry eqKind)
-                            (zip eks eks'))  
-                        ("existential kinds don't match in:\n" ++ show a0 ++ "\n" ++
-                         "kinds declared in data constructor: " ++ show eks ++
-                         "kinds declared in case alternative: " ++ show eks') 
-                tvenv' <- foldM extendTvenv tvenv etbs
-                {- check term variables -}
-                let vts = map snd vbs
-                mapM_ (\vt -> require ((not . isUtupleTy) vt)
-                                      ("pattern-bound unboxed tuple in:\n" ++ show a0 ++ "\n" ++
-                                       "pattern type: " ++ show vt)) vts
-                vks <- mapM (checkTy (tcenv,tvenv')) vts
-                mapM_ (\vk -> require (baseKind vk)
-                                      ("higher-order kind in:\n" ++ show a0 ++ "\n" ++
-                                       "kind: " ++ show vk)) vks 
-                let (ct_res:ct_args) = map (substl (utvs++etvs') (uts++(map Tvar etvs))) (ct_res0:ct_args0)
-                zipWithM_ 
-                   (\ct_arg vt -> 
-                       require (ct_arg == vt)
-                                ("pattern variable type doesn't match constructor argument type in:\n" ++ show a0 ++ "\n" ++
-                                 "pattern variable type: " ++ show ct_arg ++ "\n" ++
-                                 "constructor argument type: " ++ show vt)) ct_args vts
-                require (ct_res == t0)
-                         ("pattern constructor type doesn't match scrutinee type in:\n" ++ show a0 ++ "\n" ++
-                          "pattern constructor type: " ++ show ct_res ++ "\n" ++
-                          "scrutinee type: " ++ show t0) 
-                l_venv' <- foldM (extendVenv True) l_venv vbs
-                t <- checkExp (tcenv,tvenv',cenv,e_venv,l_venv') e
-                checkTy (tcenv,tvenv) t  {- check that existentials don't escape in result type -}
-                return t
-           Alit l e ->
-             do t <- checkLit l
-                require (t == t0)
-                        ("pattern type doesn't match scrutinee type in:\n" ++ show a0 ++ "\n" ++
-                         "pattern type: " ++ show t ++ "\n" ++
-                         "scrutinee type: " ++ show t0) 
-                checkExp env e
-           Adefault e ->
-             checkExp env e
-    
-checkTy :: (Tcenv,Tvenv) -> Ty -> CheckResult Kind
-checkTy es@(tcenv,tvenv) = ch
-     where
-       ch (Tvar tv) = do
-          res <- lookupM tvenv tv
-          case res of
-            Just k  -> return k
-            Nothing -> fail ("Undefined tvar: " ++ show tv)
-       ch (Tcon qtc) = do
-         kOrC <- qlookupM tcenv_ tcenv eempty qtc
-         case kOrC of
-            Kind k -> return k
-            Coercion (DefinedCoercion [] (t1,t2)) -> return $ Keq t1 t2
-            Coercion _ -> fail ("Unsaturated coercion app: " ++ show qtc)
-       ch (t@(Tapp t1 t2)) = 
-             case splitTyConApp_maybe t of
-               Just (tc, tys) -> do
-                 tcK <- qlookupM tcenv_ tcenv eempty tc 
-                 case tcK of
-                   Kind _ -> checkTapp t1 t2
-                   Coercion co@(DefinedCoercion tbs _) -> do
-                     -- makes sure coercion is fully applied
-                     require (length tys == length tbs) $
-                        ("Arity mismatch in coercion app: " ++ show t)
-                     let (_, tks) = unzip tbs
-                     argKs <- mapM (checkTy es) tys
-                     let kPairs = zip argKs tks
-                         -- Simon says it's okay for these to be
-                         -- subkinds
-                     let kindsOk = all (uncurry subKindOf) kPairs
-                     require kindsOk
-                        ("Kind mismatch in coercion app: " ++ show tks 
-                         ++ " and " ++ show argKs ++ " t = " ++ show t)
-                     return $ (uncurry Keq) (applyNewtype co tys)
-               Nothing -> checkTapp t1 t2
-            where checkTapp t1 t2 = do 
-                    k1 <- ch t1
-                   k2 <- ch t2
-                   case k1 of
-                     Karrow k11 k12 -> do
-                         require (k2 `subKindOf` k11) kindError
-                         return k12
-                            where kindError = 
-                                    "kinds don't match in type application: "
-                                    ++ show t ++ "\n" ++
-                                   "operator kind: " ++ show k11 ++ "\n" ++
-                                   "operand kind: " ++ show k2 
-                     _ -> fail ("applied type has non-arrow kind: " ++ show t)
-                           
-       ch (Tforall tb t) = 
-           do tvenv' <- extendTvenv tvenv tb 
-               checkTy (tcenv,tvenv') t
-       ch (TransCoercion t1 t2) = do
-            (ty1,ty2) <- checkTyCo es t1
-            (ty3,ty4) <- checkTyCo es t2
-            require (ty2 == ty3) ("Types don't match in trans. coercion: " ++
-                        show ty2 ++ " and " ++ show ty3)
-            return $ Keq ty1 ty4
-       ch (SymCoercion t1) = do
-            (ty1,ty2) <- checkTyCo es t1
-            return $ Keq ty2 ty1
-       ch (UnsafeCoercion t1 t2) = do
-            checkTy es t1
-            checkTy es t2
-            return $ Keq t1 t2
-       ch (LeftCoercion t1) = do
-            k <- checkTyCo es t1
-            case k of
-              ((Tapp u _), (Tapp w _)) -> return $ Keq u w
-              _ -> fail ("Bad coercion kind in operand of left: " ++ show k)
-       ch (RightCoercion t1) = do
-            k <- checkTyCo es t1
-            case k of
-              ((Tapp _ v), (Tapp _ x)) -> return $ Keq v x
-              _ -> fail ("Bad coercion kind in operand of left: " ++ show k)
-       ch (InstCoercion ty arg) = do
-            forallK <- checkTyCo es ty
-            case forallK of
-              ((Tforall (v1,k1) b1), (Tforall (v2,k2) b2)) -> do
-                 require (k1 `eqKind` k2) ("Kind mismatch in argument of inst: "
-                                            ++ show ty)
-                 argK <- checkTy es arg
-                 require (argK `eqKind` k1) ("Kind mismatch in type being "
-                           ++ "instantiated: " ++ show arg)
-                 let newLhs = substl [v1] [arg] b1
-                 let newRhs = substl [v2] [arg] b2
-                 return $ Keq newLhs newRhs
-              _ -> fail ("Non-forall-ty in argument to inst: " ++ show ty)
-
-checkTyCo :: (Tcenv, Tvenv) -> Ty -> CheckResult (Ty, Ty)
-checkTyCo es@(tcenv,_) t@(Tapp t1 t2) = 
-  (case splitTyConApp_maybe t of
-    Just (tc, tys) -> do
-       tcK <- qlookupM tcenv_ tcenv eempty tc
-       case tcK of
- -- todo: avoid duplicating this code
- -- blah, this almost calls for a different syntactic form
- -- (for a defined-coercion app): (TCoercionApp Tcon [Ty])
-         Coercion co@(DefinedCoercion tbs _) -> do
-           require (length tys == length tbs) $ 
-            ("Arity mismatch in coercion app: " ++ show t)
-           let (_, tks) = unzip tbs
-           argKs <- mapM (checkTy es) tys
-           let kPairs = zip argKs tks
-           let kindsOk = all (uncurry subKindOf) kPairs
-           require kindsOk
-              ("Kind mismatch in coercion app: " ++ show tks 
-                 ++ " and " ++ show argKs ++ " t = " ++ show t)
-           return (applyNewtype co tys)
-         _ -> checkTapp t1 t2
-    _ -> checkTapp t1 t2)
-       where checkTapp t1 t2 = do
-               (lhsRator, rhsRator) <- checkTyCo es t1
-               (lhs, rhs) <- checkTyCo es t2
-               -- Comp rule from paper
-               checkTy es (Tapp lhsRator lhs)
-               checkTy es (Tapp rhsRator rhs)
-               return (Tapp lhsRator lhs, Tapp rhsRator rhs)
-checkTyCo (tcenv, tvenv) (Tforall tb t) = do
-  tvenv' <- extendTvenv tvenv tb
-  (t1,t2) <- checkTyCo (tcenv, tvenv') t
-  return (Tforall tb t1, Tforall tb t2)
-checkTyCo es t = do
-  k <- checkTy es t
-  case k of
-    Keq t1 t2 -> return (t1, t2)
-    -- otherwise, expand by the "refl" rule
-    _          -> return (t, t)
-
-mlookupM :: (Eq a, Show a, Show b) => (Envs -> Env a b) -> Env a b -> Env a b -> Mname
-          -> CheckResult (Env a b)
-mlookupM _ _ local_env    Nothing            = -- (trace ("mlookupM_: returning " ++ show local_env)) $
-  return local_env
-mlookupM selector external_env local_env (Just m) = do
-  mn <- getMname
-  globalEnv <- getGlobalEnv
-  if m == mn
-     then -- trace ("global env would b e " ++ show (elookup globalEnv m)) $
-            return external_env
-     else
-       case elookup globalEnv m of
-         Just env' -> return (selector env')
-         Nothing -> fail ("Check: undefined module name: "
-                      ++ show m ++ show (edomain local_env))
-
-qlookupM :: (Ord a, Show a,Show b) => (Envs -> Env a b) -> Env a b -> Env a b
-                  -> Qual a -> CheckResult b
-qlookupM selector external_env local_env v@(m,k) =
-      do env <- -- trace ("qlookupM: " ++ show v) $
-                  mlookupM selector external_env local_env m
-         -- argh, hack for unqualified top-level names
-         maybeRes <- lookupM env k
-         case maybeRes of
-           Just r -> return r
-           Nothing -> do mn <- getMname
-                         currentMenv <- --  trace ("qlookupM: trying module for " ++ show mn) $
-                                         mlookupM selector external_env local_env (Just mn)
-                         maybeRes1 <- -- trace ("qlookupM: trying in " ++ show currentMenv) $
-                                        lookupM currentMenv k
-                         case maybeRes1 of
-                           Just r1 -> return r1
-                           Nothing -> do
-                             globalEnv <- getGlobalEnv
-                             case elookup globalEnv mn of
-                               Just e1 -> case elookup (selector e1) k of
-                                            Just r2 -> return r2
-                                            Nothing -> fail ("Undefined id " ++ show v)
-                               Nothing -> fail ("Undefined id " ++ show v) 
-
-checkLit :: Lit -> CheckResult Ty
-checkLit (Literal lit t) =
-  case lit of
-    Lint _ -> 
-         do require (t `elem` intLitTypes)
-                    ("invalid int literal: " ++ show lit ++ "\n" ++ "type: " ++ show t)
-            return t
-    Lrational _ ->
-         do require (t `elem` ratLitTypes)
-                    ("invalid rational literal: " ++ show lit ++ "\n" ++ "type: " ++ show t)
-            return t
-    Lchar _ -> 
-         do require (t `elem` charLitTypes)
-                    ("invalid char literal: " ++ show lit ++ "\n" ++ "type: " ++ show t)
-            return t   
-    Lstring _ ->
-         do require (t `elem` stringLitTypes)
-                    ("invalid string literal: " ++ show lit ++ "\n" ++ "type: " ++ show t)
-            return t
-
-{- Utilities -}
-
-{- Split off tbs, arguments and result of a (possibly abstracted)  arrow type -}
-splitTy :: Ty -> ([Tbind],[Ty],Ty)
-splitTy (Tforall tb t) = (tb:tbs,ts,tr) 
-               where (tbs,ts,tr) = splitTy t
-splitTy (Tapp(Tapp(Tcon tc) t0) t) | tc == tcArrow = (tbs,t0:ts,tr)
-               where (tbs,ts,tr) = splitTy t
-splitTy t = ([],[],t)
-
-
-primCoercionError :: Show a => a -> b
-primCoercionError s = error $ "Bad coercion application: " ++ show s
-
--- todo
-reportError :: Show a => a -> String -> b
-reportError e s = error $ ("Core type error: checkExpr failed with "
-                   ++ s ++ " and " ++ show e)
-
-type NtEnv  = M.Map Tcon CoercionKind
-
-mkNtEnv :: Menv -> NtEnv
-mkNtEnv menv = 
-  foldl M.union M.empty $
-        map (\ (_,e) ->
-                 foldr (\ (_,thing) rest ->
-                            case thing of
-                              Kind _ -> rest
-                              Coercion d@(DefinedCoercion _ (lhs,_)) -> 
-                                  case splitTyConApp_maybe lhs of
-                                    Just ((_,tc1),_) -> M.insert tc1 d rest
-                                    _ -> rest) M.empty (etolist (tcenv_ e))) (etolist menv)

diff --git a/utils/ext-core/Language/Core/Core.hs b/utils/ext-core/Language/Core/Core.hs
deleted file mode 100644 (file)
index f538ff2..0000000
--- a/utils/ext-core/Language/Core/Core.hs
+++ /dev/null
@@ -1,292 +0,0 @@
-{-# OPTIONS -fno-warn-missing-signatures #-}
-module Language.Core.Core where
-
-import Language.Core.Encoding
-
-import Data.Generics
-import Data.List (elemIndex)
-import Data.Char
-
-data Module 
- = Module AnMname [Tdef] [Vdefg]
-  deriving (Data, Typeable)
-
-data Tdef 
-  = Data (Qual Tcon) [Tbind] [Cdef]
-    -- type constructor; coercion name; type arguments; type rep
-    -- If we have: (Newtype tc co tbs (Just t))
-    -- there is an implicit axiom:
-    --  co tbs :: tc tbs :=: t
-  | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty
- deriving (Data, Typeable)
-
-data Cdef 
-  = Constr (Qual Dcon) [Tbind] [Ty]
-  deriving (Data, Typeable)
-
-data Vdefg 
-  = Rec [Vdef]
-  | Nonrec Vdef
-  deriving (Data, Typeable)
-
-newtype Vdef = Vdef (Qual Var,Ty,Exp)
-  deriving (Data, Typeable)
-
-data Exp 
-  = Var (Qual Var)
-  | Dcon (Qual Dcon)
-  | Lit Lit
-  | App Exp Exp
-  | Appt Exp Ty
-  | Lam Bind Exp         
-  | Let Vdefg Exp
-  | Case Exp Vbind Ty [Alt] {- non-empty list -}
-  | Cast Exp Ty
-  | Note String Exp
-  | External String Ty
-  deriving (Data, Typeable)
-
-data Bind 
-  = Vb Vbind
-  | Tb Tbind
-  deriving (Data, Typeable)
-
-data Alt 
-  = Acon (Qual Dcon) [Tbind] [Vbind] Exp
-  | Alit Lit Exp
-  | Adefault Exp
-  deriving (Data, Typeable)
-
-type Vbind = (Var,Ty)
-type Tbind = (Tvar,Kind)
-
-data Ty 
-  = Tvar Tvar
-  | Tcon (Qual Tcon)
-  | Tapp Ty Ty
-  | Tforall Tbind Ty 
--- Wired-in coercions:
--- These are primitive tycons in GHC, but in ext-core,
--- we make them explicit, to make the typechecker
--- somewhat more clear. 
-  | TransCoercion Ty Ty
-  | SymCoercion Ty
-  | UnsafeCoercion Ty Ty
-  | InstCoercion Ty Ty
-  | LeftCoercion Ty
-  | RightCoercion Ty
-  deriving (Data, Typeable)
-
-data Kind 
-  = Klifted
-  | Kunlifted
-  | Kopen
-  | Karrow Kind Kind
-  | Keq Ty Ty
-  deriving (Data, Typeable)
-
--- A CoercionKind isn't really a Kind at all, but rather,
--- corresponds to an arbitrary user-declared axiom.
--- A tycon whose CoercionKind is (DefinedCoercion <tbs> (from, to))
--- represents a tycon with arity (length tbs), whose kind is
--- (from :=: to) (modulo substituting type arguments.
--- It's not a Kind because a coercion must always be fully applied:
--- whenever we see a tycon that has such a CoercionKind, it must
--- be fully applied if it's to be assigned an actual Kind.
--- So, a CoercionKind *only* appears in the environment (mapping
--- newtype axioms onto CoercionKinds).
--- Was that clear??
-data CoercionKind = 
-   DefinedCoercion [Tbind] (Ty,Ty)
-
--- The type constructor environment maps names that are
--- either type constructors or coercion names onto either
--- kinds or coercion kinds.
-data KindOrCoercion = Kind Kind | Coercion CoercionKind
-
-data Lit = Literal CoreLit Ty
-  deriving (Data, Typeable, Eq)
-
-data CoreLit = Lint Integer
-  | Lrational Rational
-  | Lchar Char
-  | Lstring String 
-  deriving (Data, Typeable, Eq)
-
--- Right now we represent module names as triples:
--- (package name, hierarchical names, leaf name)
--- An alternative to this would be to flatten the
--- module namespace, either when printing out
--- Core or (probably preferably) in a 
--- preprocessor.
--- We represent the empty module name (as in an unqualified name)
--- with Nothing.
-
-type Mname = Maybe AnMname
-newtype AnMname = M (Pname, [Id], Id)
-  deriving (Eq, Ord, Data, Typeable)
-newtype Pname = P Id
-  deriving (Eq, Ord, Data, Typeable)
-type Var = Id
-type Tvar = Id
-type Tcon = Id
-type Dcon = Id
-
-type Qual t = (Mname,t)
-
-qual :: AnMname -> t -> Qual t
-qual mn t = (Just mn, t)
-
-unqual :: t -> Qual t
-unqual = (,) Nothing
-
-getModule :: Qual t -> Mname
-getModule = fst
-
-type Id = String
-
-eqKind :: Kind -> Kind -> Bool
-eqKind Klifted Klifted = True
-eqKind Kunlifted Kunlifted = True
-eqKind Kopen Kopen = True
-eqKind (Karrow k1 k2) (Karrow l1 l2) = k1 `eqKind` l1
-                                   &&  k2 `eqKind` l2
-eqKind (Keq t1 t2) (Keq u1 u2) = t1 == u1
-                              && t2 == u2
-eqKind _ _ = False
-
-splitTyConApp_maybe :: Ty -> Maybe (Qual Tcon,[Ty])
-splitTyConApp_maybe (Tvar _) = Nothing
-splitTyConApp_maybe (Tcon t) = Just (t,[])
-splitTyConApp_maybe (Tapp rator rand) = 
-   case (splitTyConApp_maybe rator) of
-      Just (r,rs) -> Just (r,rs++[rand])
-      Nothing     -> case rator of
-                       Tcon tc -> Just (tc,[rand])
-                       _       -> Nothing
-splitTyConApp_maybe (Tforall _ _) = Nothing
--- coercions
-splitTyConApp_maybe _ = Nothing
-
--- This used to be called nearlyEqualTy, but now that
--- we don't need to expand newtypes anymore, it seems
--- like equality to me!
-equalTy :: Ty -> Ty -> Bool
-equalTy t1 t2 =  eqTy [] [] t1 t2 
-  where eqTy e1 e2 (Tvar v1) (Tvar v2) =
-            case (elemIndex v1 e1,elemIndex v2 e2) of
-               (Just i1, Just i2) -> i1 == i2
-               (Nothing, Nothing)  -> v1 == v2
-               _ -> False
-       eqTy _ _ (Tcon c1) (Tcon c2) = c1 == c2
-        eqTy e1 e2 (Tapp t1a t1b) (Tapp t2a t2b) =
-             eqTy e1 e2 t1a t2a && eqTy e1 e2 t1b t2b
-        eqTy e1 e2 (Tforall (tv1,tk1) b1) (Tforall (tv2,tk2) b2) =
-             tk1 `eqKind` tk2 && eqTy (tv1:e1) (tv2:e2) b1 b2 
-       eqTy _ _ _ _ = False
-instance Eq Ty where (==) = equalTy
-
-
-subKindOf :: Kind -> Kind -> Bool
-_ `subKindOf` Kopen = True
-(Karrow a1 r1) `subKindOf` (Karrow a2 r2) = 
-  a2 `subKindOf` a1 && (r1 `subKindOf` r2)
-k1 `subKindOf` k2 = k1 `eqKind` k2  -- doesn't worry about higher kinds
-
-baseKind :: Kind -> Bool
-baseKind (Karrow _ _ ) = False
-baseKind _ = True
-
-isPrimVar (Just mn,_) = mn == primMname
-isPrimVar _ = False
-
-primMname = mkPrimMname "Prim"
-errMname  = mkBaseMname "Err"
-mkBaseMname,mkPrimMname :: Id -> AnMname
-mkBaseMname mn = M (basePkg, ghcPrefix, mn)
-mkPrimMname mn = M (primPkg, ghcPrefix, mn)
-basePkg = P "base"
-mainPkg = P "main"
-primPkg = P $ zEncodeString "ghc-prim"
-ghcPrefix = ["GHC"]
-mainPrefix = []
-baseMname = error "Somebody called baseMname!" -- mkBaseMname "Base"
-boolMname = mkPrimMname "Bool"
-mainVar = qual mainMname "main"
-wrapperMainVar = qual wrapperMainMname "main"
-mainMname = M (mainPkg, mainPrefix, "Main")
-wrapperMainMname = M (mainPkg, mainPrefix, "ZCMain")
-wrapperMainAnMname = Just wrapperMainMname
-
-dcTrue :: Dcon
-dcTrue = "True"
-dcFalse :: Dcon
-dcFalse = "False"
-
-tcArrow :: Qual Tcon
-tcArrow = (Just primMname, "ZLzmzgZR")
-
-tArrow :: Ty -> Ty -> Ty
-tArrow t1 t2 = Tapp (Tapp (Tcon tcArrow) t1) t2
-
-mkFunTy :: Ty -> Ty -> Ty
-mkFunTy randTy resultTy =
-  Tapp (Tapp (Tcon tcArrow) randTy) resultTy
-
-ktArrow :: Kind
-ktArrow = Karrow Kopen (Karrow Kopen Klifted)
-
-{- Unboxed tuples -}
-
-maxUtuple :: Int
-maxUtuple = 100
-
-tcUtuple :: Int -> Qual Tcon
-tcUtuple n = (Just primMname,"Z"++ (show n) ++ "H")
-
-ktUtuple :: Int -> Kind
-ktUtuple n = foldr Karrow Kunlifted (replicate n Kopen)
-
-tUtuple :: [Ty] -> Ty
-tUtuple ts = foldl Tapp (Tcon (tcUtuple (length ts))) ts 
-
-isUtupleTy :: Ty -> Bool
-isUtupleTy (Tapp t _) = isUtupleTy t
-isUtupleTy (Tcon tc) = 
-  case tc of
-    (Just pm, 'Z':rest) | pm == primMname && last rest == 'H' -> 
-       let mid = take ((length rest) - 1) rest in
-         all isDigit mid && (let num = read mid in
-                               1 <= num && num <= maxUtuple)
-    _ -> False
--- The above is ugly, but less ugly than this:
---tc `elem` [tcUtuple n | n <- [1..maxUtuple]]
-isUtupleTy _ = False
-
-dcUtuple :: Int -> Qual Dcon
--- TODO: Seems like Z2H etc. appears in ext-core files,
--- not $wZ2H etc. Is this right?
-dcUtuple n = (Just primMname,"Z" ++ (show n) ++ "H")
-
-isUtupleDc :: Qual Dcon -> Bool
-isUtupleDc dc = dc `elem` [dcUtuple n | n <- [1..maxUtuple]]
-
-dcUtupleTy :: Int -> Ty
-dcUtupleTy n = 
-     foldr ( \tv t -> Tforall (tv,Kopen) t)
-           (foldr ( \tv t -> tArrow (Tvar tv) t)
-                 (tUtuple (map Tvar tvs)) tvs) 
-           tvs
-     where tvs = map ( \i -> ("a" ++ (show i))) [1..n] 
-
-utuple :: [Ty] -> [Exp] -> Exp
-utuple ts es = foldl App (foldl Appt (Dcon (dcUtuple (length es))) ts) es
-
----- snarfed from GHC's CoreSyn
-flattenBinds :: [Vdefg] -> [Vdef]      -- Get all the lhs/rhs pairs
-flattenBinds (Nonrec vd : binds) = vd : flattenBinds binds
-flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
-flattenBinds []                          = []
-
-unitMname :: AnMname
-unitMname = mkPrimMname "Unit"

diff --git a/utils/ext-core/Language/Core/CoreUtils.hs b/utils/ext-core/Language/Core/CoreUtils.hs
deleted file mode 100644 (file)
index 52d51f2..0000000
--- a/utils/ext-core/Language/Core/CoreUtils.hs
+++ /dev/null
@@ -1,212 +0,0 @@
-module Language.Core.CoreUtils where
-
-import Language.Core.Core
-import Language.Core.Utils
-import Language.Core.Printer()
-
---import Debug.Trace
-
-import Data.Generics
-import Data.List
-import Data.Maybe
-
-splitDataConApp_maybe :: Exp -> Maybe (Qual Dcon, [Ty], [Exp])
-splitDataConApp_maybe (Dcon d) = Just (d, [], [])
-splitDataConApp_maybe (Appt rator t) = 
-   case splitDataConApp_maybe rator of
-     Just (r, ts, rs) -> Just (r, ts ++ [t], rs)
-     Nothing          -> Nothing
-splitDataConApp_maybe (App rator rand) =
-  case splitDataConApp_maybe rator of
-    Just (r, ts, rs) -> Just (r, ts, rs++[rand])
-    Nothing -> Nothing
-splitDataConApp_maybe _ = Nothing
-
-splitApp :: Exp -> (Exp, [Exp])
-splitApp (Appt rator _) = splitApp rator
-splitApp (App rator rand) =
-  case splitApp rator of
-    (r, rs) -> (r, rs++[rand])
-splitApp e = (e, [])
-
-splitAppIgnoreCasts :: Exp -> (Exp, [Exp])
-splitAppIgnoreCasts (Appt rator _) = splitApp rator
-splitAppIgnoreCasts (App (Cast rator _) rand) = splitApp (App rator rand)
-splitAppIgnoreCasts (App rator rand) =
-  case splitApp rator of
-    (r, rs) -> (r, rs++[rand])
-splitAppIgnoreCasts e = (e, [])
-
-splitFunTy_maybe :: Ty -> Maybe ([Ty], Ty)
-splitFunTy_maybe (Tforall _ t) = splitFunTy_maybe t
-splitFunTy_maybe t = 
-  case splitFunTy2_maybe t of
-    Just (rator, rand) -> case splitFunTy_maybe rand of
-                            Just (r,s) -> Just (rator:r, s)
-                            Nothing -> Just ([rator], rand)
-    Nothing -> Nothing
-
-splitFunTy2_maybe :: Ty -> Maybe (Ty,Ty)
-splitFunTy2_maybe (Tapp (Tapp (Tcon c) t) u) | c == tcArrow = Just (t, u)
-splitFunTy2_maybe _ = Nothing
-
-vdefNamesQ :: [Vdef] -> [Qual Var]
-vdefNamesQ = map (\ (Vdef (v,_,_)) -> v)
-
-vdefNames :: [Vdef] -> [Var]
-vdefNames = snd . unzip . vdefNamesQ
-
-vdefTys :: [Vdef] -> [Ty]
-vdefTys = map (\ (Vdef (_,t,_)) -> t)
-
-vdefgNames :: Vdefg -> [Var]
-vdefgNames = snd . unzip . vdefgNamesQ
-
-vdefgNamesQ :: Vdefg -> [Qual Var]
-vdefgNamesQ (Rec vds) = map (\ (Vdef (v,_,_)) -> v) vds
-vdefgNamesQ (Nonrec (Vdef (v,_,_))) = [v]
-
-vdefgTys :: Vdefg -> [Ty]
-vdefgTys (Rec vds) = map (\ (Vdef (_,t,_)) -> t) vds
-vdefgTys (Nonrec (Vdef (_,t,_))) = [t]
-vdefgBodies :: Vdefg -> [Exp]
-vdefgBodies (Rec vds) = map (\ (Vdef (_,_,e)) -> e) vds
-vdefgBodies (Nonrec (Vdef (_,_,e))) = [e]
-
-vbNames :: [Vbind] -> [Var]
-vbNames = fst . unzip
-
--- assumes v is not bound in e
-substIn :: Data a => Var -> Var -> a -> a
-substIn v newV = everywhereExcept (mkT frob)
-  where frob (Var (Nothing,v1)) | v == v1   = Var (Nothing,newV)
-        frob e                              = e
-
-substVars :: Data a => [Var] -> [Var] -> a -> a
-substVars oldVars newVars e = foldl' (\ e1 (old,new) -> substIn old new e1) 
-  e (zip oldVars newVars)
-
-
-tdefNames :: [Tdef] -> [Qual Var]
-tdefNames = concatMap doOne
-  where doOne (Data qtc _ cds) = qtc:(concatMap doCdef cds)
-        doOne (Newtype qtc qtc1 _ _) = [qtc, qtc1]
-        doCdef (Constr qdc _ _) = [qdc]
-
-tdefDcons :: [Tdef] -> [Qual Var]
-tdefDcons = concatMap doOne
-  where doOne (Data _ _ cds) = concatMap doCdef cds
-        doOne _ = []
-        doCdef (Constr qdc _ _) = [qdc]
-
-tdefTcons :: [Tdef] -> [Qual Var]
-tdefTcons = concatMap doOne
-  where doOne (Data qtc _ _) = [qtc]
-        doOne (Newtype qtc qtc1 _ _) = [qtc, qtc1]
-
-filterVdefgs :: (Vdef -> Bool) -> [Vdefg] -> [Vdefg]
-filterVdefgs ok = catMaybes . (map dropNames)
-  where dropNames (Nonrec v) | not (ok v) = Nothing
-        dropNames v@(Nonrec _) = Just v
-        dropNames (Rec bs) = case filter ok bs of
-           [] -> Nothing
-           newBs -> Just (Rec newBs)
-
-applyNewtype :: CoercionKind -> [Ty] -> (Ty,Ty)
-applyNewtype _d@(DefinedCoercion tbs (from,to)) tys = 
-  let (tvs,_) = unzip tbs in
-    let res = (substl tvs tys from,substl tvs tys to) in
-      -- trace ("co = " ++ show d ++ " args  = " ++ show tys ++ " res = " ++ show res) $
-        res
-
-{- Simultaneous substitution on types for type variables,
-   renaming as neceessary to avoid capture.
-   No checks for correct kindedness. -}
-substl :: [Tvar] -> [Ty] -> Ty -> Ty
-substl tvs ts t = f (zip tvs ts) t
-  where 
-    f env t0 =
-     case t0 of
-       Tcon _ -> t0
-       Tvar v -> case lookup v env of
-                   Just t1 -> t1
-                   Nothing -> t0
-       Tapp t1 t2 -> Tapp (f env t1) (f env t2)
-       Tforall (tv,k) t1 -> 
-         if tv `elem` free then
-           Tforall (t',k) (f ((tv,Tvar t'):env) t1)
-         else 
-          Tforall (tv,k) (f (filter ((/=tv).fst) env) t1)
-       TransCoercion t1 t2 -> TransCoercion (f env t1) (f env t2)
-       SymCoercion t1 -> SymCoercion (f env t1)
-       UnsafeCoercion t1 t2 -> UnsafeCoercion (f env t1) (f env t2)
-       LeftCoercion t1 -> LeftCoercion (f env t1)
-       RightCoercion t1 -> RightCoercion (f env t1)
-       InstCoercion t1 t2 -> InstCoercion (f env t1) (f env t2)
-     where free = foldr union [] (map (freeTvars.snd) env)
-           t' = freshTvar free 
-
-   
-{- Return free tvars in a type -}
-freeTvars :: Ty -> [Tvar]
-freeTvars (Tcon _) = []
-freeTvars (Tvar v) = [v]
-freeTvars (Tapp t1 t2) = freeTvars t1 `union` freeTvars t2
-freeTvars (Tforall (t,_) t1) = delete t (freeTvars t1) 
-freeTvars (TransCoercion t1 t2) = freeTvars t1 `union` freeTvars t2
-freeTvars (SymCoercion t) = freeTvars t
-freeTvars (UnsafeCoercion t1 t2) = freeTvars t1 `union` freeTvars t2
-freeTvars (LeftCoercion t) = freeTvars t
-freeTvars (RightCoercion t) = freeTvars t
-freeTvars (InstCoercion t1 t2) = freeTvars t1 `union` freeTvars t2
-
-{- Return any tvar *not* in the argument list. -}
-freshTvar :: [Tvar] -> Tvar
-freshTvar tvs = maximum ("":tvs) ++ "x" -- one simple way!
-
-splitLambda :: Exp -> ([Bind],Exp)
-splitLambda (Lam vb e) = case splitLambda e of
-  (vbs,rhs) -> (vb:vbs,rhs)
-splitLambda (Note _ e) = splitLambda e
-splitLambda e          = ([],e)
-
-vbinds :: [Bind] -> [(Var,Ty)]
-vbinds = foldl' stuff []
-  where stuff :: [(Var,Ty)] -> Bind -> [(Var,Ty)]
-        stuff rest (Tb _) = rest
-        stuff rest (Vb p) = p:rest
-
-splitBinds :: [Bind] -> ([(Tvar,Kind)],[(Var,Ty)])
-splitBinds = foldr stuff ([],[])
-  where stuff (Tb t) (tbs,vbs) = (t:tbs,vbs)
-        stuff (Vb v) (tbs,vbs) = (tbs,v:vbs)
-
-freeVars :: Exp -> [Qual Var]
-freeVars (Var v)                    = [v]
-freeVars (Dcon _)                   = []
-freeVars (Lit _)                    = []
-freeVars (App f g)                  = freeVars f `union` freeVars g
-freeVars (Appt e _)                 = freeVars e
-freeVars (Lam (Tb _) e)             = freeVars e
-freeVars (Lam (Vb (v,_)) e)         = delete (unqual v) (freeVars e)
-freeVars (Let (Nonrec (Vdef (v,_,rhs))) e) = freeVars rhs `union` (delete v (freeVars e))
-freeVars (Let r@(Rec _) e)         = (freeVars e \\ boundVars) `union` (freeVarss rhss \\ boundVars)
-  where boundVars = map unqual $ vdefgNames r
-        rhss      = vdefgBodies r
-freeVars (Case e (v,_) _ alts)      = freeVars e `union` (delete v1 (boundVarsAlts alts))
-  where v1 = unqual v
-        boundVarsAlts as = freeVarss rhss \\ (v1:caseVars)
-          where rhss = map (\ a -> case a of
-                             Acon _ _ _ r -> r
-                             Alit _ r     -> r
-                             Adefault r   -> r) as
-                caseVars = foldl' union [] (map (\ a -> case a of
-                                               Acon _ _ vbs _ ->
-                                                 (map unqual (fst (unzip vbs)))
-                                               _              -> []) as)
-freeVars (Cast e _)                 = freeVars e
-freeVars (Note _ e)                 = freeVars e
-freeVars (External {})              = []
-
-freeVarss :: [Exp] -> [Qual Var]
-freeVarss = foldl' union [] . map freeVars
\ No newline at end of file

diff --git a/utils/ext-core/Language/Core/Dependencies.hs b/utils/ext-core/Language/Core/Dependencies.hs
deleted file mode 100644 (file)
index a90650a..0000000
--- a/utils/ext-core/Language/Core/Dependencies.hs
+++ /dev/null
@@ -1,166 +0,0 @@
-module Language.Core.Dependencies(getDependencies) where
-
-import Language.Core.Core
-import Language.Core.Encoding
-import Language.Core.ParsecParser
-
-import Control.Monad.State
-import Data.Generics
-import Data.List
-import qualified Data.Map as M
-import Data.Maybe
-import System.Directory
-import System.FilePath
-import System.IO
-
-type DepM a = StateT (FilePath, -- "main" module file path
-                 -- maps module names onto dependencies
-                 M.Map (Either AnMname FilePath) [AnMname],
-                 -- module cache
-                 M.Map (Either AnMname FilePath) (FilePath, Module)) IO a
-
--- Given a module, return all the modules it
--- depends on (directly or indirectly).
-getDependencies :: [FilePath] -> IO [(FilePath, Module)]
-getDependencies ms =
-  evalStateT (do
-    (mapM_ (\ f -> do
-              liftIO $ putStrLn $ "==== Finding deps for " ++ show f ++ "====="
-              -- Every module depends on itself anyway,
-              -- so we ignore the FilePath deps.
-              ds <- go getDeps lefts (map Left) (map Right ms)
-              return (f, ds)) ms)
-    (_,t,c) <- get
-    let modNames = nub $ concat (snd (unzip (leftsPairs (M.toList t))))
-                       
-    res1 <- (liftM catMaybes) $ mapM findModuleP (map Left modNames)
-    return $ res1 `unionByFirst`
-               (snd (unzip (M.toList c))))
-   (last ms, M.empty, M.empty)
-      where unionByFirst = unionBy (\ (f,_) (g,_) -> f == g)
-
-go :: (Show a, Show b, Eq b, MonadIO m) =>
-  (a -> m [b]) -> ([a] -> [b]) -> ([b] -> [a]) -> [a] -> m [b]
-go getMore p fixUp start = do
-  next <- concatMapM getMore start
-  let more = nub $ (p start) ++ next
-  if (length start == length more)
-    then return more
-    else go getMore p fixUp (fixUp more)
-
-varRef :: Exp -> [AnMname]
-varRef (Var v) | Just m' <- getModule v = [m']
-varRef (Dcon dc) | Just m' <- getModule dc = [m']
-varRef _ = []
-
-tyRef :: Ty -> [AnMname]
-tyRef (Tcon tc) | Just m' <- getModule tc = [m']
-tyRef  _ = []
-
-
-getDeps :: Either AnMname FilePath -> DepM [AnMname]
-getDeps mn = do
-          (_,t,_) <- get
-          case M.lookup mn t of
-            Just ds -> return ds
-            Nothing -> do
-              maybeM <- findModule mn
-              case maybeM of
-                Nothing -> return []
-                Just m@(Module mname _ _) -> do
-                  let ds = (everything union ([] `mkQ` varRef) m)
-                            `union` (everything union ([] `mkQ` tyRef) m) in do
-                  liftIO $ putStrLn (show mn ++ " : " ++ show ds)
-                  (a1,t1,b1) <- get
-                  -- in case we were given a filepath, register the
-                  -- module name too
-                  put (a1, M.insert mn ds (M.insert (Left mname) ds t1), b1)
-                  return ds
-
-findModule :: Either AnMname FilePath -> DepM (Maybe Module)
-findModule x = do
- maybeRes <- findModuleP x
- case maybeRes of
-   Just (_,m) -> return $ Just m
-   _          -> return Nothing
-
-findModuleP :: Either AnMname FilePath -> DepM (Maybe (FilePath, Module))
-findModuleP (Left mn) | mn == wrapperMainMname || mn == mainMname = do
-  (f,_,_) <- get
-  findModuleP (Right f)
-findModuleP (Left mn) | mn == primMname = return Nothing
-  -- Nothing means that this module is valid; it just doesn't have
-  -- an implementation
-findModuleP m = tryFindModule m
-
-tryFindModule :: Either AnMname FilePath -> DepM (Maybe (FilePath, Module))
-tryFindModule k = do
-  (_,_,mCache) <- get
-  liftM Just $ case M.lookup k mCache of
-    Just p -> return p
-    Nothing -> findModuleNotCached k
-
-findModuleNotCached :: Either AnMname FilePath -> DepM (FilePath, Module)
-findModuleNotCached (Left m@(M (P pkgName, encHier, encLeafName))) = do
-      let hier = map zDecodeString encHier
-          leafName = zDecodeString encLeafName
-          possibleFiles = (map (dirs hier leafName) searchPath)
-                     ++ map (dirs (zDecodeString pkgName:hier) leafName) searchPath in do
-      match <- liftIO $ findM doesFileExist possibleFiles
-      case match of
-         Just fp -> findModule' fp
-         Nothing -> error ("findModule: failed to find dependency " ++ show m
-                      ++ " tried " ++ show possibleFiles)
-findModuleNotCached (Right fp) = findModule' fp
-
-dirs :: [String] -> String -> FilePath -> FilePath
-dirs modulePath leafName dir = dir </> 
-                 (foldr (</>) (addExtension leafName "hcr") modulePath)
-
-findModule' :: FilePath -> DepM (FilePath, Module)
-findModule' fp = do
-          res <- liftIO $ parseCore fp
-          case res of
-            Left _   -> error ("findModule: error parsing dependency " ++ fp)
-            Right parsedMod@(Module mn _ _) -> do
-                cacheModule mn fp parsedMod
-                return (fp, parsedMod)
-
-cacheModule :: AnMname -> FilePath -> Module -> DepM ()
-cacheModule mn fp m = modify (\ (a, b, cache) ->
-                           (a, b, M.insert (Left mn) (fp, m)
-                                    (M.insert (Right fp) (fp, m)
-                                    cache)))
-
-searchPath :: [FilePath]
-searchPath = overriddenDir:["../../libraries/",
-             -- kludgy: we wouldn't need these if we parsed the
-             -- package.conf file, but for now, we are too lazy
-              "../../libraries/integer-gmp/",
-              "../../libraries/array/"]
-
-overriddenDir :: FilePath
-overriddenDir = "./lib/"
-
-findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
-findM p = liftM listToMaybe . filterM p
-
-concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
-concatMapM f = (liftM concat) . (mapM f)
-
-lefts :: [Either a b] -> [a]
-lefts = foldr lefts' []
-  where lefts' (Left a) xs = a:xs
-        lefts' _        xs = xs
-
-leftsPairs :: [(Either a b, c)] -> [(a, c)]
-leftsPairs = foldr leftsPairs' []
-  where leftsPairs' ((Left x), y) xs = (x, y):xs
-        leftsPairs' _             xs = xs
-
-{-
-rightsPairs :: [(Either a b, c)] -> [(b, c)]
-rightsPairs = foldr rightsPairs' []
-  where rightsPairs' ((Right x), y) xs = (x, y):xs
-        rightsPairs' _             xs = xs
--}
\ No newline at end of file

diff --git a/utils/ext-core/Language/Core/Driver.hs b/utils/ext-core/Language/Core/Driver.hs
deleted file mode 100644 (file)
index 4a71691..0000000
--- a/utils/ext-core/Language/Core/Driver.hs
+++ /dev/null
@@ -1,147 +0,0 @@
-{-# OPTIONS -Wall #-}
-
-{- A simple driver that loads, typechecks, prepares, re-typechecks, and interprets the 
-    GHC standard Prelude modules and an application module called Main. 
-
-   Note that, if compiled under GHC, this requires a very large heap to run!
--}
-
-import Control.Exception
-import Data.List
-import Data.Maybe
-import Monad
-import Prelude hiding (catch)
-import System.Cmd
-import System.Console.GetOpt
-import System.Environment
-import System.Exit
-import System.FilePath
-
-import Language.Core.Core
-import Language.Core.Dependencies
-import Language.Core.Overrides
-import Language.Core.Prims
-import Language.Core.Check
-import Language.Core.Prep
-import Language.Core.Interp
-import Language.Core.ParsecParser
-
--- You may need to change this.
-baseDir :: FilePath
-baseDir = "../../libraries/"
--- change to True to typecheck library files as well as reading type signatures
-typecheckLibs :: Bool
-typecheckLibs = False
-
--- You shouldn't *need* to change anything below this line...                  
-
--- Code to check that the external and GHC printers print the same results
-validateResults :: FilePath -> Module -> IO ()
-validateResults origFile m = do
-  let genFile = origFile </> "parsed"
-  writeFile genFile (show m) 
-  resultCode <- system $ "diff -u " ++ origFile ++ " " ++ genFile
-  putStrLn $ case resultCode of
-    ExitSuccess   -> "Parse validated for " ++ origFile
-    ExitFailure 1 -> "Parse failed to validate for " ++ origFile
-    _             -> "Error diffing files: " ++ origFile ++ " " ++ genFile
-------------------------------------------------------------------------------
-
-data Flag = Test | NoDeps
-  deriving Eq
-
-options :: [OptDescr Flag]
-options =
-  [Option ['t'] ["test"] (NoArg Test) "validate prettyprinted code",
-   Option ['n'] ["no-deps"] (NoArg NoDeps) "don't compute dependencies automatically"
-  ]
-
-process :: Bool -> (Check.Menv,[Module]) -> (FilePath, Module)
-             -> IO (Check.Menv,[Module])
-process _ (senv,modules) p@(f,m) | isLib p && not typecheckLibs = do
-  -- if it's a library and we set typecheckLibs to False:
-  -- prep, but don't typecheck
-  m' <- prepM senv m f
-  return (senv, modules ++ [m'])
-    where isLib (fp,_) = baseDir `isPrefixOf` fp
-process doTest (senv,modules) (f, m@(Module mn _ _)) = catch (do
-        when doTest $ validateResults f m
-       (case checkModule senv m of
-           OkC senv' ->
-            do putStrLn $ "Check succeeded for " ++ show mn
-                m' <- prepM senv' m f
-               case checkModule senv' m' of
-                  OkC senv'' ->
-                     do putStrLn "Recheck succeeded"
-                         return (senv'',modules ++ [m'])
-                 FailC s -> 
-                     do putStrLn ("Recheck failed: " ++ s)
-                        error "quit"
-          FailC s -> error ("Typechecking failed: " ++ s))) handler
-   where handler e = do
-           putStrLn ("WARNING: we caught an exception " ++ show e 
-                     ++ " while processing " ++ f)
-           return (senv, modules)
-
-prepM :: Check.Menv -> Module -> FilePath -> IO Module
-prepM senv' m _f = do
-  let m' = prepModule senv' m
-  --writeFile (f </> ".prepped") (show m')
-  return m'
-
-main :: IO ()
-main = do
-  args <- getArgs
-  case getOpt Permute options args of
-    (opts, fnames@(_:_), _) ->
-       let doTest      = Test `elem` opts
-           computeDeps = NoDeps `notElem` opts in
-         doOneProgram computeDeps doTest fnames
-    _ -> error "usage: ./Driver [filename]"
-  where  doOneProgram :: Bool -> Bool -> [FilePath] -> IO ()
-         doOneProgram computeDeps doTest fns = do
-               putStrLn $ "========== Program " ++ (show fns) ++ " ============="
-               deps <- if computeDeps 
-                         then
-                           getDependencies fns
-                         else (liftM catMaybes) (mapM findModuleDirect fns)
-               putStrLn $ "deps = " ++ show (fst (unzip deps))
-               {-
-                 Note that we scan over the libraries twice:
-                 first to gather together all type sigs, then to typecheck them
-                 (the latter of which doesn't necessarily have to be done every time.)
-                 This is a hack to avoid dealing with circular dependencies. 
-                -}
-               -- notice: scan over libraries *and* input modules first, not just libs
-               topEnv <- mkInitialEnv (snd (unzip deps))
-               (_,modules) <- foldM (process doTest) (topEnv,[]) deps
-               let succeeded = length modules
-               putStrLn ("Finished typechecking. Successfully checked " 
-                          ++ show succeeded)
-               overridden <- override modules
-               result <- evalProgram overridden
-               putStrLn ("Result = " ++ show result)
-               putStrLn "All done\n============================================="
-
-         mkInitialEnv :: [Module] -> IO Menv
-         mkInitialEnv libs = foldM mkTypeEnv initialEnv libs
-
-         mkTypeEnv :: Menv -> Module -> IO Menv
-         mkTypeEnv globalEnv m@(Module mn _ _) = 
-                catch (return (envsModule globalEnv m)) handler
-                  where handler e = do
-                          putStrLn ("WARNING: mkTypeEnv caught an exception " ++ show e 
-                                    ++ " while processing " ++ show mn)
-                          return globalEnv
-
-findModuleDirect :: FilePath -> IO (Maybe (FilePath, Module))
--- kludge to let us run "make libtest" -- 
--- this module (in the Cabal package) causes an uncaught exception
--- from Prelude.chr, which I haven't been able to track down
-findModuleDirect fn | "PackageDescription.hcr" `isSuffixOf` fn = return Nothing
-findModuleDirect fn = do
-  putStrLn $ "Finding " ++ show fn
-  res <- parseCore fn
-  case res of
-    Left err -> error (show err)
-    Right m -> return $ Just (fn,m)
\ No newline at end of file

diff --git a/utils/ext-core/Language/Core/ElimDeadCode.hs b/utils/ext-core/Language/Core/ElimDeadCode.hs
deleted file mode 100644 (file)
index 8817edb..0000000
--- a/utils/ext-core/Language/Core/ElimDeadCode.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{- 
-   This module eliminates unused top-level bindings, under the
-   assumption that all top-level bindings with qualified names
-   should be retained.
--}
-module Language.Core.ElimDeadCode(elimDeadCode) where
-
-import Language.Core.Core
-import Language.Core.Printer()
-import Language.Core.CoreUtils
-import Language.Core.Utils
-
-import Control.Monad.Reader
-import Data.Generics
-import Data.List
-import Data.Maybe
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-elimDeadCode :: Bool -> Module -> Module
--- exports = true <=> it's assumed we want to keep exported functions;
--- otherwise, we assume the module is "closed" and eliminate everything
--- not reachable from Main
-elimDeadCode exports (Module mn tdefs vdefgs) = runReader (do
-  (usedVars, usedDcons, usedTcons) <- findUsed emptySet 
-     (mkStartSet exports mn vdefgs) 
-  let isUsed (Vdef (v,_,_)) = v `S.member` usedVars
-  let newVdefgs = filterVdefgs isUsed vdefgs
-  let newTdefs  = filter (tdefIsUsed usedTcons usedDcons) tdefs in
-    return $ Module mn newTdefs newVdefgs) ((mkVarEnv vdefgs), mkTyEnv tdefs)
-
-tdefIsUsed :: S.Set (Qual Tcon) -> S.Set (Qual Dcon) -> Tdef -> Bool
-tdefIsUsed tcs dcs (Data qtc _ cdefs) = 
-  (qtc `S.member` tcs || any (\ (Constr qdc _ _) -> qdc `S.member` dcs) cdefs)
-tdefIsUsed tcs _ (Newtype qtc qtc_co _ _) = 
-  qtc `S.member` tcs || qtc_co `S.member` tcs
-
-mkVarEnv :: [Vdefg] -> M.Map (Qual Var) Exp
-mkVarEnv vgs =
-  let vdefs = flattenBinds vgs in
-    M.fromList [(v, e) | (Vdef (v, _, e)) <- vdefs]
-
--- if there is a Newtype qtc qtc_co ty,
--- generate: qtc |-> ty and qtc_co |-> ty
--- roughly the same for rhs's of Data decls
-mkTyEnv :: [Tdef] -> M.Map (Qual Tcon) [Ty]
-mkTyEnv tdefs = 
-  M.fromList ([(qtc, [ty]) | (Newtype qtc _ _ ty) <- tdefs]
-         ++   [(qtc, [ty]) | (Newtype _ qtc _ ty) <- tdefs]
-         ++   concatMap (\ td -> case td of
-                                   Data qtc _ cdefs -> [(qtc, concatMap 
-                                     (\ (Constr _ _ ts) -> ts) cdefs)]
-                                   _ -> []) tdefs)
-
-findUsed :: DeadSet -> DeadSet -> DeadM DeadSet
-findUsed _old@(oldVars,oldDcs,oldTcs) _new@(newVars,newDcs,newTcs) = do
-  let (todoVars, todoTcs) = ((S.\\) newVars oldVars, (S.\\) newTcs oldTcs)
-  let nextOld = (oldVars `S.union` todoVars, oldDcs `S.union` newDcs,
-                 oldTcs `S.union` todoTcs)
-  nextStuff <- getVarsAndConsIn (todoVars, todoTcs)
-  if (S.null todoVars && S.null todoTcs)
-      then return nextOld
-      else findUsed nextOld nextStuff
-
-getVarsAndConsIn :: (S.Set (Qual Var), S.Set (Qual Tcon)) -> DeadM DeadSet
-getVarsAndConsIn (vs, tcs) = do
-  vs1 <- mapM varsAndConsInOne (S.toList vs)
-  ts1 <- mapM varsAndConsInOne' (S.toList tcs)
-  let (vs'::[S.Set (Qual Var)], dcs'::[S.Set (Qual Dcon)],
-        ts'::[S.Set (Qual Tcon)]) = unzip3 (vs1 ++ ts1)
-  return (foldl' S.union S.empty vs', foldl' S.union S.empty dcs',
-          foldl' S.union S.empty ts')
-
-varsAndConsInOne :: Qual Var -> DeadM DeadSet
-varsAndConsInOne vr = do
-  def <- findDefn vr
-  return $ maybe emptySet 
-    (noNames emptySet unionThree (mkQ emptySet usedNamesAll)) def
-
-varsAndConsInOne' :: Qual Tcon -> DeadM DeadSet
-varsAndConsInOne' tc = do
-  ty <- findRepTy tc
-  return $ maybe emptySet
-    (noNames emptySet unionThree 
-              (mkQ emptySet usedStuffTys)) ty
-
-emptySet :: DeadSet
-emptySet = (S.empty, S.empty, S.empty)
-mkStartSet :: Bool -> AnMname -> [Vdefg] -> DeadSet
--- Initially, we assume the definitions of any exported functions are not
--- dead, and work backwards from there.
-mkStartSet exports mn vds = 
-  (S.fromList (filter ((== Just mn) . getModule) (if exports then exportedNames vds else [mainVar])), 
-   S.empty, S.empty)
-
-exportedNames :: [Vdefg] -> [Qual Var]
-exportedNames vdefgs = 
-  let vds = flattenBinds vdefgs in
-    filter isQual (ns vds)
-      where isQual    = isJust . fst
-            ns = map (\ (Vdef (n,_,_)) -> n)
-
-type DeadSet = (S.Set (Qual Var), S.Set (Qual Dcon), S.Set (Qual Tcon))
-type DeadM = Reader (M.Map (Qual Var) Exp, M.Map (Qual Tcon) [Ty])
-
-findDefn :: Qual Var -> DeadM (Maybe Exp)
-findDefn vr = asks ((M.lookup vr) . fst)
-findRepTy :: Qual Tcon -> DeadM (Maybe [Ty])
-findRepTy tc = asks ((M.lookup tc) . snd)
-
-unionThree :: DeadSet -> DeadSet -> DeadSet
-unionThree (a,b,c) (d,e,f) = (a `S.union` d, b `S.union` e, c `S.union` f)
-
-usedNamesAll :: Exp -> DeadSet
-usedNamesAll = (noNames emptySet unionThree 
-  ((mkQ emptySet usedStuff) `extQ` usedStuffTys `extQ` usedStuffAlts))
-            
-usedStuff :: Exp -> DeadSet
-usedStuff (Var qv)  = (S.singleton qv, S.empty, S.empty)
-usedStuff (Dcon dc) = (S.empty, S.singleton dc, S.empty)
-usedStuff _         = emptySet
-
-usedStuffAlts :: Alt -> DeadSet
-usedStuffAlts (Acon qdc _ _ _) = (S.empty, S.singleton qdc, S.empty)
-usedStuffAlts _ = emptySet
-
-usedStuffTys :: Ty -> DeadSet
-usedStuffTys (Tcon qtc) = (S.empty, S.empty, S.singleton qtc)
-usedStuffTys _          = emptySet

diff --git a/utils/ext-core/Language/Core/Encoding.hs b/utils/ext-core/Language/Core/Encoding.hs
deleted file mode 100644 (file)
index c952148..0000000
--- a/utils/ext-core/Language/Core/Encoding.hs
+++ /dev/null
@@ -1,206 +0,0 @@
-{-# OPTIONS -fno-warn-name-shadowing #-}
-
-module Language.Core.Encoding where
-
-import Data.Char
-import Numeric
-
--- tjc: TODO: Copied straight out of Encoding.hs.
--- Ugh, maybe we can avoid this copy-pasta...
-
--- -----------------------------------------------------------------------------
--- The Z-encoding
-
-{-
-This is the main name-encoding and decoding function.  It encodes any
-string into a string that is acceptable as a C name.  This is done
-right before we emit a symbol name into the compiled C or asm code.
-Z-encoding of strings is cached in the FastString interface, so we
-never encode the same string more than once.
-
-The basic encoding scheme is this.  
-
-* Tuples (,,,) are coded as Z3T
-
-* Alphabetic characters (upper and lower) and digits
-       all translate to themselves; 
-       except 'Z', which translates to 'ZZ'
-       and    'z', which translates to 'zz'
-  We need both so that we can preserve the variable/tycon distinction
-
-* Most other printable characters translate to 'zx' or 'Zx' for some
-       alphabetic character x
-
-* The others translate as 'znnnU' where 'nnn' is the decimal number
-        of the character
-
-       Before          After
-       --------------------------
-       Trak            Trak
-       foo_wib         foozuwib
-       >               zg
-       >1              zg1
-       foo#            foozh
-       foo##           foozhzh
-       foo##1          foozhzh1
-       fooZ            fooZZ   
-       :+              ZCzp
-       ()              Z0T     0-tuple
-       (,,,,)          Z5T     5-tuple  
-       (# #)           Z1H     unboxed 1-tuple (note the space)
-       (#,,,,#)        Z5H     unboxed 5-tuple
-               (NB: There is no Z1T nor Z0H.)
--}
-
-type UserString = String       -- As the user typed it
-type EncodedString = String    -- Encoded form
-
-
-zEncodeString :: UserString -> EncodedString
-zEncodeString cs = case maybe_tuple cs of
-               Just n  -> n            -- Tuples go to Z2T etc
-               Nothing -> go cs
-         where
-               go []     = []
-               go (c:cs) = encode_ch c ++ go cs
-
-unencodedChar :: Char -> Bool  -- True for chars that don't need encoding
-unencodedChar 'Z' = False
-unencodedChar 'z' = False
-unencodedChar c   =  c >= 'a' && c <= 'z'
-                 || c >= 'A' && c <= 'Z'
-                 || c >= '0' && c <= '9'
-
-encode_ch :: Char -> EncodedString
-encode_ch c | unencodedChar c = [c]    -- Common case first
-
--- Constructors
-encode_ch '('  = "ZL"  -- Needed for things like (,), and (->)
-encode_ch ')'  = "ZR"  -- For symmetry with (
-encode_ch '['  = "ZM"
-encode_ch ']'  = "ZN"
-encode_ch ':'  = "ZC"
-encode_ch 'Z'  = "ZZ"
-
--- Variables
-encode_ch 'z'  = "zz"
-encode_ch '&'  = "za"
-encode_ch '|'  = "zb"
-encode_ch '^'  = "zc"
-encode_ch '$'  = "zd"
-encode_ch '='  = "ze"
-encode_ch '>'  = "zg"
-encode_ch '#'  = "zh"
-encode_ch '.'  = "zi"
-encode_ch '<'  = "zl"
-encode_ch '-'  = "zm"
-encode_ch '!'  = "zn"
-encode_ch '+'  = "zp"
-encode_ch '\'' = "zq"
-encode_ch '\\' = "zr"
-encode_ch '/'  = "zs"
-encode_ch '*'  = "zt"
-encode_ch '_'  = "zu"
-encode_ch '%'  = "zv"
-encode_ch c    = 'z' : if isDigit (head hex_str) then hex_str
-                                                else '0':hex_str
-  where hex_str = showHex (ord c) "U"
-  -- ToDo: we could improve the encoding here in various ways.
-  -- eg. strings of unicode characters come out as 'z1234Uz5678U', we
-  -- could remove the 'U' in the middle (the 'z' works as a separator).
-
-       showHex = showIntAtBase 16 intToDigit
-       -- needed because prior to GHC 6.2, Numeric.showHex added a "0x" prefix
-
-zDecodeString :: EncodedString -> UserString
-zDecodeString [] = []
-zDecodeString ('Z' : d : rest) 
-  | isDigit d = decode_tuple   d rest
-  | otherwise = decode_upper   d : zDecodeString rest
-zDecodeString ('z' : d : rest)
-  | isDigit d = decode_num_esc d rest
-  | otherwise = decode_lower   d : zDecodeString rest
-zDecodeString (c   : rest) = c : zDecodeString rest
-
-decode_upper, decode_lower :: Char -> Char
-
-decode_upper 'L' = '('
-decode_upper 'R' = ')'
-decode_upper 'M' = '['
-decode_upper 'N' = ']'
-decode_upper 'C' = ':'
-decode_upper 'Z' = 'Z'
-decode_upper ch  = {-pprTrace "decode_upper" (char ch)-} ch
-               
-decode_lower 'z' = 'z'
-decode_lower 'a' = '&'
-decode_lower 'b' = '|'
-decode_lower 'c' = '^'
-decode_lower 'd' = '$'
-decode_lower 'e' = '='
-decode_lower 'g' = '>'
-decode_lower 'h' = '#'
-decode_lower 'i' = '.'
-decode_lower 'l' = '<'
-decode_lower 'm' = '-'
-decode_lower 'n' = '!'
-decode_lower 'p' = '+'
-decode_lower 'q' = '\''
-decode_lower 'r' = '\\'
-decode_lower 's' = '/'
-decode_lower 't' = '*'
-decode_lower 'u' = '_'
-decode_lower 'v' = '%'
-decode_lower ch  = {-pprTrace "decode_lower" (char ch)-} ch
-
--- Characters not having a specific code are coded as z224U (in hex)
-decode_num_esc :: Char -> EncodedString -> UserString
-decode_num_esc d rest
-  = go (digitToInt d) rest
-  where
-    go n (c : rest) | isHexDigit c = go (16*n + digitToInt c) rest
-    go n ('U' : rest)           = chr n : zDecodeString rest
-    go n other = error ("decode_num_esc: " ++ show n ++  ' ':other)
-
-decode_tuple :: Char -> EncodedString -> UserString
-decode_tuple d rest
-  = go (digitToInt d) rest
-  where
-       -- NB. recurse back to zDecodeString after decoding the tuple, because
-       -- the tuple might be embedded in a longer name.
-    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
-    go 0 ('T':rest)    = "()" ++ zDecodeString rest
-    go n ('T':rest)    = '(' : replicate (n-1) ',' ++ ")" ++ zDecodeString rest
-    go 1 ('H':rest)    = "(# #)" ++ zDecodeString rest
-    go n ('H':rest)    = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ zDecodeString rest
-    go n other = error ("decode_tuple: " ++ show n ++ ' ':other)
-
-{-
-Tuples are encoded as
-       Z3T or Z3H
-for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts 
-       Z<digit>
-
-* "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
-  There are no unboxed 0-tuples.  
-
-* "()" is the tycon for a boxed 0-tuple.
-  There are no boxed 1-tuples.
--}
-
-maybe_tuple :: UserString -> Maybe EncodedString
-
-maybe_tuple "(# #)" = Just("Z1H")
-maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
-                                 (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")
-                                 _                  -> Nothing
-maybe_tuple "()" = Just("Z0T")
-maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of
-                                 (n, ')' : _) -> Just ('Z' : shows (n+1) "T")
-                                 _            -> Nothing
-maybe_tuple _                = Nothing
-
-count_commas :: Int -> String -> (Int, String)
-count_commas n (',' : cs) = count_commas (n+1) cs
-count_commas n cs        = (n,cs)
-

diff --git a/utils/ext-core/Language/Core/Env.hs b/utils/ext-core/Language/Core/Env.hs
deleted file mode 100644 (file)
index 8ef9c69..0000000
--- a/utils/ext-core/Language/Core/Env.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{- Environments.
-  The original version used lists. I changed it to use Data.Map.
-  Sadly it doesn't seem to matter much. --tjc
--}
-
-module Language.Core.Env (Env,
-           eempty,
-           elookup,
-           eextend,
-            edomain,
-           efromlist,
-            etolist,
-           efilter,
-           eremove)
-where
-
-import qualified Data.Map as M
-
-data Env a b = Env (M.Map a b)
- deriving Show
-
-eempty :: Env a b 
-eempty = Env M.empty
-
-{- In case of duplicates, returns most recently added entry. -}
-elookup :: (Eq a, Ord a) => Env a b -> a -> Maybe b
-elookup (Env l) k = M.lookup k l 
-
-{- May hide existing entries. -}
-eextend :: Ord a => Env a b -> (a,b) -> Env a b
-eextend (Env l) (k,d) = Env (M.insert k d l)
-
-edomain :: (Eq a) => Env a b -> [a]
-edomain (Env l) = M.keys l
-
-{- In case of duplicates, first entry hides others. -}
-efromlist :: Ord a => [(a,b)] -> Env a b
-efromlist = Env . M.fromList
-
-etolist :: Env a b -> [(a,b)]
-etolist (Env l) = M.toList l
-
-eremove :: (Eq a, Ord a)  => Env a b -> a -> Env a b
-eremove (Env l) k = Env (M.delete k l)
-
-efilter :: Ord a => Env a b -> (a -> Bool) -> Env a b
-efilter (Env l) p = Env (M.filterWithKey (\ k _ -> p k) l)
-

diff --git a/utils/ext-core/Language/Core/Environments.hs b/utils/ext-core/Language/Core/Environments.hs
deleted file mode 100644 (file)
index 47ba594..0000000
--- a/utils/ext-core/Language/Core/Environments.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Language.Core.Environments where
-
-import Language.Core.Env
-import Language.Core.Core
-import Language.Core.Printer()
-
-{- Environments. -}
-type Tvenv = Env Tvar Kind                    -- type variables  (local only)
-type Tcenv = Env Tcon KindOrCoercion          -- type constructors
-type Cenv = Env Dcon Ty                      -- data constructors
-type Venv = Env Var Ty                               -- values
-type Menv = Env AnMname Envs                 -- modules
-data Envs = Envs {tcenv_::Tcenv,cenv_::Cenv,venv_::Venv} -- all the exportable envs
-  deriving Show
-
-{- Extend an environment, checking for illegal shadowing of identifiers (for term
-   variables -- shadowing type variables is allowed.) -}
-data EnvType = Tv | NotTv
-  deriving Eq

diff --git a/utils/ext-core/Language/Core/Interp.hs b/utils/ext-core/Language/Core/Interp.hs
deleted file mode 100644 (file)
index 0a4ac65..0000000
--- a/utils/ext-core/Language/Core/Interp.hs
+++ /dev/null
@@ -1,616 +0,0 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing -XPatternGuards -fglasgow-exts #-}
-{- 
-Interprets the subset of well-typed Core programs for which
-       (a) All constructor and primop applications are saturated
-       (b) All non-trivial expressions of unlifted kind ('#') are
-             scrutinized in a Case expression.
-
-This is by no means a "minimal" interpreter, in the sense that considerably
-simpler machinary could be used to run programs and get the right answers.
-However, it attempts to mirror the intended use of various Core constructs,
-particularly with respect to heap usage.  So considerations such as unboxed
-tuples, sharing, trimming, black-holing, etc. are all covered.
-The only major omission is garbage collection.
-
-Just a sampling of primitive types and operators are included.
--}
-
-module Language.Core.Interp ( evalProgram ) where
-
-import Control.Monad.Error
-import Control.Monad.State
-import Data.Char
-import Data.List
-
-import GHC.Exts hiding (Ptr)
-import System.IO
-
-import Language.Core.Core
-import Language.Core.Env
-import Language.Core.Printer()
-
-data HeapValue = 
-    Hconstr Dcon [Value]       -- constructed value (note: no qualifier needed!)
-  | Hclos Venv Var Exp         -- function closure
-  | Hthunk Venv Exp            -- unevaluated thunk
-  deriving (Show)
-
-type Ptr = Int
-
-data Value = 
-    Vheap Ptr                 -- heap pointer (boxed)
-  | Vimm PrimValue                    -- immediate primitive value (unboxed)
-  | Vutuple [Value]            -- unboxed tuples
-  deriving (Show)
-
-instance Error Value where
-  -- TODO: ??
-  strMsg s = error s
-
-type Venv = Env Var Value       -- values of vars
-
-data PrimValue =                -- values of the (unboxed) primitive types
-    PCharzh Integer            -- actually 31-bit unsigned
-  | PIntzh Integer             -- actually WORD_SIZE_IN_BITS-bit signed
-  | PWordzh Integer            -- actually WORD_SIZE_IN_BITS-bit unsigned
-  | PAddrzh Integer            -- actually native pointer size
-  | PFloatzh Rational          -- actually 32-bit 
-  | PDoublezh Rational         -- actually 64-bit
---  etc., etc.
-  | PString String
-  deriving (Eq,Show)
-
-type Menv = Env AnMname Venv   -- modules
-
-initialGlobalEnv :: Menv
-initialGlobalEnv =
-    efromlist
-       [(primMname,efromlist [("realWorldzh",Vimm (PIntzh 0))])]
-
-{- Heap management. -}
-{- Nothing is said about garbage collection. -}
-
-data Heap = Heap Ptr (Env Ptr HeapValue) 
-    -- last cell allocated; environment of allocated cells
-  deriving Show
-
-hallocate :: Heap -> HeapValue -> (Heap,Ptr)
-hallocate (Heap last contents) v = 
-   let next = last+1
-   in (Heap next (eextend contents (next,v)),next)
-
-hupdate :: Heap -> Ptr -> HeapValue -> Heap
-hupdate (Heap last contents) p v =
-   Heap last (eextend contents (p,v))
-
-hlookup:: Heap -> Ptr -> HeapValue
-hlookup (Heap _ contents) p =
-   case elookup contents p of
-     Just v -> v
-     Nothing -> error "Missing heap entry (black hole?)"
-
-hremove :: Heap -> Ptr -> Heap
-hremove (Heap last contents) p = 
-   Heap last (eremove contents p)
-
-hempty :: Heap
-hempty = Heap 0 eempty
-
-{- The evaluation monad manages the heap and the possiblity 
-   of exceptions. -}
-
-type Exn = Value
-
-type Eval a = ErrorT Exn (StateT Heap IO) a
-
-hallocateE :: HeapValue -> Eval Ptr
-hallocateE v = do
-  h <- get
-  let (h', p) = hallocate h v
-  put h'
-  return p
-
-hupdateE :: Ptr -> HeapValue -> Eval ()
-hupdateE p v = modify (\ h -> hupdate h p v)
-
-hlookupE :: Ptr -> Eval HeapValue
-hlookupE p =  get >>= (\h -> return (hlookup h p))
-
-hremoveE :: Ptr -> Eval ()
-hremoveE p = modify (\h -> hremove h p)
-
-raiseE :: Exn -> Eval a
-raiseE = throwError
-
-catchE :: Show a => Eval a -> (Exn -> Eval a) -> Eval a
-catchE = catchError
-
-runE :: Eval a -> IO a
-runE m = do
-  resultOrError <- evalStateT (runErrorT m) hempty
-  case resultOrError of
-    Right v -> return v
-    Left exn -> error
-      ("evaluation failed with uncaught exception: " ++ show exn)
-
-{- Main entry point -}
--- TODO: This is in the IO monad because primitive I/O ops
--- actually perform the IO. It might be better to model it
--- instead (by having the interpreter return a ([Char] -> (Value, [Char])))
-evalProgram :: [Module] -> IO Value
-evalProgram modules = runE $ do
-     -- We do two passes: one to slurp in all the definitions *except*
-     -- for :Main.main, and then one to look for the Main module
-     -- and extract out just the :Main.main defn.
-     -- It's kind of annoying.
-     globalEnv' <- foldM evalModule initialGlobalEnv modules
-     globalEnv  <- evalModule globalEnv' (rootModule modules)
-     Vutuple [_,v] <- evalExp globalEnv eempty (App (Var wrapperMainVar)
-                       stateToken)
-     return v
-
-rootModule :: [Module] -> Module
--- This looks for the Main module, and constructs
--- a fake module containing only the defn of
--- :Main.main.
-rootModule ms =
-  case find (\ (Module mn _ _) -> mn == mainMname) ms of
-    Just (Module _ _ [Rec bs]) ->
-        Module wrapperMainMname []
-          [Rec (filter isWrapperMainVdef bs)]
-    _ -> error "eval: missing main module"
-  where isWrapperMainVdef (Vdef (v,_,_)) | v == wrapperMainVar = True
-        isWrapperMainVdef _ = False
-
-{- Environments:
-
-Evaluating a module just fills an environment with suspensions for all
-the external top-level values; it doesn't actually do any evaluation
-or look anything up.
-
-By the time we actually evaluate an expression, all external values from
-all modules will be in globalEnv.  So evaluation just maintains an environment
-of non-external values (top-level or local).  In particular, only non-external
-values end up in closures (all other values are accessible from globalEnv.)
-
-Throughout:
-
-- globalEnv contains external values (all top-level) from all modules seen so far.
-
-In evalModule:
-
-- e_venv    contains external values (all top-level) seen so far in current module
-- l_venv    contains non-external values (top-level or local)  
-                 seen so far in current module.
-In evalExp:
-
-- env      contains non-external values (top-level or local) seen so far
-               in current expression.
--}
-
-
-evalModule :: Menv -> Module -> Eval Menv
-evalModule globalEnv (Module mn _ vdefgs) =
-  do (e_venv,_) <- foldM evalVdef (eempty,eempty) vdefgs
-     return (eextend globalEnv (mn,e_venv))
-  where
-    evalVdef :: (Venv,Venv) -> Vdefg -> Eval (Venv,Venv)
-    evalVdef (e_env,l_env) (Nonrec(Vdef((m,x),_,e))) =
-     do p <- hallocateE (suspendExp l_env e)
-       let heaps =
-               case m of
-                 Nothing -> (e_env,eextend l_env (x,Vheap p))
-                _       -> (eextend e_env (x,Vheap p),l_env)
-       return heaps
-    evalVdef (e_env,l_env) (Rec vdefs) =
-      do l_vs0 <- mapM preallocate l_xs
-        let l_env' = foldl eextend l_env (zip l_xs (map Vheap l_vs0))
-        let l_hs = map (suspendExp l_env') l_es
-        mapM_ reallocate (zip l_vs0 l_hs)
-        let e_hs = map (suspendExp l_env') e_es
-        e_vs <- (liftM (map Vheap)) $ mapM allocate e_hs
-         let e_env' = foldl eextend e_env (zip e_xs e_vs)
-        return (e_env',l_env')            
-      where 
-        (l_xs,l_es) = unzip [(x,e) | Vdef((Nothing,x),_,e) <- vdefs]
-        (e_xs,e_es) = unzip [(x,e) | Vdef ((Just _,x),_,e) <-
-                         -- Do not dump the defn for :Main.main into
-                         -- the environment for Main!
-                                       filter inHomeModule vdefs]
-         inHomeModule (Vdef ((Just m,_),_,_)) | m == mn = True
-         inHomeModule _ = False
-        preallocate _ =
-          do p <- hallocateE undefined
-             return p
-        reallocate (p0,h) =
-          hupdateE p0 h
-        allocate h =
-          do p <- hallocateE h
-             return p
-
-    suspendExp:: Venv -> Exp -> HeapValue
-    suspendExp env (Lam (Vb(x,_)) e) = Hclos env' x e
-       where env' = thin env (delete x (freevarsExp e))
-    suspendExp env e = Hthunk env' e
-       where env' = thin env (freevarsExp e)
-
-evalExp :: Menv -> Venv -> Exp -> Eval Value
-evalExp globalEnv env = eval
-  where eval (Var qv) = 
-          let v = qlookup globalEnv env qv
-          in case v of 
-               Vheap p -> do
-                z <- hlookupE p                    -- can fail due to black-holing
-                case z of
-                  Hthunk env' e -> do
-                    hremoveE p                     -- black-hole
-                     w <- evalExp globalEnv env' e  -- result is guaranteed to be boxed!
-                     case w of
-                       Vheap p' -> do
-                        h <- hlookupE p'
-                        hupdateE p h
-                        return w
-                       _ -> error ("eval: w was not boxed: " ++ show w)
-                  _ -> return v -- return pointer to Hclos or Hconstr
-               _ -> return v     -- return Vimm or Vutuple
-        eval (Lit l) = return (Vimm (evalLit l))
-        eval (Dcon (_,c)) = do
-           p <- hallocateE (Hconstr c [])
-           return (Vheap p)
-        eval (App e1 e2) =
-          evalApp env e1 [e2]
-            where
-              evalApp :: Venv -> Exp -> [Exp] -> Eval Value
-              evalApp env (App e1 e2) es = evalApp env e1 (e2:es)
-              evalApp env (Dcon (qdc@(_,c))) es = 
-                  do vs <- suspendExps globalEnv env es
-                    if isUtupleDc qdc
-                       then
-                        return (Vutuple vs)
-                      else
-                        {- allocate a thunk -}
-                        do p <- hallocateE (Hconstr c vs)
-                           return (Vheap p)
-              evalApp env (Var(v@(_,p))) es | isPrimVar v =
-                 do vs <- evalExps globalEnv env es
-                    case (p,vs) of
-                     ("raisezh",[exn]) -> raiseE exn
-                     ("catchzh",[body,handler,rws]) ->
-                               catchE (apply body [rws])
-                               (\exn -> apply handler [exn,rws])
-                     _ -> evalPrimop p vs
-              evalApp env (External s _) es =
-                  do vs <- evalExps globalEnv env es
-                    evalExternal s vs
-              evalApp env (Appt e _) es     = evalApp env e es
-              evalApp env (Lam (Tb _) e) es = evalApp env e es
-              evalApp env (Cast e _) es     = evalApp env e es
-              evalApp env (Note _ e) es     = evalApp env e es
-              evalApp env e es = 
-          {- e must now evaluate to a closure -}
-                  do vs <- suspendExps globalEnv env es
-                    vop <- evalExp globalEnv env e
-                     apply vop vs
-
-              apply :: Value -> [Value] -> Eval Value
-              apply vop [] = return vop
-              apply (Vheap p) (v:vs) =
-                  do Hclos env' x b <- hlookupE p
-                     v' <- evalExp globalEnv (eextend env' (x,v)) b
-                     apply v' vs
-              apply _ _ = error ("apply: operator is not a closure")
-
-        eval (Appt e _) = evalExp globalEnv env e
-        eval (Lam (Vb(x,_)) e) = do
-           p <- hallocateE (Hclos env' x e)
-           return (Vheap p)
-               where env' = thin env (delete x (freevarsExp e))
-        eval (Lam _ e) = evalExp globalEnv env e
-        eval (Let vdef e) =
-          do env' <- evalVdef globalEnv env vdef
-             evalExp globalEnv env' e
-            where
-              evalVdef :: Menv -> Venv -> Vdefg -> Eval Venv
-              evalVdef globalEnv env (Nonrec(Vdef((_,x),_,e))) =
-                  do v <- suspendExp globalEnv env e
-                    return (eextend env (x,v))
-              evalVdef globalEnv env (Rec vdefs) =
-                  do vs0 <- mapM preallocate xs
-                    let env' = foldl eextend env (zip xs (map Vheap vs0))
-                    vs <- suspendExps globalEnv env' es
-                    mapM_ reallocate (zip vs0 vs)
-                    return env'
-                  where 
-                   (xs,es) = unzip [(x,e) | Vdef((_,x),_,e) <- vdefs]
-                   preallocate _ = 
-                        do p <- hallocateE (Hconstr "UGH" [])
-                          return p
-                   reallocate (p0,Vheap p) =
-                       do h <- hlookupE p
-                          hupdateE p0 h
-                    reallocate (_,_) = error "reallocate: expected a heap value"
-        eval (Case e (x,_) _ alts) =
-            do z <- evalExp globalEnv env e
-               let env' = eextend env (x,z)
-               case z of
-                 Vheap p -> do
-                  h <- hlookupE p   -- can fail due to black-holing
-                  case h of
-                    Hconstr dcon vs -> evalDcAlt env' dcon vs (reverse alts)
-                    _ ->               evalDefaultAlt env' alts
-                 Vutuple vs ->
-                    evalUtupleAlt env' vs (reverse alts)
-                 Vimm pv ->
-                    evalLitAlt env' pv (reverse alts)
-            where
-              evalDcAlt :: Venv -> Dcon -> [Value] -> [Alt] -> Eval Value
-              evalDcAlt env dcon vs = f
-                where
-                 f ((Acon (_,dcon') _ xs e):as) =
-                    if dcon == dcon' then
-                      evalExp globalEnv
-                         (foldl eextend env (zip (map fst xs) vs)) e
-                    else f as
-                 f [Adefault e] =
-                   evalExp globalEnv env e
-                 f _ = error $ "impossible Case-evalDcAlt"
-
-              evalUtupleAlt :: Venv -> [Value] -> [Alt] -> Eval Value
-              evalUtupleAlt env vs [Acon _ _ xs e] =
-                  evalExp globalEnv (foldl eextend env (zip (map fst xs) vs)) e
-              evalUtupleAlt _ _ _ = error ("impossible Case: evalUtupleAlt")
-
-              evalLitAlt :: Venv -> PrimValue -> [Alt] -> Eval Value
-              evalLitAlt env pv alts =
-                  f alts
-                      where 
-                       f ((Alit lit e):as) =
-                           let pv' = evalLit lit
-                           in if pv == pv' then
-                                  evalExp globalEnv env e
-                               else f as
-                        f [Adefault e] =
-                           evalExp globalEnv env e
-                       f _ = error "impossible Case-evalLitAlt"
-    
-              evalDefaultAlt :: Venv -> [Alt] -> Eval Value
-              evalDefaultAlt env [Adefault e] = evalExp globalEnv env e
-              evalDefaultAlt _ _ = error "evalDefaultAlt: impossible case"
-
-        eval (Cast e _) = evalExp globalEnv env e
-        eval (Note _ e) = evalExp globalEnv env e
-        eval (External s _) = evalExternal s []
-
-evalExps :: Menv -> Venv -> [Exp] -> Eval [Value]
-evalExps globalEnv env = mapM (evalExp globalEnv env)
-
-suspendExp:: Menv -> Venv -> Exp -> Eval Value
-suspendExp globalEnv env (Var qv) = return (qlookup globalEnv env qv)
-suspendExp _ _ (Lit l) = return (Vimm (evalLit l))
-suspendExp _ env (Lam (Vb(x,_)) e) =
-   do p <- hallocateE (Hclos env' x e)
-      return (Vheap p)
-   where env' = thin env (delete x (freevarsExp e))
-suspendExp globalEnv env (Lam _ e) = suspendExp globalEnv env e
-suspendExp globalEnv env (Appt e _) = suspendExp globalEnv env e
-suspendExp globalEnv env (Cast e _) = suspendExp globalEnv env e
-suspendExp globalEnv env (Note _ e) = suspendExp globalEnv env e
-suspendExp _ _ (External s _) = evalExternal s []
-suspendExp _ env e =
-   do p <- hallocateE (Hthunk env' e)
-      return (Vheap p)
-   where env' = thin env (freevarsExp e)
-
-suspendExps :: Menv -> Venv -> [Exp] -> Eval [Value]
-suspendExps globalEnv env = mapM (suspendExp globalEnv env)
-
-mlookup :: Menv -> Venv -> Mname -> Venv
-mlookup _          env       Nothing  = env
-mlookup globalEnv  _         (Just m) = 
-    case elookup globalEnv m of
-      Just env' -> env'
-      Nothing -> error ("Interp: undefined module name: " ++ show m)
-
-qlookup :: Menv -> Venv -> (Mname,Var) -> Value
-qlookup globalEnv env (m,k) =
-  case elookup (mlookup globalEnv env m) k of
-    Just v -> v
-    Nothing -> error ("undefined identifier: " ++ show m ++ "." ++ show k)
-
-evalPrimop :: Var -> [Value] -> Eval Value
-evalPrimop "zpzh"        = primIntBinop    (+)
-evalPrimop "zpzhzh"      = primDoubleBinop (+)
-evalPrimop "zmzh"        = primIntBinop    (-)
-evalPrimop "zmzhzh"      = primDoubleBinop (-)
-evalPrimop "ztzh"        = primIntBinop    (*)
-evalPrimop "ztzhzh"      = primDoubleBinop (*)
-evalPrimop "zgzh"        = primIntCmpOp    (>)
-evalPrimop "zlzh"        = primIntCmpOp    (<)
-evalPrimop "zlzhzh"      = primDoubleCmpOp (<)
-evalPrimop "zezezh"      = primIntCmpOp    (==)
-evalPrimop "zlzezh"      = primIntCmpOp    (<=)
-evalPrimop "zlzezhzh"    = primDoubleCmpOp (<=)
-evalPrimop "zgzezh"      = primIntCmpOp    (>=)
-evalPrimop "zszezh"      = primIntCmpOp    (/=)
-evalPrimop "zszhzh"      = primDoubleCmpOp (/=)
-evalPrimop "negateIntzh" = primIntUnop     (\ i -> -i)
-evalPrimop "quotIntzh"   = primIntBinop    quot
-evalPrimop "remIntzh"    = primIntBinop    rem
-evalPrimop "subIntCzh"   = primSubIntC
-evalPrimop "addIntCzh"   = primAddIntC
-evalPrimop "mulIntMayOflozh" = primIntBinop
-  (\ i j ->
-     case (fromIntegral i, fromIntegral j) of
-       (I# x, I# y) -> 
-         case x `mulIntMayOflo#` y of
-           k -> fromIntegral (I# k))
-evalPrimop "narrow32Intzh" = primIntUnop
-  (\ i ->
-     case fromIntegral i of
-       (I# j) -> case narrow32Int# j of
-                   k -> fromIntegral (I# k))
-evalPrimop "int2Doublezh" = primInt2Double 
--- single-threaded, so, it's a no-op
---evalPrimop "noDuplicatezh" [state] = return state
-evalPrimop "indexCharOffAddrzh" = primIndexChar
-evalPrimop "eqCharzh"           = primCharCmpOp (==)
-evalPrimop "leCharzh"           = primCharCmpOp (<) 
-evalPrimop "ordzh"              = primOrd 
-evalPrimop "chrzh"              = primChr
-evalPrimop "isSpacezh"          = primCharUnop isSpace
-evalPrimop "isAlphazh"          = primCharUnop isAlpha
-evalPrimop "hPutCharzh"         = primHPutChar
--- etc.
-evalPrimop p = error ("undefined primop: " ++ p)
-
-primIntUnop :: (Integer -> Integer) -> [Value] -> Eval Value
-primIntUnop op [Vimm (PIntzh i)] = return (Vimm (PIntzh (op i)))
-primIntUnop _ _ = error "primIntUnop: wrong number of arguments"
-
-primIntBinop :: (Integer -> Integer -> Integer) -> [Value] -> Eval Value
-primIntBinop op [Vimm (PIntzh i), Vimm (PIntzh j)] = 
-  return (Vimm (PIntzh (i `op` j)))
-primIntBinop _ _ = error "primIntBinop: wrong number of arguments"
-
-primDoubleBinop :: (Rational -> Rational -> Rational) -> [Value] -> Eval Value
-primDoubleBinop op [Vimm (PDoublezh i), Vimm (PDoublezh j)] = 
-  return (Vimm (PDoublezh (i `op` j)))
-primDoubleBinop _ _ = error "primDoubleBinop: wrong number of arguments"
-
-primIntCmpOp :: (Integer -> Integer -> Bool) -> [Value] -> Eval Value
-primIntCmpOp op [Vimm (PIntzh i), Vimm (PIntzh j)] = mkBool (i `op` j)
-primIntCmpOp _ _ = error "primIntCmpOp: wrong number of arguments"
-
-primDoubleCmpOp :: (Rational -> Rational -> Bool) -> [Value] -> Eval Value
-primDoubleCmpOp op [Vimm (PDoublezh i), Vimm (PDoublezh j)] = mkBool (i `op` j)
-primDoubleCmpOp _ _ = error "primDoubleCmpOp: wrong number of arguments"
-
-primCharCmpOp :: (Integer -> Integer -> Bool) -> [Value] -> Eval Value
-primCharCmpOp op [Vimm (PCharzh c), Vimm (PCharzh d)] = mkBool (c `op` d)
-primCharCmpOp _ _ = error "primCharCmpOp: wrong number of arguments"
-
-primSubIntC :: [Value] -> Eval Value
-primSubIntC vs = carryOp subIntC# vs
-
-primAddIntC :: [Value] -> Eval Value
-primAddIntC vs = carryOp addIntC# vs
-
-carryOp :: (Int# -> Int# -> (# Int#, Int# #)) -> [Value] -> Eval Value
-carryOp op [Vimm (PIntzh i1), Vimm (PIntzh i2)] =
-  case (fromIntegral i1, fromIntegral i2) of
-    (I# int1, I# int2) -> 
-       case (int1 `op` int2) of
-        (# res1, res2 #) -> 
-           return $ Vutuple [Vimm (PIntzh (fromIntegral (I# res1))),
-                             Vimm (PIntzh (fromIntegral (I# res2)))]
-carryOp _ _ = error "carryOp: wrong number of arguments"
-
-primInt2Double :: [Value] -> Eval Value
-primInt2Double [Vimm (PIntzh i)] =
-  return (Vimm (PDoublezh (fromIntegral i)))
-primInt2Double _ = error "primInt2Double: wrong number of arguments"
-
-primOrd :: [Value] -> Eval Value
-primOrd [Vimm (PCharzh c)] = return $ Vimm (PIntzh c)
-primOrd _ = error "primOrd: wrong number of arguments"
-
-primChr :: [Value] -> Eval Value
-primChr [Vimm (PIntzh c)] = return $ Vimm (PCharzh c)
-primChr _ = error "primChr: wrong number of arguments"
-
-primCharUnop :: (Char -> Bool) -> [Value] -> Eval Value
-primCharUnop op [Vimm (PCharzh c)] = mkBool (op (chr (fromIntegral c)))
-primCharUnop _ _ = error "primCharUnop: wrong number of arguments"
-
-primIndexChar :: [Value] -> Eval Value
-primIndexChar [(Vimm (PString s)), (Vimm (PIntzh i))] = 
-  -- String is supposed to be null-terminated, so if i == length(s),
-  -- we return null. (If i > length(s), emit nasal demons.)
-  return $ let len = fromIntegral $ length s in
-             if i < len 
-               then Vimm (PCharzh (fromIntegral (ord (s !! fromIntegral i))))
-               else if i == len
-                      then Vimm (PCharzh 0)
-                      else error "indexCharOffAddr#: index too large"
-primIndexChar _ = error "primIndexChar: wrong number of arguments"
-
-primHPutChar :: [Value] -> Eval Value
-primHPutChar [Vimm (PIntzh hdl), Vimm (PCharzh c)] =
-  liftIO (hPutChar 
-     (if hdl == 0
-        then stdin
-        else if hdl == 1
-               then stdout
-               else -- lol
-                 stderr) (chr (fromIntegral c))) >>
-  returnUnit
-primHPutChar _ = error "primHPutChar: wrong number of arguments"
-
-evalExternal :: String -> [Value] -> Eval Value
--- etc.
-evalExternal s _ = error $ "evalExternal undefined for now: " ++ show s  -- etc.,etc.
-
-returnUnit :: Eval Value
-returnUnit = do    
-  p <- hallocateE (Hclos eempty "_"
-         (App (App (Dcon (dcUtuple 2)) stateToken) unitCon))
-  return $ Vheap p
-
-evalLit :: Lit -> PrimValue
-evalLit (Literal l t) = 
-    case l of
-      Lint i | (Tcon(_,"Intzh")) <- t -> PIntzh i
-      Lint i | (Tcon(_,"Wordzh")) <- t -> PWordzh i
-      Lint i | (Tcon(_,"Addrzh")) <- t -> PAddrzh i
-      Lint i | (Tcon(_,"Charzh"))<- t -> PCharzh i
-      Lrational r | (Tcon(_,"Floatzh"))  <- t -> PFloatzh r
-      Lrational r | (Tcon(_,"Doublezh")) <- t -> PDoublezh r
-      Lchar c | (Tcon(_,"Charzh")) <- t       -> PCharzh (toEnum (ord c))
-      Lstring s | (Tcon(_,"Addrzh")) <- t     -> PString s
-          -- should really be address of non-heap copy of C-format string s
-          -- tjc: I am ignoring this comment
-      _ -> error ("evalLit: strange combination of literal "
-             ++ show l ++ " and type " ++ show t)
-
-{- Utilities -}
-
-mkBool :: Bool -> Eval Value
-mkBool True = 
-  do p <- hallocateE (Hconstr "True" [])
-     return (Vheap p)
-mkBool False = 
-  do p <- hallocateE (Hconstr "False" [])
-     return (Vheap p)
-
-thin :: Ord a => Env a b -> [a] -> Env a b    
-thin env vars = efilter env (`elem` vars)
-
-{- Return the free non-external variables in an expression. -}
-
-freevarsExp :: Exp -> [Var]
-freevarsExp (Var (Nothing,v)) = [v]
-freevarsExp (Var _) = []
-freevarsExp (Dcon _) = []
-freevarsExp (Lit _) = []
-freevarsExp (App e1 e2) = freevarsExp e1 `union` freevarsExp e2
-freevarsExp (Appt e _) = freevarsExp e
-freevarsExp (Lam (Vb(v,_)) e) = delete v (freevarsExp e)
-freevarsExp (Lam _ e) = freevarsExp e
-freevarsExp (Let vdefg e) = freevarsVdefg vdefg `union` freevarsExp e
-  where freevarsVdefg (Rec vdefs) = (foldl union [] (map freevarsExp es)) \\ vs
-            where (vs,es) = unzip [(v,e) | Vdef((_,v),_,e) <- vdefs]   
-        freevarsVdefg (Nonrec (Vdef (_,_,e))) = freevarsExp e
-freevarsExp (Case e (v,_) _ as) = freevarsExp e `union` [v] `union` freevarsAlts as
-  where freevarsAlts alts = foldl union [] (map freevarsAlt alts)
-        freevarsAlt (Acon _ _ vbs e) = freevarsExp e \\ (map fst vbs) 
-        freevarsAlt (Alit _ e) = freevarsExp e
-        freevarsAlt (Adefault e) = freevarsExp e
-freevarsExp (Cast e _) = freevarsExp e
-freevarsExp (Note _ e) =  freevarsExp e
-freevarsExp (External _ _) = []
-
-stateToken :: Exp
-stateToken = Var (qual primMname "realWorldzh")
-
-unitCon :: Exp
-unitCon = Dcon (qual baseMname "Z0T")

diff --git a/utils/ext-core/Language/Core/Lex.hs b/utils/ext-core/Language/Core/Lex.hs
deleted file mode 100644 (file)
index 991ee0a..0000000
--- a/utils/ext-core/Language/Core/Lex.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-module Lex where
-
-import ParseGlue
-import Ratio
-import Char
-
-isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') 
-isKeywordChar c = isAlpha c || (c == '_') 
-
-lexer :: (Token -> P a) -> P a 
-lexer cont [] = cont TKEOF []
-lexer cont ('\n':cs) = \line -> lexer cont cs (line+1)
-lexer cont ('-':'>':cs) = cont TKrarrow cs
-lexer cont (c:cs) 
-      | isSpace c = lexer cont cs
-      | isLower c || (c == '_') = lexName cont TKname (c:cs)
-      | isUpper c = lexName cont TKcname (c:cs)
-      | isDigit c || (c == '-') = lexNum cont (c:cs)
-lexer cont ('%':cs) = lexKeyword cont cs
-lexer cont ('\'':cs) = lexChar cont cs
-lexer cont ('\"':cs) = lexString [] cont cs 
-lexer cont ('#':cs) = cont TKhash cs
-lexer cont ('(':cs) = cont TKoparen cs
-lexer cont (')':cs) = cont TKcparen cs
-lexer cont ('{':cs) = cont TKobrace cs
-lexer cont ('}':cs) = cont TKcbrace cs
-lexer cont ('=':cs) = cont TKeq cs
-lexer cont (':':':':cs) = cont TKcoloncolon cs
-lexer cont ('*':cs) = cont TKstar cs
-lexer cont ('.':cs) = cont TKdot cs
-lexer cont ('\\':cs) = cont TKlambda cs
-lexer cont ('/':'\\':cs) = cont TKbiglambda cs
-lexer cont ('@':cs) = cont TKat cs
-lexer cont ('?':cs) = cont TKquestion cs
-lexer cont (';':cs) = cont TKsemicolon cs
-lexer cont (':':cs) = cont TKcolon cs
-lexer cont (c:cs) = failP "invalid character" [c]
-
-lexChar cont ('\\':'x':h1:h0:'\'':cs)
-       | isHexEscape [h1,h0] =  cont (TKchar (hexToChar h1 h0)) cs
-lexChar cont ('\\':cs) = failP "invalid char character" ('\\':(take 10 cs))
-lexChar cont ('\'':cs) = failP "invalid char character" ['\'']
-lexChar cont ('\"':cs) = failP "invalid char character" ['\"']
-lexChar cont (c:'\'':cs) = cont (TKchar c) cs
-
-lexString s cont ('\\':'x':h1:h0:cs) 
-       | isHexEscape [h1,h0] = lexString (s++[hexToChar h1 h0]) cont cs
-lexString s cont ('\\':cs) = failP "invalid string character" ['\\']
-lexString s cont ('\'':cs) = failP "invalid string character" ['\'']
-lexString s cont ('\"':cs) = cont (TKstring s) cs
-lexString s cont (c:cs) = lexString (s++[c]) cont cs
-
-isHexEscape = all (\c -> isHexDigit c && (isDigit c || isLower c))
-
-hexToChar h1 h0 = 
-       chr(
-       (digitToInt h1) * 16 + 
-       (digitToInt h0))
-
-
-lexNum cont cs =
-  case cs of
-     ('-':cs) ->  f (-1) cs
-     _ -> f 1 cs
- where f sgn cs = 
-         case span isDigit cs of
-          (digits,'.':c:rest) | isDigit c -> 
-            cont (TKrational (numer % denom)) rest'
-              where (fpart,rest') = span isDigit (c:rest)
-                    denom = 10^(length fpart)
-                    numer = sgn * ((read digits) * denom + (read fpart))
-          (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest
-
-lexName cont cstr cs = cont (cstr name) rest
-   where (name,rest) = span isNameChar cs
-
-lexKeyword cont cs = 
-   case span isKeywordChar cs of
-      ("module",rest) -> cont TKmodule rest
-      ("data",rest)  -> cont TKdata rest
-      ("newtype",rest) -> cont TKnewtype rest
-      ("forall",rest) -> cont TKforall rest    
-      ("rec",rest) -> cont TKrec rest  
-      ("let",rest) -> cont TKlet rest  
-      ("in",rest) -> cont TKin rest    
-      ("case",rest) -> cont TKcase rest        
-      ("of",rest) -> cont TKof rest    
-      ("cast",rest) -> cont TKcast rest        
-      ("note",rest) -> cont TKnote rest        
-      ("external",rest) -> cont TKexternal rest
-      ("_",rest) -> cont TKwild rest
-      _ -> failP "invalid keyword" ('%':cs) 
-

diff --git a/utils/ext-core/Language/Core/Merge.hs b/utils/ext-core/Language/Core/Merge.hs
deleted file mode 100644 (file)
index 18ad057..0000000
--- a/utils/ext-core/Language/Core/Merge.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-{-
-   This module combines multiple External Core modules into
-   a single module, including both datatype and value definitions. 
--}
-module Language.Core.Merge(merge,uniqueNamesIn,nonUniqueNamesIn) where
-
-import Language.Core.Core
-import Language.Core.CoreUtils
-import Language.Core.Utils
-
-import Data.Char
-import Data.Generics
-import Data.List
-import Data.Maybe
-
-{-
-   merge turns a group of (possibly mutually recursive) modules
-   into a single module, which should be called main:Main. 
-
-   This doesn't handle dependency-finding; you have to hand it all
-   the modules that your main module depends on (transitively).
-   Language.Core.Dependencies does automatic dependency-finding,
-   but that code is a bit moldy.
-
-   merge takes an extra argument that is a variable substitution.
-   This is because you may want to treat some defined names specially
-   rather than dumping their definitions into the Main module. For
-   example, if my back-end tool defines a new primop that has
-   the type IO (), it's easiest for me if I can consider IO and () as
-   primitive type constructors, though they are not. Thus, I pass in
-   a substitution that says to replace GHC.IOBase.IO with GHC.Prim.IO,
-   and GHC.Base.() with GHC.Prim.(). Of course, I am responsible for
-   providing a type environment defining those names if I want to be
-   able to type the resulting program.
-
-   You can pass in the empty list if you don't understand what the
-   purpose of the substitution is.
--}
-
-merge    :: [(Qual Var, Qual Var)] -> [Module] -> Module
-merge subst ms = 
-   zapNames subst topNames (Module mainMname newTdefs topBinds)
-     where -- note: dead code elimination will later remove any names
-           -- that were in the domain of the substitution
-           newTdefs = finishTdefs deadIds $ concat allTdefs
-           (allTdefs, allVdefgs) = unzip $ map (\ (Module _ tds vdefgs) 
-                                             -> (tds, vdefgs)) ms
-           (deadIds,_) = unzip subst
-           topNames    = uniqueNamesIn topBinds (concat allTdefs)
-           (topBinds::[Vdefg])    = finishVdefs deadIds $ concat allVdefgs
-
-{-
-   This function finds all of the names in the given group of vdefs and
-   tdefs that are only defined by one module. This is because if function
-   quux is only defined in module foo:Bar.Blat, we want to call it
-   main:Main.quux in the final module, and not main:Main.foo_Bar_Blat_quux,
-   for file size and readability's sake.
-
-   Possible improvements:
-   * take into account that tcons/dcons are separate namespaces
-   * restructure the whole thing to shorten names *after* dead code elim.        
-   (Both of those would allow for more names to be shortened, but aren't
-   strictly necessary.)
--}
-uniqueNamesIn :: [Vdefg] -> [Tdef] -> [Qual Var]
-uniqueNamesIn topBinds allTdefs = res
-  where vars  = vdefNamesQ (flattenBinds topBinds)
-        dcons = tdefDcons allTdefs
-        tcons = tdefTcons allTdefs
-        uniqueVars  = vars \\ dupsUnqual vars
-        uniqueDcons = dcons \\ dupsUnqual dcons
-        uniqueTcons = tcons \\ dupsUnqual tcons
-        res = uniqueVars ++ uniqueDcons ++ uniqueTcons
-
-nonUniqueNamesIn :: [Vdef] -> [Tdef] -> [Qual Var]
-nonUniqueNamesIn topBinds allTdefs = dupsUnqual allNames
-  where allNames = vdefNamesQ topBinds ++ tdefNames allTdefs
-        
--- This takes each top-level name of the form Foo.Bar.blah and
--- renames it to FoozuBarzublah (note we *don't* make it exported!
--- This is so we know which names were in the original program and
--- which were dumped in from other modules, and thus can eliminate
--- dead code.)
-zapNames :: Data a => [(Qual Var, Qual Var)] -> [Qual Var] -> a -> a
-zapNames subst qvs = everywhereBut (mkQ False (\ (_::String) -> True))
-             (mkT (fixupName subst qvs))
-
--- also need version for type and data constructors
--- don't forget to *not* zap if something has the primitive module name
--- We hope and pray there are no top-level unqualified names that are used in
--- more than one module. (Can we assume this?) (I think so, b/c -fext-core
--- attaches uniques to things. But could still perhaps go wrong if we fed
--- in .hcr files that were generated in diff. compilation sessions...)
--- (This wouldn't be too hard to fix, but should state the assumption,
--- and how to remove it.)
-
-fixupName :: [(Qual Var, Qual Var)] -> [Qual Var] -> Qual Var -> Qual Var
--- For a variable in the domain of the substitution, just
--- apply the substitution.
-fixupName subst _ oldVar | Just newVar <- lookup oldVar subst = newVar
--- We don't alter unqualified names, since we just need to make sure
--- everything can go in the Main module.
-fixupName _ _ vr@(Nothing,_) = vr
--- Nor do we alter anything defined in the Main module or the primitive module.
-fixupName _ _ vr@(Just mn, _) | mn == mainMname || mn == wrapperMainMname ||
-                            mn == primMname = vr
--- For a variable that is defined by only one module in scope, we 
--- give it a name that is just its unqualified name, without the original
--- module and package names.
-fixupName _ uniqueNames (_, v) | okay = 
-   (mkMname v, v)
-     where okay = any (\ (_,v1) -> v == v1) uniqueNames
--- This is the case for a name that is defined in more than one
--- module. In this case, we have to give it a unique name to disambiguate
--- it from other definitions of the same name. We combine the package and
--- module name to give a unique prefix.
-fixupName _ _ (Just (M (P pname, hierNames, leafName)), varName) = 
-   (mkMname varName, -- see comment for zapNames 
-     (if isUpperStr varName then capitalize else id) $
-       intercalate "zu" (pname:(hierNames ++ [leafName, varName])))
-  where capitalize (ch:rest) = (toUpper ch):rest
-        capitalize ""        = ""
-
-mkMname :: Var -> Mname
--- icky hack :-(
--- necessary b/c tycons and datacons have to be qualified,
--- but we want to write fixupName as a generic transformation on vars.
-mkMname v = if isUpperStr v then Just mainMname else Nothing
-
-isUpperStr :: String -> Bool
-isUpperStr (c:_)     = isUpper c
-isUpperStr []        = False
-
-dupsUnqual :: [Qual Var] -> [Qual Var]
-dupsUnqual = dupsBy (\ (_,v1) (_,v2) -> v1 == v2)
-
--- We remove any declarations for tcons/dcons that are in
--- the domain of the substitution. Why? Because we assume that
--- the substitution maps anything in its domain onto something
--- with a different module name from the main one. If you want
--- to substitute Main-module-defined things for Main-module-defined
--- things, you can do that before merging modules.
-finishTdefs :: [Qual Var] -> [Tdef] -> [Tdef]
-finishTdefs namesToDrop = filter isOkay
-  where isOkay (Newtype qtc qtc1 _ _) = 
-               qtc `notElem` namesToDrop 
-            && qtc1 `notElem` namesToDrop
-        isOkay (Data qtc _ cdefs) = 
-               qtc `notElem` namesToDrop 
-            && cdefsOkay cdefs
-        cdefsOkay = all cdefOkay
-        cdefOkay (Constr qdc _ _) = qdc `notElem` namesToDrop
-finishVdefs :: [Qual Var] -> [Vdefg] -> [Vdefg]
-finishVdefs namesToDrop = filterVdefgs
-  (\ (Vdef (qv,_,_)) -> qv `notElem` namesToDrop)

diff --git a/utils/ext-core/Language/Core/Overrides.hs b/utils/ext-core/Language/Core/Overrides.hs
deleted file mode 100644 (file)
index 391b129..0000000
--- a/utils/ext-core/Language/Core/Overrides.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-{-# OPTIONS -Wall #-}
-{- 
-   This module encapsulates some magic regarding overridden modules.
-
-   In the interpreter, we use "overridden" versions of certain
-   standard GHC library modules in order to avoid implementing
-   more primitives than we need to implement to run simple programs.
-   So, after typechecking but before interpretation, references to overridden
-   modules are resolved to references to modules in our simplified
-   version of the standard library.
-
-   It's kind of ugly.
--}
-module Language.Core.Overrides (override) where
-
-import Language.Core.Core
-import Language.Core.Encoding
-import Language.Core.ParsecParser
-
-import Data.Generics
-import System.FilePath
-
-override :: [Module] -> IO [Module]
-override = mapM overrideOne
-  where overrideOne :: Module -> IO Module
-        overrideOne (Module mn _ _) | mn `elem` wiredInModules =
-           findWiredInModule mn >>= (return . snd)
-        overrideOne m = return m
-
--- This function encapsulates all the business with overriden modules.
--- The story is that if an "overridden" module exists for the given
--- module, then we parse it in and rewrite all occurrences of the "base-extcore"
--- package name inside it to "base". We have to do this b/c when compiling
--- the overridden modules, we gave the package name "base-extcore", because
--- GHC gets unhappy if we try to make it part of the "base" package.
--- Was that clear? (No.)
-findWiredInModule :: AnMname -> IO (FilePath, Module)
-findWiredInModule m@(M (pn, encHier, encLeafName)) =
-   findModuleIO (Just munged) (wiredInFileName m)
-     where hier = map zDecodeString encHier
-           leafName = zDecodeString encLeafName
-           munged = 
-             M (pn, map (\ p -> if p == "GHC_ExtCore" then "GHC" else p) hier,
-                 leafName)
-
-
-wiredInModules :: [AnMname]
-wiredInModules =
-  map (\ m -> (mkBaseMname m)) ["Handle", "IO", "Unicode"]
-
-wiredInFileName :: AnMname -> FilePath
-wiredInFileName (M (_,_,leafName)) =
-  "./lib/GHC_ExtCore/" </> leafName `addExtension` "hcr"
-
-
-mungePackageName :: Module -> Module
--- for now: just substitute "base-extcore" for "base"
--- and "GHC" for "GHC_ExtCore" in every module name
-mungePackageName m@(Module _ _ _) = everywhere (mkT mungeMname)
-    (everywhere (mkT mungePname) 
-       (everywhere (mkT mungeVarName) m))
-  where mungePname (P s) | s == zEncodeString overriddenPname =
-           (P "base")
-        mungePname p = p
-{- TODO: Commented out because this code should eventually
-   be completely rewritten. No time to do it now.
-        -- rewrite uses of fake primops
-        mungeVarName (Var (Just mn', v))
-          | mn' == mn && v `elem` (fst (unzip newPrimVars)) =
-            Var (Just primMname, v)
--}
-        mungeVarName :: Exp -> Exp
-        mungeVarName e = e
-
-mungeMname :: AnMname -> AnMname
-mungeMname (M (pname, (hd:rest), leaf)) 
-  | zDecodeString hd == "GHC_ExtCore" =
-          (M (pname, ("GHC":rest), leaf))
-mungeMname mn = mn
-
-overriddenPname :: String
-overriddenPname = "base-extcore"
-
-
-findModuleIO :: Mname -> FilePath -> IO (FilePath, Module)
-findModuleIO trueName fp = do
-   res <- parseCore fp
-   case res of
-     Left _   -> error ("findModule: error parsing dependency " ++ fp)
-     Right parsedMod -> do
-              let resultMod@(Module _ _ _) = 
-                      case trueName of
-                        Just _ -> mungePackageName parsedMod
-                        Nothing -> parsedMod
-              return (fp, resultMod)
-

diff --git a/utils/ext-core/Language/Core/ParseGlue.hs b/utils/ext-core/Language/Core/ParseGlue.hs
deleted file mode 100644 (file)
index 3743792..0000000
--- a/utils/ext-core/Language/Core/ParseGlue.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module Language.Core.ParseGlue where
-
-import Encoding
-
-import Data.List
-
-data ParseResult a = OkP a | FailP String
-type P a = String -> Int -> ParseResult a
-
-instance Show a => Show (ParseResult a)
-  where show (OkP r) = show r
-        show (FailP s) = s
-
-thenP :: P a -> (a -> P b) -> P b
-m `thenP`  k = \ s l -> 
-  case m s l of 
-    OkP a -> k a s l
-    FailP s -> FailP s
-
-returnP :: a -> P a
-returnP m _ _ = OkP m
-
-failP :: String -> P a
-failP s s' _ = FailP (s ++ ":" ++ s')
-
-data Token =
-   TKmodule 
- | TKdata 
- | TKnewtype 
- | TKforall 
- | TKrec 
- | TKlet 
- | TKin 
- | TKcase 
- | TKof 
- | TKcast
- | TKnote 
- | TKexternal
- | TKwild
- | TKoparen 
- | TKcparen 
- | TKobrace
- | TKcbrace
- | TKhash
- | TKeq 
- | TKcoloncolon 
- | TKstar 
- | TKrarrow 
- | TKlambda
- | TKbiglambda
- | TKat 
- | TKdot
- | TKcolon
- | TKquestion
- | TKsemicolon
- | TKname String 
- | TKcname String
- | TKinteger Integer 
- | TKrational Rational
- | TKstring String 
- | TKchar Char 
- | TKEOF

diff --git a/utils/ext-core/Language/Core/ParsecParser.hs b/utils/ext-core/Language/Core/ParsecParser.hs
deleted file mode 100644 (file)
index ff2333c..0000000
--- a/utils/ext-core/Language/Core/ParsecParser.hs
+++ /dev/null
@@ -1,580 +0,0 @@
-{-# OPTIONS -Wall -fno-warn-missing-signatures #-}
-
-module Language.Core.ParsecParser (parseCore, coreModuleName, coreTcon, 
-  coreQualifiedGen, upperName, identifier, coreType, coreKind,
-  coreTbinds, parens, braces, topVbind) where
-
-import Language.Core.Core
-import Language.Core.Check
-import Language.Core.Encoding
-import Language.Core.PrimCoercions
-
-import Text.ParserCombinators.Parsec
-import qualified Text.ParserCombinators.Parsec.Token as P
-import Text.ParserCombinators.Parsec.Language
-import Data.Char
-import Data.List
-import Data.Ratio
-
-parseCore :: FilePath -> IO (Either ParseError Module)
-parseCore = parseFromFile coreModule
-
-coreModule :: Parser Module
-coreModule = do
-   whiteSpace
-   reserved "module"
-   mName      <- coreModuleName
-   whiteSpace
-   tdefs      <- option [] coreTdefs
-   vdefGroups <- coreVdefGroups
-   eof
-   return $ Module mName tdefs vdefGroups
-
-coreModuleName :: Parser AnMname
-coreModuleName = do
-   pkgName      <- corePackageName
-   char ':'
-   (modHierarchy,baseName) <- coreHierModuleNames
-   return $ M (pkgName, modHierarchy, baseName)
-
-corePackageName :: Parser Pname
--- Package names can be lowercase or uppercase!
-corePackageName = (identifier <|> upperName) >>= (return . P)
-
-coreHierModuleNames :: Parser ([Id], Id)
-coreHierModuleNames = do
-   parentName <- upperName
-   return $ splitModuleName parentName
-
-upperName :: Parser Id
-upperName = do
-   firstChar <- upper
-   rest <- many (identLetter extCoreDef)
-   return $ firstChar:rest
-
-coreTdefs :: Parser [Tdef]
-coreTdefs = many coreTdef 
-
-coreTdef :: Parser Tdef
-coreTdef = withSemi (try (try coreDataDecl <|> try coreNewtypeDecl))
-            
-
-withSemi p = try p `withTerminator` ";"
-
-withTerminator p term = do
-   x <- try p
-   try $ symbol term
-   return x
-
-coreDataDecl :: Parser Tdef
-coreDataDecl = do
-  reserved "data"
-  tyCon  <- coreQualifiedCon
-  whiteSpace -- important
-  tBinds <- coreTbinds
-  whiteSpace
-  symbol "="
-  whiteSpace
-  cDefs  <- braces coreCdefs
-  return $ Data tyCon tBinds cDefs
-
-coreNewtypeDecl :: Parser Tdef
-coreNewtypeDecl = do
-  reserved "newtype"
-  tyCon  <- coreQualifiedCon
-  whiteSpace
-  coercionName <- coreQualifiedCon
-  whiteSpace
-  tBinds <- coreTbinds
-  tyRep  <- try coreTRep
-  return $ Newtype tyCon coercionName tBinds tyRep
-
-coreQualifiedCon :: Parser (Mname, Id)
-coreQualifiedCon = coreQualifiedGen upperName
- 
-coreQualifiedName = coreQualifiedGen identifier
-
-coreQualifiedGen :: Parser String -> Parser (Mname, Id) 
-coreQualifiedGen p = (try (do
-  packageIdOrVarName <- corePackageName
-  maybeRest <- optionMaybe (char ':' >> coreHierModuleNames)
-  case maybeRest of
-               -- unqualified id, so backtrack
-    Nothing -> pzero
-               -- qualified name, so look for the id part
-    Just (modHierarchy, baseName) -> do
-               char '.'
-               theId <- p
-               return
-                 (Just $ M (packageIdOrVarName, modHierarchy, baseName),
-                  theId))) <|> 
-   -- unqualified name
-   (p >>= (\ res -> return (Nothing, res)))
-
-coreTbinds :: Parser [Tbind]
-coreTbinds = many coreTbind 
-
-coreTbindsGen :: CharParser () String -> Parser [Tbind]
--- The "try" here is important. Otherwise, when parsing:
--- "Node (^base:DataziTuple.Z3T)" (a cdef), we commit to
--- parsing (^base...) as a tbind rather than a type.
-coreTbindsGen separator = many (try $ coreTbindGen separator)
-
-coreTbind :: Parser Tbind
-coreTbind = coreTbindGen whiteSpace
-
-coreTbindGen :: CharParser () a -> Parser Tbind
-coreTbindGen sep = (parens (do
-                     sep
-                     tyVar <- identifier
-                     kind <- symbol "::" >> coreKind
-                     return (tyVar, kind))) <|>
-                    (sep >> identifier >>= (return . (\ tv -> (tv,Klifted))))
-
-coreCdefs :: Parser [Cdef]
-coreCdefs = sepBy coreCdef (symbol ";")
-
-coreCdef :: Parser Cdef
-coreCdef = do
-  dataConName <- coreQualifiedCon
-  whiteSpace -- important!
-  tBinds      <- try $ coreTbindsGen (symbol "@")
-  -- This should be equivalent to (many coreAty)
-  -- But it isn't. WHY??
-  tys         <- sepBy coreAtySaturated whiteSpace
-  return $ Constr dataConName tBinds tys
-
-coreTRep :: Parser Ty
--- note that the "=" is inside here since if there's
--- no rhs for the newtype, there's no "="
-coreTRep = symbol "=" >> try coreType
-
-coreType :: Parser Ty
-coreType = coreForallTy <|> (do
-             hd <- coreBty
-             -- whiteSpace is important!
-             whiteSpace
-             -- This says: If there is at least one ("-> ty"..) thing,
-             -- use it. If not, don't consume any input.
-             maybeRest <- option [] (many1 (symbol "->" >> coreType))
-             return $ case maybeRest of
-                         [] -> hd
-                         stuff -> foldl Tapp (Tcon tcArrow) (hd:stuff))
-
-coreBty :: Parser Ty
-coreBty = do
-  hd <- coreAty
-                         -- The "try" is necessary:
-                         -- otherwise, parsing "T " fails rather
-                         -- than returning "T".
-  maybeRest <- option [] (many1 (try (whiteSpace >> coreAtySaturated)))
-  return $ (case hd of
-             -- so I'm not sure I like this... it's basically doing
-             -- typechecking (kind-checking?) in the parser.
-             -- However, the type syntax as defined in Core.hs sort of
-             -- forces it.
-             ATy t     -> foldl Tapp t maybeRest
-             Trans k   -> app k 2 maybeRest "trans"
-             Sym k     -> app k 1 maybeRest "sym"
-             Unsafe k  -> app k 2 maybeRest "unsafe"
-             LeftCo k  -> app k 1 maybeRest "left"
-             RightCo k -> app k 1 maybeRest "right"
-             InstCo k  -> app k 2 maybeRest "inst")
-                 where app k arity args _ | length args == arity = k args
-                       app _ _ args err = 
-                           primCoercionError (err ++ 
-                             ("Args were: " ++ show args))
-
-coreAtySaturated :: Parser Ty
-coreAtySaturated = do
-   t <- coreAty
-   case t of
-     ATy ty -> return ty
-     _     -> unexpected "coercion ty"
-
-coreAty :: Parser ATyOp
-coreAty = try coreTcon <|> ((try coreTvar <|> parens coreType)
-                             >>= return . ATy)
-coreTvar :: Parser Ty
-coreTvar = try identifier >>= (return . Tvar)
-
-coreTcon :: Parser ATyOp
--- TODO: Change the grammar
--- A Tcon can be an uppercase type constructor
--- or a lowercase (always qualified) coercion variable
-coreTcon =  
-         -- Special case is first so that (CoUnsafe .. ..) gets parsed as
-         -- a prim. coercion app and not a Tcon app.
-         -- But the whole thing is so bogus.
-        try (do
-                                    -- the "try"s are crucial; they force
-                                    -- backtracking
-           maybeCoercion <- choice [try symCo, try transCo, try unsafeCo,
-                                    try instCo, try leftCo, rightCo]
-           return $ case maybeCoercion of
-              TransC  -> Trans (\ [x,y] -> TransCoercion x y)
-              SymC    -> Sym (\ [x] -> SymCoercion x)
-              UnsafeC -> Unsafe (\ [x,y] -> UnsafeCoercion x y)
-              LeftC   -> LeftCo (\ [x] -> LeftCoercion x)
-              RightC  -> RightCo (\ [x] -> RightCoercion x)
-              InstC   -> InstCo (\ [x,y] -> InstCoercion x y))
-    <|> (coreQualifiedCon >>= (return . ATy . Tcon))
-
-data CoercionTy = TransC | InstC | SymC | UnsafeC | LeftC | RightC
-
-symCo, transCo, unsafeCo, instCo, leftCo, rightCo :: Parser CoercionTy
-symCo    = string "%sym"    >> return SymC
-transCo  = string "%trans"  >> return TransC
-unsafeCo = string "%unsafe" >> return UnsafeC
-leftCo   = string "%left"   >> return LeftC
-rightCo  = string "%right"  >> return RightC
-instCo   = string "%inst"   >> return InstC
-
-coreForallTy :: Parser Ty
-coreForallTy = do
-  reserved "forall"
-  tBinds <- many1 coreTbind
-  symbol "."
-  bodyTy <- coreType
-  return $ foldr Tforall bodyTy tBinds
-
--- TODO: similar to coreType. should refactor
-coreKind :: Parser Kind
-coreKind = do
-  hd <- coreAtomicKind 
-  maybeRest <- option [] (many1 (symbol "->" >> coreKind))
-  return $ foldl Karrow hd maybeRest
-
-coreAtomicKind = try liftedKind <|> try unliftedKind 
-       <|> try openKind <|> try (do
-                    (from,to) <- parens equalityKind
-                    return $ Keq from to)
-       <|> try (parens coreKind)
-
-liftedKind = do
-  symbol "*"
-  return Klifted
-
-unliftedKind = do
-  symbol "#"
-  return Kunlifted
-
-openKind = do
-  symbol "?"
-  return Kopen
-
-equalityKind = do
-  ty1 <- coreBty
-  symbol ":=:"
-  ty2 <- coreBty
-  return (ty1, ty2)
-
--- Only used internally within the parser:
--- represents either a Tcon, or a continuation
--- for a primitive coercion
-data ATyOp = 
-   ATy Ty
- | Trans ([Ty] -> Ty)
- | Sym ([Ty] -> Ty)
- | Unsafe ([Ty] -> Ty)
- | LeftCo ([Ty] -> Ty)
- | RightCo ([Ty] -> Ty)
- | InstCo ([Ty] -> Ty)
-
-coreVdefGroups :: Parser [Vdefg]
-coreVdefGroups = option [] (do
-  theFirstVdef <- coreVdefg
-  symbol ";"
-  others <- coreVdefGroups
-  return $ theFirstVdef:others)
-
-coreVdefg :: Parser Vdefg
-coreVdefg = coreRecVdef <|> coreNonrecVdef
-
-coreRecVdef = do
-  reserved "rec"
-  braces (sepBy1 coreVdef (symbol ";")) >>= (return . Rec)
-
-coreNonrecVdef = coreVdef >>= (return . Nonrec)
-
-coreVdef = do
-  (vdefLhs, vdefTy) <- try topVbind <|> (do
-                        (v, ty) <- lambdaBind
-                        return (unqual v, ty))
-  whiteSpace
-  symbol "="
-  whiteSpace
-  vdefRhs  <- coreFullExp
-  return $ Vdef (vdefLhs, vdefTy, vdefRhs) 
-
-coreAtomicExp :: Parser Exp
-coreAtomicExp = do
--- For stupid reasons, the whiteSpace is necessary.
--- Without it, (pt coreAppExp "w a:B.C ") doesn't work.
-  whiteSpace
-  res <- choice [try coreDconOrVar,
-                    try coreLit,
-                    parens coreFullExp ]
-  whiteSpace
-  return res
-
-coreFullExp = (choice [coreLam, coreLet,
-  coreCase, coreCast, coreNote, coreExternal, coreLabel]) <|> (try coreAppExp)
--- The "try" is necessary so that we backtrack
--- when we see a var (that is not an app)
-    <|> coreAtomicExp
-
-coreAppExp = do
--- notes:
--- it's important to have a separate coreAtomicExp (that any app exp
--- begins with) and to define the args in terms of many1.
--- previously, coreAppExp could parse either an atomic exp (an app with
--- 0 arguments) or an app with >= 1 arguments, but that led to ambiguity.
-    oper <- try coreAtomicExp
-    whiteSpace
-    args <- many1 (whiteSpace >> ((coreAtomicExp >>= (return . Left)) <|>
-             -- note this MUST be coreAty, not coreType, because otherwise:
-             -- "A @ B c" gets parsed as "A @ (B c)"
-             ((symbol "@" >> coreAtySaturated) >>= (return . Right))))
-    return $ foldl (\ op ->
-                     either (App op) (Appt op)) oper args
-
-coreDconOrVar = do
-  theThing <- coreQualifiedGen (try upperName <|> identifier)
-  return $ case theThing of
-    -- note that data constructors must be qualified
-    (Just _, idItself) | isUpper (head idItself)
-      -> Dcon theThing
-    _ -> Var theThing
-
-coreLit :: Parser Exp
-coreLit = parens (coreLiteral >>= (return . Lit))
-
-coreLiteral :: Parser Lit
-coreLiteral = do
-  l <- try aLit
-  symbol "::"
-  t <- coreType
-  return $ Literal l t
-
-coreLam = do
-  symbol "\\"
-  binds <- coreLambdaBinds
-  symbol "->"
-  body <- coreFullExp
-  return $ foldr Lam body binds
-coreLet = do
-  reserved "let"
-  vdefg <- coreVdefg
-  whiteSpace
-  reserved "in"
-  body <- coreFullExp
-  return $ Let vdefg body 
-coreCase = do
-  reserved "case"
-  ty <- coreAtySaturated
-  scrut <- coreAtomicExp
-  reserved "of"
-  vBind <- parens lambdaBind
-  alts <- coreAlts
-  return $ Case scrut vBind ty alts
-coreCast = do
-  reserved "cast"
-  whiteSpace
--- The parens are CRUCIAL, o/w it's ambiguous
-  body <- try (parens coreFullExp)
-  whiteSpace
-  ty <- try coreAtySaturated
-  return $ Cast body ty
-coreNote = do
-  reserved "note"
-  s <- stringLiteral
-  e <- coreFullExp
-  return $ Note s e
-coreExternal = (do
-  reserved "external"
-  -- TODO: This isn't in the grammar, but GHC
-  -- always prints "external ccall". investigate...
-  symbol "ccall"
-  s <- stringLiteral
-  t <- coreAtySaturated
-  return $ External s t) <|>
-    -- TODO: I don't really understand what this does
-                (do
-    reserved "dynexternal"
-    symbol "ccall"
-    t <- coreAtySaturated
-    return $ External "[dynamic]" t)
-coreLabel = do
--- TODO: Totally punting this, but it needs to go in the grammar
--- or not at all
-  reserved "label"
-  s <- stringLiteral
-  return $ External s tAddrzh
-
-coreLambdaBinds = many1 coreBind
-
-coreBind = coreTbinding <|> coreVbind
-
-coreTbinding = try coreAtTbind >>= (return . Tb)
-coreVbind = parens (lambdaBind >>= (return . Vb))
-
-coreAtTbind = (symbol "@") >> coreTbind
-
-topVbind :: Parser (Qual Var, Ty)
-topVbind   = aCoreVbind coreQualifiedName
-lambdaBind :: Parser (Var, Ty)
-lambdaBind = aCoreVbind identifier
-
-aCoreVbind idP =  do
-  nm <- idP
-  symbol "::"
-  t <- coreType
-  return (nm, t)
-
-
-aLit :: Parser CoreLit
-aLit = intOrRatLit <|> charLit <|> stringLit
-
-intOrRatLit :: Parser CoreLit
-intOrRatLit = do
- -- Int and lit combined into one to avoid ambiguity.
- -- Argh....
-  lhs <- intLit
-  maybeRhs <- optionMaybe (symbol "%" >> anIntLit)
-  case maybeRhs of
-    Nothing  -> return $ Lint lhs
-    Just rhs -> return $ Lrational (lhs % rhs)
-
-intLit :: Parser Integer
-intLit = anIntLit <|> parens anIntLit
-
-anIntLit :: Parser Integer
-anIntLit = do
-  sign <- option 1 (symbol "-" >> return (-1)) 
-  n <- natural
-  return (sign * n)
-
-charLit :: Parser CoreLit
-charLit = charLiteral >>= (return . Lchar)
- -- make sure this is right
-   
-stringLit :: Parser CoreLit
-stringLit = stringLiteral >>= (return . Lstring)
- -- make sure this is right
-
-coreAlts :: Parser [Alt]
-coreAlts = braces $ sepBy1 coreAlt (symbol ";")
-
-coreAlt :: Parser Alt
-coreAlt = conAlt <|> litAlt <|> defaultAlt
-
-conAlt :: Parser Alt
-conAlt = do
-  conName <- coreQualifiedCon
-  whiteSpace
-  (tBinds, vBinds) <- caseVarBinds
-  try (symbol "->")
-  rhs     <- try coreFullExp
-  return $ Acon conName tBinds vBinds rhs
-
-caseVarBinds :: Parser ([Tbind], [Vbind])
-caseVarBinds = do
-     maybeFirstTbind <- optionMaybe coreAtTbind
-     case maybeFirstTbind of
-        Just tb -> do
-           (tbs,vbs) <- caseVarBinds
-           return (tb:tbs, vbs)
-        Nothing -> do
-           vbs <- many (parens lambdaBind)
-           return ([], vbs)
-
-litAlt :: Parser Alt
-litAlt = do
-  l <- parens coreLiteral
-  symbol "->"
-  rhs <- coreFullExp
-  return $ Alit l rhs
-
-defaultAlt :: Parser Alt
-defaultAlt = do
-  reserved "_"
-  symbol "->"
-  rhs <- coreFullExp
-  return $ Adefault rhs
-----------------
--- ugh
-splitModuleName mn = 
-   let decoded = zDecodeString mn
-       -- Triple ugh.
-       -- We re-encode the individual parts so that:
-       -- main:Foo_Bar.Quux.baz
-       -- prints as:
-       -- main:FoozuBarziQuux.baz
-       -- and not:
-       -- main:Foo_BarziQuux.baz
-       parts   = map zEncodeString $ filter (notElem '.') $ groupBy 
-                   (\ c1 c2 -> c1 /= '.' && c2 /= '.') 
-                 decoded in
-     (take (length parts - 1) parts, last parts)
-----------------
-extCore = P.makeTokenParser extCoreDef
-
-parens          = P.parens extCore    
-braces          = P.braces extCore    
--- newlines are allowed anywhere
-whiteSpace      = P.whiteSpace extCore <|> (newline >> return ())
-symbol          = P.symbol extCore    
-identifier      = P.identifier extCore    
--- Keywords all begin with '%'
-reserved  s     = P.reserved extCore ('%':s) 
-natural         = P.natural extCore    
-charLiteral     = P.charLiteral extCore    
-stringLiteral   = P.stringLiteral extCore    
-
--- dodgy since Core doesn't really allow comments,
--- but we'll pretend...
-extCoreDef = LanguageDef { 
-      commentStart    = "{-"
-    , commentEnd      = "-}"
-    , commentLine     = "--"
-    , nestedComments  = True
-    , identStart      = lower
-    , identLetter     = lower <|> upper <|> digit <|> (char '\'')
-    , opStart         = opLetter extCoreDef
-    , opLetter        = oneOf ";=@:\\%_.*#?%"
-    , reservedNames   = map ('%' :)
-                          ["module", "data", "newtype", "rec",
-                           "let", "in", "case", "of", "cast",
-                           "note", "external", "forall"]
-    , reservedOpNames = [";", "=", "@", "::", "\\", "%_",
-                          ".", "*", "#", "?"]
-    , caseSensitive   = True
-    }       
-
-{-
--- Stuff to help with testing in ghci.
-pTest (Left a) = error (show a)
-pTest (Right t) = print t
-
-pTest1 :: Show a => CharParser () a -> String -> IO ()
-pTest1 pr s = do
-  let res = parse pr "" s
-  pTest res
-
-pt :: Show a => CharParser () a -> String -> IO ()
-pt pr s = do
-  x <- parseTest pr s
-  print x
-
-try_ = try
-many_ = many
-option_ = option
-many1_ = many1
-il = identLetter
-
-andThenSym a b = do
-  p <- a
-  symbol b
-  return p
--}
\ No newline at end of file

diff --git a/utils/ext-core/Language/Core/Prep.hs b/utils/ext-core/Language/Core/Prep.hs
deleted file mode 100644 (file)
index 1ce8fda..0000000
--- a/utils/ext-core/Language/Core/Prep.hs
+++ /dev/null
@@ -1,239 +0,0 @@
-{-# OPTIONS -fno-warn-name-shadowing #-}
-{-
-Preprocess a module to normalize it in the following ways:
-       (1) Saturate all constructor and primop applications. 
-              (as well as external calls; this is probably already
-               guaranteed, but paranoia is good)
-       (2) Arrange that any non-trivial expression of unlifted kind ('#')
-             is turned into the scrutinee of a Case.
-After these preprocessing steps, Core can be interpreted (or given an operational semantics)
-      ignoring type information almost completely.
--}
-
-
-module Language.Core.Prep where
-
---import Debug.Trace
-
-import Control.Monad.State
-import Data.Either
-import Data.List
-import Data.Generics
-import qualified Data.Map as M
-
-import Language.Core.Core
-import Language.Core.CoreUtils
-import Language.Core.Env
-import Language.Core.Check
-import Language.Core.Environments
-import Language.Core.Utils
-
-prepModule :: Menv -> Module -> Module
-prepModule globalEnv (Module mn tdefs vdefgs) = 
-    Module mn tdefs (snd (evalState 
-      (foldM prepTopVdefg (eempty,[]) vdefgs) initCounter))
-  where
-    (tcenv, cenv) = mkTypeEnvsNoChecking tdefs
-
-    prepTopVdefg :: (Venv, [Vdefg]) -> Vdefg -> PrepM (Venv, [Vdefg])
-    prepTopVdefg (venv,vdefgs) vdefg = do
-         (venv',vdefg') <- prepVdefg (venv,eempty) vdefg
-         return (venv',vdefgs ++ [vdefg'])
- 
-    prepVdefg (env@(venv,_)) (Nonrec(Vdef((Nothing,x),t,e))) = do
-        e' <- prepExp env e
-       return (eextend venv (x,t), Nonrec(Vdef((Nothing,x),t,e')))
-    prepVdefg (env@(venv,_))  (Nonrec(Vdef(qx,t,e))) = do
-        e' <- prepExp env e
-       return (venv, Nonrec(Vdef(qx,t,e')))
-    prepVdefg (venv,tvenv) (Rec vdefs) = do
-        vds' <- mapM (\ (Vdef (qx,t,e)) -> do
-                         e' <- prepExp (venv',tvenv) e
-                         return (Vdef (qx,t,e'))) vdefs
-       return (venv', Rec vds')
-       where venv' = foldl' eextend venv [(x,t) | Vdef((Nothing,x),t,_) <- vdefs]
-
-    prepExp :: (Venv, Tvenv) -> Exp -> PrepM Exp
-    prepExp _ (Var qv) = return $ Var qv
-    prepExp _ (Dcon qdc) = return $ Dcon qdc
-    prepExp _ (Lit l) = return $ Lit l
-    prepExp env e@(App _ _) = unwindApp env e []
-    prepExp env e@(Appt _ _) = unwindApp env e []
-    prepExp (venv,tvenv) (Lam (Vb vb) e) = do
-       e' <- prepExp (eextend venv vb,tvenv) e             
-       return $ Lam (Vb vb) e' 
-    prepExp (venv,tvenv) (Lam (Tb tb) e) = do
-       e' <- prepExp (venv,eextend tvenv tb) e
-       return $ Lam (Tb tb) e' 
-    prepExp env@(venv,tvenv) (Let (Nonrec(Vdef((Nothing,x),t,b))) e) 
-        | (kindOfTy tvenv t `eqKind` Kunlifted && suspends b) = do 
-            -- There are two places where we call the typechecker, one of them
-            -- here.
-            -- We need to know the type of the let body in order to construct
-            -- a case expression. 
-                                -- need to extend the env with the let-bound var too!
-            scrut' <- prepExp env b
-            rhs' <- prepExp (eextend venv (x,t),tvenv) e
-            return $
-              let eTy = typeOfExp (eextend venv (x, t)) tvenv e in
-                Case scrut' (x,t) eTy [Adefault rhs'] 
-    prepExp (venv,tvenv) (Let vdefg e) =  do
-      (venv',vdefg') <- prepVdefg (venv,tvenv) vdefg
-      rhs' <- prepExp (venv',tvenv) e
-      return $ Let vdefg' rhs'
-    prepExp env@(venv,tvenv) (Case e vb t alts) = do
-      e' <- prepExp env e
-      alts' <- mapM (prepAlt (eextend venv vb,tvenv)) alts
-      return $ Case e' vb t alts'
-    prepExp env (Cast e t) = do
-      e' <- prepExp env e
-      return $ Cast e' t
-    prepExp env (Note s e) = do
-      e' <- prepExp env e
-      return $ Note s e'
-    prepExp _ (External s t) = return $ External s t
-
-    prepAlt :: (Venv,Tvenv) -> Alt -> PrepM Alt
-    prepAlt (venv,tvenv) (Acon qdc tbs vbs e) = do
-      rhs' <- prepExp (foldl' eextend venv vbs,foldl' eextend tvenv tbs) e
-      return $ Acon qdc tbs vbs rhs'
-    prepAlt env (Alit l e) = (liftM (Alit l)) (prepExp env e)
-    prepAlt env (Adefault e) = (liftM Adefault) (prepExp env e)
-
-    unwindApp :: (Venv, Tvenv) -> Exp -> [Either Exp Ty] -> PrepM Exp
-    unwindApp env (App e1 e2) as = unwindApp env e1 (Left e2:as)
-    unwindApp env (Appt e t) as  = unwindApp env e (Right t:as)
-    unwindApp env (op@(Dcon qdc)) as = do
-        e' <- rewindApp env op as
-        -- possibly dubious to assume no type args
-        etaExpand [] (drop n atys) e'
-        where (tbs,atys0,_) = splitTy (qlookup cenv_ eempty qdc)
-             atys = map (substl (map fst tbs) ts) atys0
-             ts = [t | Right t <- as]
-              n = length [e | Left e <- as]
-    unwindApp env (op@(Var qv)) as | isPrimVar qv = do
-        e' <- rewindApp env op as
-        etaExpand [] [] e'
-    unwindApp env (op@(External _ t)) as = do
-        e' <- rewindApp env op as
-        etaExpand [] (drop n atys) e'
-          where (_,atys,_) = splitTy t
-                n = length as -- assumes all args are term args
-    unwindApp env op as = rewindApp env op as
-
-
-    etaExpand :: [Kind] -> [Ty] -> Exp -> PrepM Exp
-    etaExpand ks ts e = do
-         -- what a pain
-         tyvs <- replicateM (length ks) freshVar
-         termvs <- replicateM (length ts) freshVar
-         let tyArgs   = zip tyvs ks
-         let termArgs = zip termvs ts
-         return $
-          foldr (\ (t1,k1) e -> Lam (Tb (t1,k1)) e)
-          (foldr (\ (v,t) e -> Lam (Vb (v,t)) e)
-              (foldl' (\ e (v,_) -> App e (Var (unqual v)))
-                 (foldl' (\ e (tv,_) -> Appt e (Tvar tv))
-                   e tyArgs)
-              termArgs) termArgs)
-           tyArgs
-
-    rewindApp :: (Venv, Tvenv) -> Exp -> [Either Exp Ty] -> PrepM Exp
-    rewindApp _ e [] = return e
-    rewindApp env@(venv,tvenv) e1 (Left e2:as) | kindOfTy tvenv t `eqKind` Kunlifted && suspends e2 = do
-        v <- freshVar
-        let venv' = eextend venv (v,t)
-        rhs <- rewindApp (venv', tvenv) (App e1 (Var (unqual v))) as
-        newScrut <- prepExp env e2
-       -- This is the other place where we call the typechecker.
-        return $ Case newScrut (v,t) (typeOfExp venv' tvenv rhs) [Adefault rhs]
-        where t = typeOfExp venv tvenv e2
-    rewindApp env e1 (Left e2:as) = do
-      e2' <- prepExp env e2
-      rewindApp env (App e1 e2') as
-    rewindApp env e (Right t:as) = rewindApp env (Appt e t) as
-
-    typeOfExp :: Venv -> Tvenv -> Exp -> Ty
-    typeOfExp = checkExpr mn globalEnv tcenv cenv
-
-    kindOfTy :: Tvenv -> Ty -> Kind
-    kindOfTy tvenv = checkType mn globalEnv tcenv tvenv
-
-    {- Return false for those expressions for which Interp.suspendExp builds a thunk. -}
-    suspends (Var _) = False
-    suspends (Lit _) = False
-    suspends (Lam (Vb _) _) = False
-    suspends (Lam _ e) = suspends e
-    suspends (Appt e _) = suspends e
-    suspends (Cast e _) = suspends e
-    suspends (Note _ e) = suspends e
-    suspends (External _ _) = False
-    suspends _ = True
-
-    mlookup :: (Envs -> Env a b) -> Env a b -> Mname -> Env a b
-    mlookup _ local_env Nothing = local_env
-    mlookup selector _  (Just m) =   
-      case elookup globalEnv m of
-        Just env -> selector env
-        Nothing -> error ("Prep: undefined module name: " ++ show m)
-
-    qlookup ::  (Ord a, Show a) => (Envs -> Env a b) -> Env a b -> (Mname,a) -> b
-    qlookup selector local_env (m,k) =   
-      case elookup (mlookup selector local_env m) k of
-        Just v -> v
-        Nothing -> error ("undefined identifier: " ++ show k)
-
-boundVars :: Exp -> [Id]
-boundVars (Lam (Vb (v,_)) e) = [v] `union` boundVars e
-boundVars (Lam _ e) = boundVars e
-boundVars (Let vds e) = (boundVarsVdefs vds) `union` boundVars e
-boundVars (Case scrut (v,_) _ alts) = 
-   [v] `union` (boundVars scrut) `union` boundVarsAlts alts
-boundVars (Cast e _) = boundVars e
-boundVars (Note _ e) = boundVars e
-boundVars (App e1 e2) = boundVars e1 `union` boundVars e2
-boundVars (Appt e _) = boundVars e
-boundVars _ = []
-
-boundVarsVdefs :: Vdefg -> [Id]
-boundVarsVdefs (Rec vds) = nub (concatMap boundVarsVdef vds)
-boundVarsVdefs (Nonrec vd) = boundVarsVdef vd
-
-boundVarsVdef :: Vdef -> [Id]
-boundVarsVdef (Vdef ((_,v),_,e)) = [v] `union` boundVars e
-
-boundVarsAlts :: [Alt] -> [Var]
-boundVarsAlts as = nub (concatMap boundVarsAlt as)
-
-boundVarsAlt :: Alt -> [Var]
-boundVarsAlt (Acon _ _ vbs e) = (map fst vbs) `union` (boundVars e)
-boundVarsAlt (Alit _ e) = boundVars e
-boundVarsAlt (Adefault e) = boundVars e
-
-substNewtys :: NtEnv -> Ty -> Ty
-substNewtys ntEnv = everywhere'Except (mkT go)
-                 where go t | Just ((_,tc),args) <- splitTyConApp_maybe t =
-                         case M.lookup tc ntEnv of
-                           Just d -> -- trace ("applying newtype: " ++ show t) $
-                                       (snd (applyNewtype d args))
-                           Nothing  -> t
-                       go t = t
-
-newtypeCoercion_maybe :: NtEnv -> Ty -> Maybe CoercionKind
-newtypeCoercion_maybe ntEnv t | Just ((_,tc),_) <- splitTyConApp_maybe t =
-  M.lookup tc ntEnv
-newtypeCoercion_maybe _ _ = Nothing
-
-mkTapp :: Ty -> [Ty] -> Ty
-mkTapp = foldl Tapp
-
-initCounter :: Int
-initCounter = 0
-
-type PrepM = State Int
-
-freshVar :: PrepM String
-freshVar = do
-  i <- get
-  put (i+1)
-  return $ ("zd" ++ show i)

diff --git a/utils/ext-core/Language/Core/PrimCoercions.hs b/utils/ext-core/Language/Core/PrimCoercions.hs
deleted file mode 100644 (file)
index e6851d8..0000000
--- a/utils/ext-core/Language/Core/PrimCoercions.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# OPTIONS -Wall -fno-warn-missing-signatures #-}
-module Language.Core.PrimCoercions where
-import Language.Core.Core
-
--- Stuff the parser needs to know about
-
-pv :: a -> Qual a
-pv = qual primMname
-
-pvz :: Id -> Qual Id
-pvz = (qual primMname) . (++ "zh")
-
-{- Coercions -}
-symCoercion, transCoercion, unsafeCoercion,
- leftCoercion, rightCoercion, instCoercion :: Qual Tcon
-symCoercion    = pv "sym"
-transCoercion  = pv "trans"
-unsafeCoercion = pv "CoUnsafe"
-leftCoercion   = pv "left"
-rightCoercion  = pv "right"
-instCoercion   = pv "inst"
-
-{- Addrzh -}
-tcAddrzh = pvz "Addr"
-tAddrzh = Tcon tcAddrzh
-ktAddrzh = Kunlifted

diff --git a/utils/ext-core/Language/Core/PrimEnv.hs b/utils/ext-core/Language/Core/PrimEnv.hs
deleted file mode 100644 (file)
index a7c1f1b..0000000
--- a/utils/ext-core/Language/Core/PrimEnv.hs
+++ /dev/null
@@ -1,373 +0,0 @@
------------------------------------------------------------------------
--- This module is automatically generated by the GHC utility
--- "genprimopcode". Do not edit!
------------------------------------------------------------------------
-module Language.Core.PrimEnv(primTcs, primVals, intLitTypes, ratLitTypes,
- charLitTypes, stringLitTypes) where
-import Language.Core.Core
-import Language.Core.Encoding
-
-primTcs :: [(Tcon, Kind)]
-primTcs = [
-      (zEncodeString "Char#", Kunlifted),
-      (zEncodeString "Int#", Kunlifted),
-      (zEncodeString "Word#", Kunlifted),
-      (zEncodeString "Int64#", Kunlifted),
-      (zEncodeString "Word64#", Kunlifted),
-      (zEncodeString "Double#", Kunlifted),
-      (zEncodeString "Float#", Kunlifted),
-      (zEncodeString "Array#", (Karrow Klifted Kunlifted)),
-      (zEncodeString "MutableArray#", (Karrow Klifted (Karrow Klifted Kunlifted))),
-      (zEncodeString "ByteArray#", Kunlifted),
-      (zEncodeString "MutableByteArray#", (Karrow Klifted Kunlifted)),
-      (zEncodeString "Addr#", Kunlifted),
-      (zEncodeString "MutVar#", (Karrow Klifted (Karrow Klifted Kunlifted))),
-      (zEncodeString "TVar#", (Karrow Klifted (Karrow Klifted Kunlifted))),
-      (zEncodeString "MVar#", (Karrow Klifted (Karrow Klifted Kunlifted))),
-      (zEncodeString "State#", (Karrow Klifted Kunlifted)),
-      (zEncodeString "RealWorld", Klifted),
-      (zEncodeString "ThreadId#", Kunlifted),
-      (zEncodeString "Weak#", (Karrow Klifted Kunlifted)),
-      (zEncodeString "StablePtr#", (Karrow Klifted Kunlifted)),
-      (zEncodeString "StableName#", (Karrow Klifted Kunlifted)),
-      (zEncodeString "BCO#", Kunlifted),
-      (zEncodeString "Any", Klifted)   ]
-primVals :: [(Var, Ty)]
-primVals = [
-      (zEncodeString "gtChar#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "geChar#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "eqChar#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "neChar#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "ltChar#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "leChar#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "ord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "+#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "-#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "*#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "mulIntMayOflo#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "quotInt#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "remInt#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "gcdInt#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "negateInt#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "addIntC#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))))),
-      (zEncodeString "subIntC#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))))),
-      (zEncodeString ">#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString ">=#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "==#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "/=#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "<#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "<=#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "chr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Char#")))),
-      (zEncodeString "int2Word#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#")))),
-      (zEncodeString "int2Float#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "int2Double#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "int2Integer#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))),
-      (zEncodeString "uncheckedIShiftL#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "uncheckedIShiftRA#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "uncheckedIShiftRL#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "plusWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "minusWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "timesWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "quotWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "remWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "and#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "or#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "xor#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "not#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#")))),
-      (zEncodeString "uncheckedShiftL#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "uncheckedShiftRL#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "word2Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "word2Integer#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))),
-      (zEncodeString "gtWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "geWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "eqWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "neWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "ltWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "leWord#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "narrow8Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "narrow16Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "narrow32Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "narrow8Word#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#")))),
-      (zEncodeString "narrow16Word#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#")))),
-      (zEncodeString "narrow32Word#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) ((Tcon (Just primMname, zEncodeString "Word#")))),
-      (zEncodeString "int64ToInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int64#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))),
-      (zEncodeString "word64ToInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word64#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))),
-      (zEncodeString "plusInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "minusInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "timesInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "gcdInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "gcdIntegerInt#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))))),
-      (zEncodeString "divExactInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "quotInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "remInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "cmpInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))))),
-      (zEncodeString "cmpIntegerInt#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))))),
-      (zEncodeString "quotRemInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tapp (Tapp (Tcon (Just primMname, "Z4H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "divModInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tapp (Tapp (Tcon (Just primMname, "Z4H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "integer2Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "integer2Word#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "andInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "orInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "xorInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))))),
-      (zEncodeString "complementInteger#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#"))))))),
-      (zEncodeString ">##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString ">=##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "==##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "/=##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "<##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "<=##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "+##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "-##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "*##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "/##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "negateDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "double2Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "double2Float#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "expDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "logDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "sqrtDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "sinDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "cosDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "tanDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "asinDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "acosDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "atanDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "sinhDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "coshDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "tanhDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "**##", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "decodeDouble#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) ((Tapp (Tapp (Tapp (Tcon (Just primMname, "Z3H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))),
-      (zEncodeString "gtFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "geFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "eqFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "neFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "ltFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "leFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "plusFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "minusFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "timesFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "divideFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "negateFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "float2Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "expFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "logFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "sqrtFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "sinFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "cosFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "tanFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "asinFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "acosFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "atanFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "sinhFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "coshFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "tanhFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#")))),
-      (zEncodeString "powerFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "float2Double#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tcon (Just primMname, zEncodeString "Double#")))),
-      (zEncodeString "decodeFloat#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) ((Tapp (Tapp (Tapp (Tcon (Just primMname, "Z3H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))),
-      (zEncodeString "newArray#", Tforall ("a", Klifted) (Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a"))))))))))),
-      (zEncodeString "sameMutableArray#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a"))))) ((Tcon (Just boolMname, zEncodeString "Bool"))))))),
-      (zEncodeString "readArray#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tvar "a"))))))))),
-      (zEncodeString "writeArray#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s")))))))))),
-      (zEncodeString "indexArray#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "Array#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tcon (Just primMname, "Z1H")) ((Tvar "a"))))))),
-      (zEncodeString "unsafeFreezeArray#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "Array#")) ((Tvar "a")))))))))),
-      (zEncodeString "unsafeThawArray#", Tforall ("a", Klifted) (Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "Array#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutableArray#")) ((Tvar "s"))) ((Tvar "a")))))))))),
-      (zEncodeString "newByteArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))))))),
-      (zEncodeString "newPinnedByteArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))))))),
-      (zEncodeString "byteArrayContents#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Addr#")))),
-      (zEncodeString "sameMutableByteArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) ((Tcon (Just boolMname, zEncodeString "Bool")))))),
-      (zEncodeString "unsafeFreezeByteArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))))),
-      (zEncodeString "sizeofByteArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "sizeofMutableByteArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexCharArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Char#"))))),
-      (zEncodeString "indexWideCharArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Char#"))))),
-      (zEncodeString "indexIntArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexWordArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexAddrArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Addr#"))))),
-      (zEncodeString "indexFloatArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "indexDoubleArray#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "indexStablePtrArray#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))))),
-      (zEncodeString "indexInt8Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexInt16Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexInt32Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexInt64Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int64#"))))),
-      (zEncodeString "indexWord8Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexWord16Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexWord32Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexWord64Array#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word64#"))))),
-      (zEncodeString "readCharArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Char#"))))))))),
-      (zEncodeString "readWideCharArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Char#"))))))))),
-      (zEncodeString "readIntArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readWordArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readAddrArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Addr#"))))))))),
-      (zEncodeString "readFloatArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Float#"))))))))),
-      (zEncodeString "readDoubleArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Double#"))))))))),
-      (zEncodeString "readStablePtrArray#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))))))))),
-      (zEncodeString "readInt8Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readInt16Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readInt32Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readInt64Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int64#"))))))))),
-      (zEncodeString "readWord8Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readWord16Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readWord32Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readWord64Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word64#"))))))))),
-      (zEncodeString "writeCharArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWideCharArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeIntArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWordArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeAddrArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeFloatArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeDoubleArray#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeStablePtrArray#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s")))))))))),
-      (zEncodeString "writeInt8Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeInt16Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeInt32Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeInt64Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int64#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord8Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord16Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord32Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord64Array#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "MutableByteArray#")) ((Tvar "s"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word64#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "nullAddr#", (Tcon (Just primMname, zEncodeString "Addr#"))),
-      (zEncodeString "plusAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Addr#"))))),
-      (zEncodeString "minusAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "remAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "addr2Int#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just primMname, zEncodeString "Int#")))),
-      (zEncodeString "int2Addr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Addr#")))),
-      (zEncodeString "gtAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "geAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "eqAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "neAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "ltAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "leAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tcon (Just boolMname, zEncodeString "Bool"))))),
-      (zEncodeString "indexCharOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Char#"))))),
-      (zEncodeString "indexWideCharOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Char#"))))),
-      (zEncodeString "indexIntOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexWordOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexAddrOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Addr#"))))),
-      (zEncodeString "indexFloatOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Float#"))))),
-      (zEncodeString "indexDoubleOffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Double#"))))),
-      (zEncodeString "indexStablePtrOffAddr#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))))),
-      (zEncodeString "indexInt8OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexInt16OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexInt32OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "indexInt64OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Int64#"))))),
-      (zEncodeString "indexWord8OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexWord16OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexWord32OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word#"))))),
-      (zEncodeString "indexWord64OffAddr#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tcon (Just primMname, zEncodeString "Word64#"))))),
-      (zEncodeString "readCharOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Char#"))))))))),
-      (zEncodeString "readWideCharOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Char#"))))))))),
-      (zEncodeString "readIntOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readWordOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readAddrOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Addr#"))))))))),
-      (zEncodeString "readFloatOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Float#"))))))))),
-      (zEncodeString "readDoubleOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Double#"))))))))),
-      (zEncodeString "readStablePtrOffAddr#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))))))))),
-      (zEncodeString "readInt8OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readInt16OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readInt32OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "readInt64OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int64#"))))))))),
-      (zEncodeString "readWord8OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readWord16OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readWord32OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word#"))))))))),
-      (zEncodeString "readWord64OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Word64#"))))))))),
-      (zEncodeString "writeCharOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWideCharOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Char#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeIntOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWordOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeAddrOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeFloatOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Float#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeDoubleOffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Double#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeStablePtrOffAddr#", Tforall ("a", Klifted) (Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s")))))))))),
-      (zEncodeString "writeInt8OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeInt16OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeInt32OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeInt64OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int64#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord8OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord16OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord32OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "writeWord64OffAddr#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Word64#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "newMutVar#", Tforall ("a", Klifted) (Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutVar#")) ((Tvar "s"))) ((Tvar "a")))))))))),
-      (zEncodeString "readMutVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tvar "a")))))))),
-      (zEncodeString "writeMutVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "sameMutVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutVar#")) ((Tvar "s"))) ((Tvar "a"))))) ((Tcon (Just boolMname, zEncodeString "Bool"))))))),
-      (zEncodeString "atomicModifyMutVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tforall ("c", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MutVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tvar "b")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tvar "c"))))))))))),
-      (zEncodeString "catch#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))))),
-      (zEncodeString "raise#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tvar "b"))))),
-      (zEncodeString "raiseIO#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "b")))))))),
-      (zEncodeString "blockAsyncExceptions#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))),
-      (zEncodeString "unblockAsyncExceptions#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))),
-      (zEncodeString "atomically#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))),
-      (zEncodeString "retry#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))),
-      (zEncodeString "catchRetry#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))))),
-      (zEncodeString "catchSTM#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))))),
-      (zEncodeString "check#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a")))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just baseMname, zEncodeString "()")))))))),
-      (zEncodeString "newTVar#", Tforall ("a", Klifted) (Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "TVar#")) ((Tvar "s"))) ((Tvar "a")))))))))),
-      (zEncodeString "readTVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "TVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tvar "a")))))))),
-      (zEncodeString "writeTVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "TVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "sameTVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "TVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "TVar#")) ((Tvar "s"))) ((Tvar "a"))))) ((Tcon (Just boolMname, zEncodeString "Bool"))))))),
-      (zEncodeString "newMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))))))),
-      (zEncodeString "takeMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tvar "a")))))))),
-      (zEncodeString "tryTakeMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tapp (Tcon (Just primMname, "Z3H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tvar "a")))))))),
-      (zEncodeString "putMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))))),
-      (zEncodeString "tryPutMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#")))))))))),
-      (zEncodeString "sameMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) ((Tcon (Just boolMname, zEncodeString "Bool"))))))),
-      (zEncodeString "isEmptyMVar#", Tforall ("s", Klifted) (Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tapp (Tcon (Just primMname, zEncodeString "MVar#")) ((Tvar "s"))) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))),
-      (zEncodeString "delay#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))),
-      (zEncodeString "waitRead#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))),
-      (zEncodeString "waitWrite#", Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))))),
-      (zEncodeString "fork#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just primMname, zEncodeString "ThreadId#")))))))),
-      (zEncodeString "forkOn#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just primMname, zEncodeString "ThreadId#"))))))))),
-      (zEncodeString "killThread#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ThreadId#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld"))))))))),
-      (zEncodeString "yield#", Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))),
-      (zEncodeString "myThreadId#", Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just primMname, zEncodeString "ThreadId#")))))),
-      (zEncodeString "labelThread#", Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ThreadId#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))))),
-      (zEncodeString "isCurrentThreadBound#", Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just primMname, zEncodeString "Int#")))))),
-      (zEncodeString "noDuplicate#", Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))),
-      (zEncodeString "mkWeak#", Tforall ("o", Kopen) (Tforall ("b", Klifted) (Tforall ("c", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "o"))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "c"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "Weak#")) ((Tvar "b"))))))))))))),
-      (zEncodeString "deRefWeak#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "Weak#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tapp (Tcon (Just primMname, "Z3H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tvar "a"))))))),
-      (zEncodeString "finalizeWeak#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "Weak#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tapp (Tcon (Just primMname, "Z3H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tcon (Just baseMname, zEncodeString "()"))))))))))),
-      (zEncodeString "touch#", Tforall ("o", Kopen) (Tapp (Tapp (Tcon tcArrow) ((Tvar "o"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))))),
-      (zEncodeString "makeStablePtr#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))))))),
-      (zEncodeString "deRefStablePtr#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tvar "a"))))))),
-      (zEncodeString "eqStablePtr#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StablePtr#")) ((Tvar "a"))))) ((Tcon (Just primMname, zEncodeString "Int#")))))),
-      (zEncodeString "makeStableName#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tcon (Just primMname, zEncodeString "RealWorld")))))) ((Tapp (Tcon (Just primMname, zEncodeString "StableName#")) ((Tvar "a"))))))))),
-      (zEncodeString "eqStableName#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StableName#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StableName#")) ((Tvar "a"))))) ((Tcon (Just primMname, zEncodeString "Int#")))))),
-      (zEncodeString "stableNameToInt#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "StableName#")) ((Tvar "a"))))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "reallyUnsafePtrEquality#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tcon (Just primMname, zEncodeString "Int#")))))),
-      (zEncodeString "par#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "parGlobal#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))))),
-      (zEncodeString "parLocal#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))))),
-      (zEncodeString "parAt#", Tforall ("b", Klifted) (Tforall ("a", Klifted) (Tforall ("c", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "c"))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))))))),
-      (zEncodeString "parAtAbs#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) ((Tcon (Just primMname, zEncodeString "Int#")))))))))))),
-      (zEncodeString "parAtRel#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) ((Tcon (Just primMname, zEncodeString "Int#")))))))))))),
-      (zEncodeString "parAtForNow#", Tforall ("b", Klifted) (Tforall ("a", Klifted) (Tforall ("c", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "c"))) ((Tcon (Just primMname, zEncodeString "Int#"))))))))))))),
-      (zEncodeString "dataToTag#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tcon (Just primMname, zEncodeString "Int#"))))),
-      (zEncodeString "tagToEnum#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tvar "a")))),
-      (zEncodeString "addrToHValue#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tapp (Tcon (Just primMname, "Z1H")) ((Tvar "a")))))),
-      (zEncodeString "mkApUpd0#", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "BCO#")))) ((Tapp (Tcon (Just primMname, "Z1H")) ((Tvar "a")))))),
-      (zEncodeString "newBCO#", Tforall ("a", Klifted) (Tforall ("s", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "Array#")) ((Tvar "a"))))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "ByteArray#")))) (Tapp (Tapp (Tcon tcArrow) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tapp (Tcon (Just primMname, zEncodeString "State#")) ((Tvar "s"))))) ((Tcon (Just primMname, zEncodeString "BCO#"))))))))))))),
-      (zEncodeString "unpackClosure#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tapp (Tapp (Tapp (Tcon (Just primMname, "Z3H")) ((Tcon (Just primMname, zEncodeString "Addr#")))) ((Tapp (Tcon (Just primMname, zEncodeString "Array#")) ((Tvar "b"))))) ((Tcon (Just primMname, zEncodeString "ByteArray#")))))))),
-      (zEncodeString "getApStackVal#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tapp (Tapp (Tcon (Just primMname, "Z2H")) ((Tcon (Just primMname, zEncodeString "Int#")))) ((Tvar "b")))))))),
-      (zEncodeString "seq", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) (Tapp (Tapp (Tcon tcArrow) ((Tvar "b"))) ((Tvar "b")))))),
-      (zEncodeString "inline", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tvar "a")))),
-      (zEncodeString "lazy", Tforall ("a", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tvar "a")))),
-      (zEncodeString "unsafeCoerce#", Tforall ("a", Klifted) (Tforall ("b", Klifted) (Tapp (Tapp (Tcon tcArrow) ((Tvar "a"))) ((Tvar "b")))))]
-intLitTypes :: [Ty]
-intLitTypes = [
-   (Tcon (Just primMname, zEncodeString "Char#")),
-   (Tcon (Just primMname, zEncodeString "Int#")),
-   (Tcon (Just primMname, zEncodeString "Word#")),
-   (Tcon (Just primMname, zEncodeString "Int64#")),
-   (Tcon (Just primMname, zEncodeString "Word64#")),
-   (Tcon (Just primMname, zEncodeString "Addr#"))]
-ratLitTypes :: [Ty]
-ratLitTypes = [
-   (Tcon (Just primMname, zEncodeString "Double#")),
-   (Tcon (Just primMname, zEncodeString "Float#"))]
-charLitTypes :: [Ty]
-charLitTypes = [
-   (Tcon (Just primMname, zEncodeString "Char#"))]
-stringLitTypes :: [Ty]
-stringLitTypes = [
-   (Tcon (Just primMname, zEncodeString "Addr#"))]
-

diff --git a/utils/ext-core/Language/Core/Prims.hs b/utils/ext-core/Language/Core/Prims.hs
deleted file mode 100644 (file)
index 69e0cb9..0000000
--- a/utils/ext-core/Language/Core/Prims.hs
+++ /dev/null
@@ -1,167 +0,0 @@
-{-# OPTIONS -Wall #-}
-
-{- This module contains a few primitive types that need to be wired in.
-   Most are defined in PrimEnv, which is automatically generated from
-   GHC's primops.txt. -}
-
-module Language.Core.Prims(initialEnv, primEnv, primId, bv,
-             tIntzh, tInt64zh, tCharzh, tFloatzh, tAddrzh, tDoublezh, tcStatezh,
-             tWordzh, tWord64zh, tByteArrayzh,
-             tcStablePtrzh, tcIO, mkInitialEnv, mkTypeEnv, tRWS, tBool, tcBool,
-             ioBaseMname) where
-
-import Control.Monad
-
-import Language.Core.Core
-import Language.Core.Encoding
-import Language.Core.Env
-import Language.Core.Check
-import Language.Core.PrimCoercions
-import Language.Core.PrimEnv
-
-initialEnv :: Menv
-initialEnv = efromlist [(primMname,primEnv),
-                    (errMname,errorEnv),
-                     (boolMname,boolEnv)]
-
-primEnv :: Envs
--- Tediously, we add defs for ByteArray# etc. because these are
--- declared as ByteArr# (etc.) in primops.txt, and GHC has
--- ByteArray# etc. wired-in.
--- At least this is better than when all primops were wired-in here.
-primEnv = Envs {tcenv_=efromlist $ map (\ (t,k) -> (t,Kind k)) $ 
-                  [(snd tcByteArrayzh,ktByteArrayzh), 
-                   (snd tcMutableArrayzh, ktMutableArrayzh),
-                   (snd tcMutableByteArrayzh, ktMutableByteArrayzh)] ++
-                 ([(snd $ tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]] 
-                   ++ ((snd tcArrow,ktArrow):primTcs)),
-               cenv_=efromlist primDcs,
-               venv_=efromlist (opsState ++ primVals)}
-
-errorEnv :: Envs
-errorEnv = Envs {tcenv_=eempty,
-                cenv_=eempty,
-                venv_=efromlist errorVals}
-
--- Unpleasantly, we wire in the Bool type because some people
--- (i.e. me) need to depend on it being primitive. This shouldn't
--- hurt anything, since if someone pulls in the GHC.Bool module,
--- it will override this definition.
-boolEnv :: Envs
-boolEnv = Envs {tcenv_=efromlist boolTcs,
-                cenv_=efromlist boolDcs,
-                venv_=eempty}
-
-boolTcs :: [(Tcon, KindOrCoercion)]
-boolTcs = [(snd tcBool, Kind Klifted)]
-            
-boolDcs :: [(Dcon, Ty)]
-boolDcs = [(dcTrue, tBool),
-           (dcFalse, tBool)]
-
-primDcs :: [(Dcon,Ty)]
-primDcs = map (\ ((_,c),t) -> (c,t))
-             [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]]
-
-tRWS :: Ty
-tRWS = tStatezh tRealWorld
-
-opsState :: [(Var, Ty)]
-opsState = [
-  ("realWorldzh", tRWS)]
-
-{- Arrays -}
-
-tcByteArrayzh, tcMutableArrayzh, tcMutableByteArrayzh :: Qual Tcon
-ktByteArrayzh, ktMutableArrayzh, ktMutableByteArrayzh :: Kind
-
-tcByteArrayzh = pvz "ByteArray"
-ktByteArrayzh = Kunlifted
-
-tcMutableArrayzh = pvz "MutableArray"
-ktMutableArrayzh = Karrow Klifted (Karrow Klifted Kunlifted)
-
-tcMutableByteArrayzh = pvz "MutableByteArray"
-ktMutableByteArrayzh = Karrow Klifted Kunlifted
-
-{- Real world and state. -}
-
--- tjc: why isn't this one unboxed?
-tcRealWorld :: Qual Tcon
-tcRealWorld = pv "RealWorld"
-tRealWorld :: Ty
-tRealWorld = Tcon tcRealWorld
-
-tcStatezh :: Qual Tcon
-tcStatezh = pvz "State"
-tStatezh :: Ty -> Ty
-tStatezh t = Tapp (Tcon tcStatezh) t
-
-{- Properly defined in PrelError, but needed in many modules before that. -}
-errorVals :: [(Var, Ty)]
-errorVals = []
-{-
- [
- ("error", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
- ("irrefutPatError", str2A),
- ("patError", str2A),
- ("divZZeroError", forallAA),
- ("overflowError", forallAA)]
--}
-
-{- Non-primitive, but mentioned in the types of primitives. -}
-
-bv :: a -> Qual a
-bv = qual baseMname
-
-str2A, forallAA :: Ty  
-str2A = Tforall ("a",Kopen) (tArrow tAddrzh (Tvar "a"))
-forallAA = Tforall ("a",Kopen) (Tvar "a")
-
-tBool :: Ty
-tBool = Tcon tcBool
-tcBool :: Qual Tcon
-tcBool = (Just boolMname, "Bool")
-tcChar :: Qual Tcon
-tcChar = bv "Char"
-tChar :: Ty
-tChar = Tcon tcChar
-tcList :: Qual Tcon
-tcList = bv "ZMZN"
-tList :: Ty -> Ty
-tList t = Tapp (Tcon tcList) t
-tString :: Ty
-tString = tList tChar
-tIntzh, tInt64zh, tWordzh, tWord64zh, tCharzh, tFloatzh, tDoublezh, {-tIOUnit,-} 
-  tByteArrayzh :: Ty
-tIntzh = Tcon (primId "Int#")
-tInt64zh = Tcon (primId "Int64#")
-tWordzh = Tcon (primId "Word#")
-tWord64zh = Tcon (primId "Word64#")
-tByteArrayzh = Tcon (primId "ByteArray#")
-tCharzh = Tcon (primId "Char#")
-tFloatzh = Tcon (primId "Float#")
-tDoublezh = Tcon (primId "Double#")
-tcStablePtrzh, tcIO :: Qual Tcon
-tcStablePtrzh = pvz "StablePtr"
-tcIO = (Just (mkBaseMname "IOBase"), "IO")
-
-primId :: String -> Qual Id
-primId = pv . zEncodeString
-
---- doesn't really belong here... sigh
-
-mkInitialEnv :: [Module] -> IO Menv
-mkInitialEnv libs = foldM mkTypeEnv initialEnv libs
-                    
-mkTypeEnv :: Menv -> Module -> IO Menv
-mkTypeEnv globalEnv m@(Module mn _ _) = 
-    catch (return (envsModule globalEnv m)) handler
-        where handler e = do
-                putStrLn ("WARNING: mkTypeEnv caught an exception " ++ show e 
-                                    ++ " while processing " ++ show mn)
-                return globalEnv
-
------ move this 
-ioBaseMname :: AnMname
-ioBaseMname = mkBaseMname "IOBase"

diff --git a/utils/ext-core/Language/Core/Printer.hs b/utils/ext-core/Language/Core/Printer.hs
deleted file mode 100644 (file)
index d7c4cdb..0000000
--- a/utils/ext-core/Language/Core/Printer.hs
+++ /dev/null
@@ -1,232 +0,0 @@
-{-# OPTIONS -Wall -fno-warn-missing-signatures #-}
-
-module Language.Core.Printer where
-
-import Text.PrettyPrint.HughesPJ
-import Data.Char
-
-import Language.Core.Core
-import Language.Core.Encoding
-
-instance Show Module where
-  showsPrec _ m = shows (pmodule m)
-
-instance Show Tdef where
-  showsPrec _ t = shows (ptdef t)
-
-instance Show Cdef where
-  showsPrec _ c = shows (pcdef c)
-
-instance Show Vdefg where
-  showsPrec _ v = shows (pvdefg v)
-
-instance Show Vdef where
-  showsPrec _ v = shows (pvdef v)
-
-instance Show Exp where
-  showsPrec _ e = shows (pexp e)
-
-instance Show Alt where
-  showsPrec _ a = shows (palt a)
-
-instance Show Ty where
-  showsPrec _ t = shows (pty t)
-
-instance Show Kind where
-  showsPrec _ k = shows (pkind k)
-
-instance Show CoercionKind where
-  showsPrec _ (DefinedCoercion tbs (from,to)) =
-    shows $ parens (text "defined coercion:" <+> (hsep (map ptbind tbs))
-            <+> text ":" <+> brackets (pty from)
-            <+> text "->" <+> brackets (pty to))
-instance Show Lit where
-  showsPrec _ l = shows (plit l)
-
-instance Show CoreLit where
-  showsPrec _ l = shows (pclit l)
-
-instance Show KindOrCoercion where
-  showsPrec _ (Kind k) = shows (text "<K" <+> pkind k <> text ">")
-  showsPrec _ (Coercion (DefinedCoercion tbs (t1,t2))) = 
-     shows (text "<C" <+> hsep (map ptbind tbs) <+>
-              parens (pkind (Keq t1 t2)) <> text ">") 
-
-instance Show AnMname where
-  showsPrec _ mn = shows (panmname mn)
-
-indent = nest 2
-
--- seems like this is asking for a type class...
-
-pmodule (Module mname tdefs vdefgs) =
-  (text "%module" <+> panmname mname)
-  $$ indent ((vcat (map ((<> char ';') . ptdef) tdefs))
-            $$ (vcat (map ((<> char ';') . pvdefg) vdefgs)))
-  <> (if ((not.null) tdefs) || ((not.null) vdefgs) then char '\n' else empty)
-         -- add final newline; sigh.
-
-ptdef (Data qtcon tbinds cdefs) =
-  (text "%data" <+> pqname qtcon <+> (hsep (map ptbind tbinds)) <+> char '=')
-  $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
-
-ptdef (Newtype qtcon coercion tbinds tyopt) =
-  text "%newtype" <+> pqname qtcon <+> pqname coercion 
-    <+> (hsep (map ptbind tbinds)) $$ indent repclause
-       where repclause = char '=' <+> pty tyopt
-
-pcdef (Constr qdcon tbinds tys)  =
-  (pqname qdcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
-
-pname = text
-
-pqname (m,v) = pmname m <> pname v
-
--- be sure to print the '.' here so we don't print out
--- ".foo" for unqualified foo...
-pmname Nothing = empty
-pmname (Just m) = panmname m <> char '.'
-
-panmname (M (P pkgName, parents, name)) =
-  let parentStrs = map pname parents in
-         pname pkgName <> char ':' <>
-         -- This is to be sure to not print out:
-         -- main:.Main for when there's a single module name
-         -- with no parents.
-             (case parentStrs of
-                [] -> empty
-                _  -> hcat (punctuate hierModuleSeparator 
-                        (map pname parents)) 
-                      <> hierModuleSeparator)
-             <> pname name
-
--- note that this is not a '.' but a Z-encoded '.':
--- GHCziIOBase.IO, not GHC.IOBase.IO.
--- What a pain.
-hierModuleSeparator = text (zEncodeString ".")
-
-ptbind (t,Klifted) = pname t
-ptbind (t,k) = parens (pname t <> text "::" <> pkind k)
-
-pattbind (t,k) = char '@' <> ptbind (t,k)
-
-pakind (Klifted) = char '*'
-pakind (Kunlifted) = char '#'
-pakind (Kopen) = char '?'
-pakind k = parens (pkind k)
-
-pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2)
-pkind (Keq from to) = peqkind (from,to)
-pkind k = pakind k
-
-peqkind (t1, t2) = parens (parens (pty t1) <+> text ":=:" <+> parens (pty t2)) 
-
-paty (Tvar n) = pname n
-paty (Tcon c) = pqname c
-paty t = parens (pty t)
-
-pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2])
-pbty (Tapp t1 t2) = pappty t1 [t2] 
-pbty t = paty t
-
-pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2]
-pty (Tforall tb t) = text "%forall" <+> pforall [tb] t
-pty (TransCoercion t1 t2) = 
-    (sep ([text "%trans", paty t1, paty t2]))
-pty (SymCoercion t) = 
-    (sep [text "%sym", paty t])
-pty (UnsafeCoercion t1 t2) = 
-    (sep [text "%unsafe", paty t1, paty t2])
-pty (LeftCoercion t) = 
-    (text "%left" <+> paty t)
-pty (RightCoercion t) = 
-    (text "%right" <+> paty t)
-pty (InstCoercion t1 t2) = 
-    (sep [text "%inst", paty t1, paty t2])
-pty t = pbty t
-
-pappty (Tapp t1 t2) ts = pappty t1 (t2:ts)
-pappty t ts = sep (map paty (t:ts))
-
-pforall tbs (Tforall tb t) = pforall (tbs ++ [tb]) t
-pforall tbs t = hsep (map ptbind tbs) <+> char '.' <+> pty t
-
-pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvdef vdefs))))
-pvdefg (Nonrec vdef) = pvdef vdef
-
-pvdef (Vdef (qv,t,e)) = sep [pqname qv <+> text "::" <+> pty t <+> char '=',
-                    indent (pexp e)]
-
-paexp (Var x) = pqname x
-paexp (Dcon x) = pqname x
-paexp (Lit l) = plit l
-paexp e = parens(pexp e)
-
-plamexp bs (Lam b e) = plamexp (bs ++ [b]) e
-plamexp bs e = sep [sep (map pbind bs) <+> text "->",
-                   indent (pexp e)]
-
-pbind (Tb tb) = char '@' <+> ptbind tb
-pbind (Vb vb) = pvbind vb
-
-pfexp (App e1 e2) = pappexp e1 [Left e2]
-pfexp (Appt e t) = pappexp e [Right t]
-pfexp e = paexp e
-
-pappexp (App e1 e2) as = pappexp e1 (Left e2:as)
-pappexp (Appt e t) as = pappexp e (Right t:as)
-pappexp e as = fsep (paexp e : map pa as)
-           where pa (Left ex) = paexp ex
-                pa (Right t) = char '@' <+> paty t
-
-pexp (Lam b e) = char '\\' <+> plamexp [b] e
-pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
-pexp (Case e vb t alts) = sep [text "%case" <+> paty t <+> paexp e,
-                            text "%of" <+> pvbind vb]
-                       $$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
-pexp (Cast e t) = (text "%cast" <+> parens (pexp e)) $$ paty t
-pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
--- TODO: ccall shouldn't really be there
-pexp (External n t) = (text "%external ccall" <+> pstring n) $$ paty t
-pexp e = pfexp e
-
-
-pvbind (x,t) = parens(pname x <> text "::" <> pty t)
-
-palt (Acon c tbs vbs e) =
-       sep [pqname c, 
-            sep (map pattbind tbs),
-            sep (map pvbind vbs) <+> text "->"]
-        $$ indent (pexp e)
-palt (Alit l e) = 
-       (plit l <+>  text "->")
-       $$ indent (pexp e)
-palt (Adefault e) = 
-       (text "%_ ->")
-       $$ indent (pexp e)
-
-plit (Literal cl t) = parens (pclit cl <> text "::" <> pty t)
-
-pclit (Lint i) = integer i
--- makes sure to print it out as n % d
-pclit (Lrational r) = text (show r)
-pclit (Lchar c) = text ("\'" ++ escape [c] ++ "\'")
-pclit (Lstring s) = pstring s
-
-pstring s = doubleQuotes(text (escape s))
-
-escape :: String -> String
-escape s = foldr f [] (map ord s)
-    where 
-     f cv rest
-       | cv > 0xFF = '\\':'x':hs ++ rest
-       | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
-        '\\':'x':h1:h0:rest
-           where (q1,r1) = quotRem cv 16
-                h1 = intToDigit q1
-                 h0 = intToDigit r1
-                hs = dropWhile (=='0') $ reverse $ mkHex cv
-                mkHex 0 = ""
-                mkHex num = intToDigit r : mkHex q
-                   where (q,r) = quotRem num 16
-     f cv rest = (chr cv):rest

diff --git a/utils/ext-core/Language/Core/Utils.hs b/utils/ext-core/Language/Core/Utils.hs
deleted file mode 100644 (file)
index d5ca785..0000000
--- a/utils/ext-core/Language/Core/Utils.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-module Language.Core.Utils
-         (everywhereExcept, everywhereExceptM, noNames, notNull,
-             expectJust, fixedPointBy, applyPasses, varsIn, dupsBy,
-             everywhere'Except, everywhere'But, wordsBy) where
-
-import Data.Generics
-import Data.List
-import Data.Maybe
-import qualified Data.Set as S
-
-everywhereExcept :: Data a => GenericT -> a -> a
-everywhereExcept = everywhereBut (mkQ False (\ (_::String) -> True))
-
-everywhere'Except :: Data a => GenericT -> a -> a
-everywhere'Except = everywhere'But (mkQ False (\ (_::String) -> True))
-
-everywhereExceptM :: (Data a, Monad m) => GenericM m -> a -> m a
-everywhereExceptM = everywhereButM (mkQ False (\ (_::String) -> True))
-
-
-noNames :: Data a => r -> (r -> r -> r) -> GenericQ r -> a -> r
-noNames e c = everythingBut e c (mkQ False (\ (_::String) -> True))
-
-everythingBut :: r -> (r -> r -> r) -> GenericQ Bool
-              -> GenericQ r -> GenericQ r
-everythingBut empty combine q q1 x
-  | q x         = empty
-  | otherwise   = q1 x `combine` 
-     (foldl' combine empty
-       (gmapQ (everythingBut empty combine q q1) x))
-
-everywhere'But :: GenericQ Bool -> GenericT -> GenericT
--- Guarded to let traversal cease if predicate q holds for x
-everywhere'But q f x
-    | q x       = x
-    | otherwise = let top = f x in
-                    top `seq` (gmapT (everywhere'But q f) top)
-
-everywhereButM :: Monad m => GenericQ Bool -> GenericM m -> GenericM m
-everywhereButM q f x
-    | q x       = return x
-    | otherwise = (gmapM (everywhereButM q f) x) >>= f
-
-notNull :: [a] -> Bool
-notNull = not . null
-
-expectJust :: String -> Maybe a -> a
-expectJust s = fromMaybe (error s)
-
-fixedPointBy :: (a -> a -> Bool) -> (a -> a) -> a -> a
-fixedPointBy done trans start = go start
-  where go v = 
-          let next = trans v in
-           if done v next then
-             next
-           else
-             go next
-
-applyPasses :: [a -> a] -> a -> a
-applyPasses passes p = -- trace ("p = " ++ show p) $ 
-  foldl' (\ p' nextF -> nextF p') p passes
-
-varsIn :: (Ord b, Typeable b, Data a) => a -> S.Set b
-varsIn = noNames S.empty S.union 
-           (mkQ S.empty (\ v -> S.singleton v))
-
-dupsBy :: (a -> a -> Bool) -> [a] -> [a]
-dupsBy (~=) xs = filter (\ x -> length (filter (~= x) xs) > 1) xs
-
-wordsBy :: Eq a => a -> [a] -> [[a]]
-wordsBy _ []              = [[]]
-wordsBy y (x:xs) | y == x = [x]:(wordsBy y xs)
-wordsBy y (x:xs)          = 
-  case wordsBy y xs of
-    (z:zs) -> (x:z):zs
-    []     -> [[y]]

diff --git a/utils/ext-core/Makefile b/utils/ext-core/Makefile
deleted file mode 100644 (file)
index 99bd6d2..0000000
--- a/utils/ext-core/Makefile
+++ /dev/null
@@ -1,11 +0,0 @@
-# This makefile is just for running the tests. For everything else,
-# use Cabal! (The tests could be run with Cabal too, I'm just too lazy
-# to figure out how.)
-
-# The following assumes that you've built all the GHC libs with -fext-core...
-libtest:
-       ./Driver -n `find ../../libraries -print | grep .hcr$$ | grep -v bootstrapping`
-
-# ...or built all the nofib programs with -fext-core.
-nofibtest:
-       ./Driver `find ../../nofib -print | grep .hcr$$`

diff --git a/utils/ext-core/Parser.y b/utils/ext-core/Parser.y
deleted file mode 100644 (file)
index 67db7bc..0000000
--- a/utils/ext-core/Parser.y
+++ /dev/null
@@ -1,260 +0,0 @@
-{
-module Parser ( parse ) where
-
-import Core
-import ParseGlue
-import Lex
-
-}
-
-%name parse
-%expect 0
-%tokentype { Token }
-
-%token
- '%module'     { TKmodule }
- '%data'       { TKdata }
- '%newtype'    { TKnewtype }
- '%forall'     { TKforall }
- '%rec'                { TKrec }
- '%let'                { TKlet }
- '%in'         { TKin }
- '%case'       { TKcase }
- '%of'         { TKof }
- '%cast'       { TKcast }
- '%note'       { TKnote }
- '%external'   { TKexternal }
- '%_'          { TKwild }
- '('           { TKoparen }
- ')'           { TKcparen }
- '{'           { TKobrace }
- '}'           { TKcbrace }
- '#'           { TKhash}
- '='           { TKeq }
- '::'          { TKcoloncolon }
- '*'           { TKstar }
- '->'          { TKrarrow }
- '\\'          { TKlambda}
- '@'           { TKat }
- '.'           { TKdot }
- ':'           { TKcolon }
- '?'           { TKquestion}
- ';'            { TKsemicolon }
- NAME          { TKname $$ }
- CNAME                 { TKcname $$ }
- INTEGER       { TKinteger $$ }
- RATIONAL      { TKrational $$ }
- STRING                { TKstring $$ }
- CHAR          { TKchar $$ }
-
-%monad { P } { thenP } { returnP }
-%lexer { lexer } { TKEOF }
-
-%%
-
-module :: { Module }
-       : '%module' mname tdefs  vdefgs 
-               { Module $2 $3 $4 }
-
-tdefs  :: { [Tdef] }
-       : {- empty -}   {[]}
-       | tdef ';' tdefs        {$1:$3}
-
-tdef   :: { Tdef }
-       : '%data' qcname tbinds '=' '{' cons1 '}'
-               { Data $2 $3 $6 }
-       | '%newtype' qcname tbinds trep 
-               { Newtype $2 $3 $4 }
-
-trep    :: { Maybe Ty }
-        : {- empty -}   {Nothing}
-        | '=' ty        { Just $2 }
-
-tbind  :: { Tbind }
-       :  name { ($1,Klifted) }
-       |  '(' name '::' akind ')'
-               { ($2,$4) }
-
-tbinds         :: { [Tbind] }
-       : {- empty -}   { [] }
-       | tbind tbinds  { $1:$2 }
-
-
-vbind  :: { Vbind }
-       : '(' name '::' ty')'   { ($2,$4) }
-
-vbinds :: { [Vbind] }
-       : {-empty -}    { [] }
-       | vbind vbinds  { $1:$2 }
-
-bind   :: { Bind }
-       : '@' tbind     { Tb $2 }
-       | vbind         { Vb $1 }
-
-binds1         :: { [Bind] }
-       : bind          { [$1] }
-       | bind binds1   { $1:$2 }
-
-attbinds :: { [Tbind] }
-       : {- empty -}   { [] }
-       | '@' tbind attbinds 
-                       { $2:$3 }
-
-akind  :: { Kind }
-       : '*'           {Klifted}       
-       | '#'           {Kunlifted}
-       | '?'           {Kopen}
-        | '(' kind ')' { $2 }
-
-kind   :: { Kind }
-       : akind         { $1 }
-       | akind '->' kind 
-               { Karrow $1 $3 }
-
-cons1  :: { [Cdef] }
-       : con           { [$1] }
-       | con ';' cons1 { $1:$3 }
-
-con    :: { Cdef }
-       : qcname attbinds atys 
-               { Constr $1 $2 $3 }
-
-atys   :: { [Ty] }
-       : {- empty -} { [] }
-       | aty atys      { $1:$2 }
-
-aty    :: { Ty }
-       : name  { Tvar $1 }
-       | qcname { Tcon $1 }
-       | '(' ty ')' { $2 }
-
-
-bty    :: { Ty }
-       : aty   { $1 }
-        | bty aty { Tapp $1 $2 }
-
-ty     :: { Ty }
-       : bty   {$1}
-       | bty '->' ty 
-               { tArrow $1 $3 }
-       | '%forall' tbinds '.' ty 
-               { foldr Tforall $4 $2 }
-
-vdefgs :: { [Vdefg] }
-       : {- empty -}           { [] }
-       | vdefg ';' vdefgs      {$1:$3 }
-
-vdefg  :: { Vdefg }
-       : '%rec' '{' vdefs1 '}'
-                      { Rec $3 }
-       |  vdef { Nonrec $1}
-
-vdefs1 :: { [Vdef] }
-       : vdef          { [$1] }
-       | vdef ';' vdefs1 { $1:$3 }
-
-vdef   :: { Vdef }
-       : qname '::' ty '=' exp 
-               { Vdef ($1,$3,$5) }
-
-aexp    :: { Exp }
-       : qname         { Var $1 }
-        | qcname       { Dcon $1 } 
-       | lit           { Lit $1 }
-       | '(' exp ')'   { $2 }
-
-fexp   :: { Exp }
-       : fexp aexp     { App $1 $2 }
-       | fexp '@' aty  { Appt $1 $3 }
-       | aexp          { $1 }
-
-exp    :: { Exp }
-       : fexp          { $1 }
-       | '\\' binds1 '->' exp
-               { foldr Lam $4 $2 }
-       | '%let' vdefg '%in' exp 
-               { Let $2 $4 }
-       | '%case' '(' ty ')' aexp '%of' vbind '{' alts1 '}'
-               { Case $5 $7 $3 $9 }
--- Note: ty, not aty! You can cast something to a forall type
--- Though now we have shift/reduce conflicts like woah
-       | '%cast' exp ty
-               { Cast $2 $3 }
-       | '%note' STRING exp 
-               { Note $2 $3 }
-        | '%external' STRING aty
-                { External $2 $3 }
-
-alts1  :: { [Alt] }
-       : alt           { [$1] }
-       | alt ';' alts1 { $1:$3 }
-
-alt    :: { Alt }
-       : qcname attbinds vbinds '->' exp 
-               { Acon $1 $2 $3 $5 } 
-       | lit '->' exp
-               { Alit $1 $3 }
-       | '%_' '->' exp
-               { Adefault $3 }
-
-lit    :: { Lit }
-       : '(' INTEGER '::' aty ')'
-               { Lint $2 $4 }
-       | '(' RATIONAL '::' aty ')'
-               { Lrational $2 $4 }
-       | '(' CHAR '::' aty ')'
-               { Lchar $2 $4 }
-       | '(' STRING '::' aty ')'
-               { Lstring $2 $4 }
-
-name   :: { Id }
-       : NAME  { $1 }
-
-cname  :: { Id }
-       : CNAME { $1 }
-         
-mname  :: { AnMname }
-        : pkgName ':' cname
-             { let (parentNames, childName) = splitModuleName $3 in
-                 ($1, parentNames, childName) }
-
-pkgName :: { Id }
-        : NAME { $1 }
-
--- TODO: Clean this up. Now hierarchical names are z-encoded.
-
--- note that a sequence of mnames is either:
--- empty, or a series of cnames separated by
--- dots, with a leading dot
--- See the definition of mnames: the "name" part
--- is required.
-mnames :: { [Id] } 
-         : {- empty -} {[]}
-         | '.' cname mnames {$2:$3}
-
--- it sucks to have to repeat the Maybe-checking twice,
--- but otherwise we get reduce/reduce conflicts
-
--- TODO: this is the ambiguity here. mname '.' name --
--- but by maximal-munch, in GHC.Base.Bool the entire 
--- thing gets counted as the module name. What to do,
--- besides z-encoding the dots in the hierarchy again?
--- (Or using syntax other than a dot to separate the
--- module name from the variable name...)
-qname  :: { (Mname,Id) }
-        : name { (Nothing, $1) }
-       | mname '.' name 
-               { (Just $1,$3) }
-
-qcname :: { (Mname,Id) }
-        : cname { (Nothing, $1) }
-        | mname '.' cname 
-               { (Just $1,$3) }
-
-
-{
-
-happyError :: P a 
-happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
-
-}

diff --git a/utils/ext-core/README b/utils/ext-core/README
deleted file mode 100644 (file)
index 8191b71..0000000
--- a/utils/ext-core/README
+++ /dev/null
@@ -1,83 +0,0 @@
-This package has moved to Hackage!
-http://hackage.haskell.org/package/extcore-0.2
-
-The version of the stand-alone External Core library in the GHC
-source tree is now out-of-date, and will probably go away eventually.
-Please get the latest version from Hackage.
-
-=====================================================================
-
-A set of example programs for handling external core format.
-
-In particular, typechecker and interpreter give a precise semantics.
----------------------
-tjc April/May 2008:
-
-==== Documentation ====
-
-Documentation for the External Core format lives under docs/ext-core in the
-GHC tree. If you are building from HEAD, do not rely on the version of the
-External Core documentation that lives in haskell.org -- it is obsolete!
-
-==== Notes ====
-
-The checker should work on most programs. Bugs (and infelicities) 
-I'm aware of:
-   
-1. There's some weirdness involving funny character literals. This can
-   be fixed by writing a new lexer for chars rather than using Parsec's
-   built-in charLiteral lexer. But I haven't done that.
-
-2. The test driver attempts to find module dependencies automatically,
-   but it's slow. You can turn it off with the "-n" flag to the driver,
-   and specify all dependencies on the command line (you have to include
-   standard library dependencies too.)
-     * It would help to cache dependency info for standard libraries
-       in a file, or something, but that's future work.
-
-3. To avoid implementing some of the I/O primitives and foreign calls,
-   I use a gross hack involving replacing certain standard library
-   modules with simplified versions (found under lib/) that depend on
-   fake "primops" that the Core interpreter implements. This makes it
-   difficult (if not impossible) to load optimized versions of standard
-   libraries right now. Fixing this is future work too.
-
-Typechecking all the GHC libraries eats about a gig of heap and takes a
-long time. I blame Parsec. (Someone who was bored, or understood happy
-better than I do, could update the old happy parser, which is still in the
-repo.)
-
-The interpreter is also memory-hungry, but works for small programs
-that only do simple I/O (e.g., putStrLn is okay; not much more than that)
-and don't use Doubles or arrays. For example: exp3_8, gen_regexps, queens,
-primes, rfib, tak, wheel-sieve1, and wheel-sieve2, if modified so as not
-to take input or arguments.
-
-==== Building ====
-
-To run the checker and interpreter, you need to generate External Core
-for all the base, integer and ghc-prim libraries. This can be done by
-adding "-fext-core" to the GhcLibHcOpts in your build.mk file, then
-running "make" under libraries/.
-
-Then you need to edit Driver.hs and change "baseDir" to point to your GHC
-libraries directory.
-
-Once you've done that, the ext-core library can be built in the usual
-Cabal manner:
-1. runhaskell Setup.lhs configure
-2. runhaskell Setup.lhs build
-3. runhaskell Setup.lhs install
-
-Then, you can build the example Driver program with:
-  ghc -package extcore Driver.hs -o Driver
-
-And finally, you can use the included Makefile to run tests:
-
-  make nofibtest (to run the parser/checker on all nofib programs...
-   for example.)
-  make libtest (to typecheck all the libraries)
-
-Tested with GHC 6.8.2. I make no claims of portability.
-
-

diff --git a/utils/ext-core/Setup.lhs b/utils/ext-core/Setup.lhs
deleted file mode 100644 (file)
index 35661d4..0000000
--- a/utils/ext-core/Setup.lhs
+++ /dev/null
@@ -1,68 +0,0 @@
-#!/usr/bin/env runhaskell
-\begin{code}
-{-# OPTIONS -Wall -cpp #-}
-
-import Control.Monad
-import Distribution.PackageDescription
-import Distribution.Simple
-import Distribution.Simple.LocalBuildInfo
-import Distribution.Simple.Utils
-import System.Cmd
-import System.FilePath
-import System.Exit
-import System.Directory
-import Control.Exception
-
-main :: IO ()
-main = do
-   let hooks = simpleUserHooks {
-                 buildHook = build_primitive_sources 
-                           $ buildHook simpleUserHooks
-            }
-   defaultMainWithHooks hooks
-\end{code}
-
-Mostly snarfed from ghc-prim's Setup.hs.
-
-\begin{code}
-type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
-
-
--- Hack: If PrimEnv.hs exists *and* genprimopcode or
--- primops.txt doesn't exist, don't rebuild PrimEnv.hs
-
-build_primitive_sources :: Hook a -> Hook a
-build_primitive_sources f pd lbi uhs x
- = do when (compilerFlavor (compiler lbi) == GHC) $ do
-          let genprimopcode = joinPath ["..", "..", "utils",
-                                        "genprimopcode", "genprimopcode"]
-              primops = joinPath ["..", "..", "compiler", "prelude",
-                                  "primops.txt"]
-              primhs = joinPath ["Language", "Core", "PrimEnv.hs"]
-              primhs_tmp = addExtension primhs "tmp"
-          primEnvExists <- doesFileExist primhs
-          genprimopcodeExists <- doesFileExist genprimopcode
-          primopsExists <- doesFileExist primops
-          unless (primEnvExists && not genprimopcodeExists && not primopsExists) $ do
-             maybeExit $ system (genprimopcode ++ " --make-ext-core-source < "
-                           ++ primops ++ " > " ++ primhs_tmp)
-             maybeUpdateFile primhs_tmp primhs
-             maybeExit $ system ("make -C lib/GHC_ExtCore")
-      f pd lbi uhs x
-
--- Replace a file only if the new version is different from the old.
--- This prevents make from doing unnecessary work after we run 'setup makefile'
-maybeUpdateFile :: FilePath -> FilePath -> IO ()
-maybeUpdateFile source target = do
-  r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
-  case r of
-    ExitSuccess   -> removeFile source
-    ExitFailure _ -> do 
-#if __GLASGOW_HASKELL__ >= 610
-      (try :: IO () -> IO (Either IOException ()))
-#else
-      try
-#endif 
-       (removeFile target)
-      renameFile source target
-\end{code}
\ No newline at end of file

diff --git a/utils/ext-core/extcore.cabal b/utils/ext-core/extcore.cabal
deleted file mode 100644 (file)
index bb17b81..0000000
--- a/utils/ext-core/extcore.cabal
+++ /dev/null
@@ -1,28 +0,0 @@
-name:                extcore
-version:             0.1
-synopsis:            Libraries for processing GHC Core
-description:         Libraries for processing GHC Core
-category:            Language
-license:             BSD3
-license-file:        LICENSE
-author:              Andrew Tolmach, Tim Chevalier, The GHC Team
-maintainer:          chevalier@alum.wellesley.edu
-stability:           alpha
-tested-with:         GHC ==6.8.2, GHC==6.10.1
-data-files:          README
-build-type:          Simple
-cabal-version:       >=1.2
-Library {
-  exposed-modules:     Language.Core.Check, Language.Core.Dependencies, Language.Core.Core, Language.Core.Interp, Language.Core.Overrides, Language.Core.ParsecParser, Language.Core.Prep, Language.Core.Prims, Language.Core.Printer, Language.Core.Merge, Language.Core.ElimDeadCode, Language.Core.Encoding, Language.Core.Env, Language.Core.CoreUtils
-  other-modules:       Language.Core.PrimCoercions, Language.Core.PrimEnv, Language.Core.Utils, Language.Core.Environments
-  extensions:          DeriveDataTypeable PatternGuards RankNTypes ScopedTypeVariables
-  ghc-options:         -Wall -O2
-  build-depends:       base, containers, directory, filepath, mtl, parsec, pretty
-  if impl(ghc > 6.8.2) {
-     build-depends:syb
-  }
-  else {
-     extensions: PatternSignatures
-  }
-}
-

diff --git a/utils/ext-core/lib/GHC_ExtCore/Handle.hs b/utils/ext-core/lib/GHC_ExtCore/Handle.hs
deleted file mode 100644 (file)
index 6417c28..0000000
--- a/utils/ext-core/lib/GHC_ExtCore/Handle.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
-
--- Replacement for GHC.Handle module
-
-module GHC_ExtCore.Handle(Handle(..), stdin, stderr, stdout, hFlush) where
-
-import GHC.Exts
-
-newtype Handle = H Int
-
--- these shouldn't actually get used
-stdout, stdin, stderr :: Handle
-stdin  = H 0
-stdout = H 1
-stderr = H 2
-
--- ditto
-hFlush :: Handle -> IO ()
-hFlush _ = return ()

diff --git a/utils/ext-core/lib/GHC_ExtCore/IO.hs b/utils/ext-core/lib/GHC_ExtCore/IO.hs
deleted file mode 100644 (file)
index 81d9226..0000000
--- a/utils/ext-core/lib/GHC_ExtCore/IO.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
-
--- Replacement for GHC.IO module
-
-module GHC_ExtCore.IO where
-
-import GHC.Exts
-import GHC_ExtCore.Handle
-
-hPutStr :: Handle -> String -> IO ()
-hPutStr h s = mapM_ (hPutChar h) s
-
-hPutChar :: Handle -> Char -> IO ()
-hPutChar (H (I# i)) (C# c) = hPutChar# i c
-
-------------------------------------------------------------
--- fake stubs for primops to fool GHC into typechecking this
-------------------------------------------------------------
-{-# NOINLINE hPutChar# #-}
-hPutChar# :: Int# -> Char# -> IO ()
-hPutChar# _ _ = return ()

diff --git a/utils/ext-core/lib/GHC_ExtCore/Makefile b/utils/ext-core/lib/GHC_ExtCore/Makefile
deleted file mode 100644 (file)
index 93b95a7..0000000
--- a/utils/ext-core/lib/GHC_ExtCore/Makefile
+++ /dev/null
@@ -1,5 +0,0 @@
-all:   Handle.hs IO.hs Unicode.hs
-       ghc -c -fext-core -package-name base-extcore Handle.hs IO.hs Unicode.hs -cpp -i../
-
-clean:
-       rm -f *.hcr *.hi *.o

diff --git a/utils/ext-core/lib/GHC_ExtCore/Unicode.hs b/utils/ext-core/lib/GHC_ExtCore/Unicode.hs
deleted file mode 100644 (file)
index 13c24db..0000000
--- a/utils/ext-core/lib/GHC_ExtCore/Unicode.hs
+++ /dev/null
@@ -1,252 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
-
--- Replacement for GHC.Unicode module
-
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS -#include "WCsubst.h" #-}
-{-# OPTIONS_HADDOCK hide #-}
------------------------------------------------------------------------------
--- |
--- Module      :  GHC.Unicode
--- Copyright   :  (c) The University of Glasgow, 2003
--- License     :  see libraries/base/LICENSE
--- 
--- Maintainer  :  cvs-ghc@haskell.org
--- Stability   :  internal
--- Portability :  non-portable (GHC extensions)
---
--- Implementations for the character predicates (isLower, isUpper, etc.)
--- and the conversions (toUpper, toLower).  The implementation uses
--- libunicode on Unix systems if that is available.
---
------------------------------------------------------------------------------
-
--- #hide
-module GHC_ExtCore.Unicode (
-    isAscii, isLatin1, isControl,
-    isAsciiUpper, isAsciiLower,
-    isPrint, isSpace,  isUpper,
-    isLower, isAlpha,  isDigit,
-    isOctDigit, isHexDigit, isAlphaNum,
-    toUpper, toLower, toTitle,
-    wgencat, isSpace#
-  ) where
-
-import GHC.Base
-import GHC.Real  (fromIntegral)
-import GHC.Int
-import GHC.Word
-import GHC.Num   (fromInteger)
-
-#include "HsBaseConfig.h"
-
--- | Selects the first 128 characters of the Unicode character set,
--- corresponding to the ASCII character set.
-isAscii                 :: Char -> Bool
-isAscii c               =  c <  '\x80'
-
--- | Selects the first 256 characters of the Unicode character set,
--- corresponding to the ISO 8859-1 (Latin-1) character set.
-isLatin1                :: Char -> Bool
-isLatin1 c              =  c <= '\xff'
-
--- | Selects ASCII lower-case letters,
--- i.e. characters satisfying both 'isAscii' and 'isLower'.
-isAsciiLower :: Char -> Bool
-isAsciiLower c          =  c >= 'a' && c <= 'z'
-
--- | Selects ASCII upper-case letters,
--- i.e. characters satisfying both 'isAscii' and 'isUpper'.
-isAsciiUpper :: Char -> Bool
-isAsciiUpper c          =  c >= 'A' && c <= 'Z'
-
--- | Selects control characters, which are the non-printing characters of
--- the Latin-1 subset of Unicode.
-isControl               :: Char -> Bool
-
--- | Selects printable Unicode characters
--- (letters, numbers, marks, punctuation, symbols and spaces).
-isPrint                 :: Char -> Bool
-
-{-
--- | Selects white-space characters in the Latin-1 range.
--- (In Unicode terms, this includes spaces and some control characters.)
-isSpace                 :: Char -> Bool
--- isSpace includes non-breaking space
--- Done with explicit equalities both for efficiency, and to avoid a tiresome
--- recursion with GHC.List elem
-isSpace c               =  c == ' '     ||
-                           c == '\t'    ||
-                           c == '\n'    ||
-                           c == '\r'    ||
-                           c == '\f'    ||
-                           c == '\v'    ||
-                           c == '\xa0'  ||
-                           iswspace (fromIntegral (ord c)) /= 0
--}
-
--- | Selects upper-case or title-case alphabetic Unicode characters (letters).
--- Title case is used by a small number of letter ligatures like the
--- single-character form of /Lj/.
-isUpper                 :: Char -> Bool
-
--- | Selects lower-case alphabetic Unicode characters (letters).
-isLower                 :: Char -> Bool
-
--- | Selects alphabetic Unicode characters (lower-case, upper-case and
--- title-case letters, plus letters of caseless scripts and modifiers letters).
--- This function is equivalent to 'Data.Char.isLetter'.
-isAlpha                 :: Char -> Bool
-
--- | Selects alphabetic or numeric digit Unicode characters.
---
--- Note that numeric digits outside the ASCII range are selected by this
--- function but not by 'isDigit'.  Such digits may be part of identifiers
--- but are not used by the printer and reader to represent numbers.
-isAlphaNum              :: Char -> Bool
-
--- | Selects ASCII digits, i.e. @\'0\'@..@\'9\'@.
-isDigit                 :: Char -> Bool
-isDigit c               =  c >= '0' && c <= '9'
-
--- | Selects ASCII octal digits, i.e. @\'0\'@..@\'7\'@.
-isOctDigit              :: Char -> Bool
-isOctDigit c            =  c >= '0' && c <= '7'
-
--- | Selects ASCII hexadecimal digits,
--- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@.
-isHexDigit              :: Char -> Bool
-isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
-                                        c >= 'a' && c <= 'f'
-
--- | Convert a letter to the corresponding upper-case letter, if any.
--- Any other character is returned unchanged.
-toUpper                 :: Char -> Char
-
--- | Convert a letter to the corresponding lower-case letter, if any.
--- Any other character is returned unchanged.
-toLower                 :: Char -> Char
-
--- | Convert a letter to the corresponding title-case or upper-case
--- letter, if any.  (Title case differs from upper case only for a small
--- number of ligature letters.)
--- Any other character is returned unchanged.
-toTitle                 :: Char -> Char
-
--- -----------------------------------------------------------------------------
--- Implementation with the supplied auto-generated Unicode character properties
--- table (default)
-
-#if 1
-
--- Regardless of the O/S and Library, use the functions contained in WCsubst.c
-
-type CInt = HTYPE_INT
-
-isAlphaNum c = iswalnum (fromIntegral (ord c)) /= 0
---isSpace    c = iswspace (fromIntegral (ord c)) /= 0
-isControl  c = iswcntrl (fromIntegral (ord c)) /= 0
-isPrint    c = iswprint (fromIntegral (ord c)) /= 0
-isUpper    c = iswupper (fromIntegral (ord c)) /= 0
-isLower    c = iswlower (fromIntegral (ord c)) /= 0
-
-toLower c = chr (fromIntegral (towlower (fromIntegral (ord c))))
-toUpper c = chr (fromIntegral (towupper (fromIntegral (ord c))))
-toTitle c = chr (fromIntegral (towtitle (fromIntegral (ord c))))
-
-foreign import ccall unsafe "u_iswdigit"
-  iswdigit :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswalpha"
-  iswalpha :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswalnum"
-  iswalnum :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswcntrl"
-  iswcntrl :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswspace"
-  iswspace :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswprint"
-  iswprint :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswlower"
-  iswlower :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswupper"
-  iswupper :: CInt -> CInt
-
-foreign import ccall unsafe "u_towlower"
-  towlower :: CInt -> CInt
-
-foreign import ccall unsafe "u_towupper"
-  towupper :: CInt -> CInt
-
-foreign import ccall unsafe "u_towtitle"
-  towtitle :: CInt -> CInt
-
-foreign import ccall unsafe "u_gencat"
-  wgencat :: CInt -> CInt
-
--- -----------------------------------------------------------------------------
--- No libunicode, so fall back to the ASCII-only implementation (never used, indeed)
-
-#else
-
-isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
-isPrint c               =  not (isControl c)
-
--- The upper case ISO characters have the multiplication sign dumped
--- randomly in the middle of the range.  Go figure.
-isUpper c               =  c >= 'A' && c <= 'Z' ||
-                           c >= '\xC0' && c <= '\xD6' ||
-                           c >= '\xD8' && c <= '\xDE'
--- The lower case ISO characters have the division sign dumped
--- randomly in the middle of the range.  Go figure.
-isLower c               =  c >= 'a' && c <= 'z' ||
-                           c >= '\xDF' && c <= '\xF6' ||
-                           c >= '\xF8' && c <= '\xFF'
-
-isAlpha c               =  isLower c || isUpper c
-isAlphaNum c            =  isAlpha c || isDigit c
-
--- Case-changing operations
-
-toUpper c@(C# c#)
-  | isAsciiLower c    = C# (chr# (ord# c# -# 32#))
-  | isAscii c         = c
-    -- fall-through to the slower stuff.
-  | isLower c   && c /= '\xDF' && c /= '\xFF'
-  = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
-  | otherwise
-  = c
-
-
-toLower c@(C# c#)
-  | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
-  | isAscii c      = c
-  | isUpper c      = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
-  | otherwise      =  c
-
-#endif
-
--------------------------------------------------------------
-
-isSpace :: Char -> Bool
-isSpace (C# c) = isSpace# c
-
-isAlpha (C# c) = isAlpha# c
-
-------------------------------------------------------------
--- fake stubs for primops to fool GHC into typechecking this
-------------------------------------------------------------
-{-# NOINLINE isSpace# #-}
-isSpace# :: Char# -> Bool
-isSpace# _ = True
-
-{-# NOINLINE isAlpha# #-}
-isAlpha# :: Char# -> Bool
-isAlpha# _ = False
-