[move IO and tuples to jhc-prim
John Meacham <john@repetae.net>**20120122093125
 Ignore-this: 53dae55e305bd20b6966a46868ce2ca8
] hunk ./Makefile.am 71
-all-local: libs
+all-local: $(JHC_LIBS)
hunk ./lib/jhc-prim/Jhc/Prim/Bits.hs 33
-data Complex_ :: # -> #
+-- data Complex_ :: # -> #
hunk ./lib/jhc-prim/Jhc/Prim/Bits.hs 35
--- these newtypes exist to modify the 
+-- these newtypes exist to modify the
hunk ./lib/jhc-prim/Jhc/Prim/IO.hs 3
-data State_ s :: #
-data RealWorld
+data State_ :: * -> #
+data RealWorld :: *
hunk ./lib/jhc-prim/Jhc/Prim/IO.hs 6
-type STRep s a = State_ s -> (# State_ s, a #)
hunk ./lib/jhc-prim/Jhc/Prim/IO.hs 7
-type UIO a = STRep RealWorld a
+
+type UST s a = State_ s -> (# State_ s, a #)
+type UST_ s = State_ s -> State_ s
+type UIO a = UST RealWorld a
hunk ./lib/jhc-prim/Jhc/Prim/IO.hs 13
-newtype IO a = IO (STRep RealWorld a)
-newtype ST s a = ST (STRep s a)
+newtype IO a = IO (UST RealWorld a)
+newtype ST s a = ST (UST s a)
+newtype ACIO a = ACIO (IO a)
hunk ./lib/jhc-prim/Jhc/Prim/Prim.hs 1
+-- This module is always included behind the scenes when compiling.
+-- It will not bring any code into the system, but brings several
+-- names and type definitions into scope that the compiler expects
+-- to exist.
hunk ./lib/jhc-prim/Jhc/Prim/Prim.hs 7
-data (->) :: ?? -> ? -> *
+import Jhc.Prim.Bits
+import Jhc.Prim.IO
hunk ./lib/jhc-prim/Jhc/Prim/Prim.hs 10
-foreign import primitive "unsafeCoerce" unsafeCoerce__ :: a -> b
+data (->) :: ?? -> ? -> *
hunk ./lib/jhc-prim/Jhc/Prim/Prim.hs 12
--- like 'const' but creates an artificial dependency on its second argument to guide optimization.
-foreign import primitive dependingOn :: a -> b -> a
+data () = ()
+data (,) a b = (,) a b
+data (,,) a b c = (,,) a b c
+data (,,,) a b c d = (,,,) a b c d
+data (,,,,) a b c d e = (,,,,) a b c d e
+data (,,,,,) a b c d e f = (,,,,,) a b c d e f
+data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
+data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
+data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
addfile ./lib/jhc-prim/Jhc/Prim/Wrapper.hs
hunk ./lib/jhc-prim/Jhc/Prim/Wrapper.hs 1
+module Jhc.Prim.Wrapper where
+
+import Jhc.Prim.IO
+
+-- | when no exception wrapper is wanted
+runNoWrapper :: IO a -> World__ -> World__
+runNoWrapper (IO run) w = case run w of (# w, _ #) -> w
+
+-- | this is wrapped around arbitrary expressions and just
+-- evaluates them to whnf
+foreign import primitive "seq" runRaw :: a -> World__ -> World__
hunk ./lib/jhc-prim/jhc-prim.yaml 8
-        - Jhc.Prim.Words
+#        - Jhc.Prim.Words
hunk ./lib/jhc-prim/jhc-prim.yaml 11
+        - Jhc.Prim.Wrapper
hunk ./lib/jhc/Jhc/Basics.hs 4
-import Jhc.Prim
hunk ./lib/jhc/Jhc/Basics.hs 5
+import Jhc.Prim
hunk ./lib/jhc/Jhc/Basics.hs 7
-data (->) :: ?? -> ? -> *
hunk ./lib/jhc/Jhc/Basics.hs 11
-data () = ()
-data (,) a b = (,) a b
-data (,,) a b c = (,,) a b c
-data (,,,) a b c d = (,,,) a b c d
-data (,,,,) a b c d e = (,,,,) a b c d e
-data (,,,,,) a b c d e f = (,,,,,) a b c d e f
-data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
-data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
-data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
-
-
-
hunk ./lib/jhc/Jhc/Basics.hs 35
-
hunk ./lib/jhc/Jhc/Basics.hs 38
-
hunk ./lib/jhc/Jhc/Basics.hs 49
-
-
hunk ./lib/jhc/Jhc/Basics.hs 53
-
hunk ./lib/jhc/Jhc/Basics.hs 64
-
-
hunk ./lib/jhc/Jhc/Basics.hs 71
-
-
hunk ./lib/jhc/Jhc/Basics.hs 77
-
hunk ./lib/jhc/Jhc/Basics.hs 81
-
hunk ./lib/jhc/Jhc/Basics.hs 86
-
-
hunk ./lib/jhc/Jhc/Basics.hs 92
-
hunk ./lib/jhc/Jhc/Basics.hs 97
-
hunk ./lib/jhc/Jhc/Basics.hs 110
-
hunk ./lib/jhc/Jhc/Basics.hs 116
-
hunk ./lib/jhc/Jhc/Basics.hs 121
-
hunk ./lib/jhc/Jhc/IO.hs 31
-import Jhc.Prim
+import Foreign.C.Types
hunk ./lib/jhc/Jhc/IO.hs 34
-import Foreign.C.Types
+import Jhc.Prim
+import Jhc.Prim.IO
hunk ./lib/jhc/Jhc/IO.hs 38
-
hunk ./lib/jhc/Jhc/IO.hs 40
-
hunk ./lib/jhc/Jhc/IO.hs 43
-type UIO a = World__ -> (# World__, a #)
-type UIO_ = World__ -> World__
-
hunk ./lib/jhc/Jhc/IO.hs 49
-
hunk ./lib/jhc/Jhc/IO.hs 73
-
hunk ./lib/jhc/Jhc/IO.hs 95
-
hunk ./lib/jhc/Jhc/IO.hs 100
-
hunk ./lib/jhc/Jhc/IO.hs 113
-
hunk ./lib/jhc/Jhc/IO.hs 115
-
hunk ./lib/jhc/Jhc/IO.hs 134
-
-
-
hunk ./lib/jhc/Jhc/IO.hs 139
-
hunk ./lib/jhc/Jhc/IO.hs 159
-
hunk ./lib/jhc/Jhc/Prim.hs 2
-module Jhc.Prim(module Jhc.Prim.Bits, module Jhc.Prim) where
+module Jhc.Prim(module Jhc.Prim.Bits, module Jhc.Prim, module Jhc.Prim.IO) where
hunk ./lib/jhc/Jhc/Prim.hs 6
+import Jhc.Prim.IO
hunk ./lib/jhc/Jhc/Prim.hs 11
-newtype IO a = IO (World__ -> (# World__, a #))
+--newtype IO a = IO (World__ -> (# World__, a #))
hunk ./lib/jhc/Jhc/Prim.hs 13
-data World__ :: #
+--data World__ :: #
hunk ./regress/tests/1_typecheck/config.yaml 1
-jhc_flags: --stop typecheck --stale Main --no-ho -pcontainers
+jhc_flags: --stop typecheck --stale Main --no-ho
hunk ./src/DataConstructors.hs 200
-    conInhabits = tStar, conOrigSlots = map SlotNormal sts }) where
+    conInhabits = s_Star, conOrigSlots = map SlotNormal sts }) where
hunk ./src/DataConstructors.hs 233
-            conInhabits = tHash,
+            conInhabits = s_Hash,
hunk ./src/DataConstructors.hs 268
-            conInhabits = tStar,
+            conInhabits = s_Star,
hunk ./src/DataConstructors.hs 276
-    conInhabits = tHash,
+    conInhabits = s_Hash,
hunk ./src/DataConstructors.hs 293
-            conInhabits = tStar,
+            conInhabits = s_Star,
hunk ./src/DataConstructors.hs 388
-    f e@(ELit LitCons { litName = c }) | c == tc_Unit || c == tc_World__ = return ExtTypeVoid
+    f e@(ELit LitCons { litName = c }) | c == tc_Unit || c == tc_State_ = return ExtTypeVoid
hunk ./src/DataConstructors.hs 496
-{-
-create_integralCast_toInt c1 t1 e = create_integralCast Op.I2I c1 t1 dc_Int tIntzh e tInt
-create_integralCast_toInteger c1 t1 e = create_integralCast Op.Sx c1 t1 dc_Integer tIntegerzh e tInteger
-create_integralCast_fromInt c2 t2 e t = create_integralCast Op.I2I dc_Int tIntzh c2 t2 e t
-create_integralCast_fromInteger c2 t2 e t = create_integralCast Op.Lobits dc_Integer tIntegerzh c2 t2 e t
-
-create_uintegralCast_toInteger c1 t1 e = create_integralCast Op.Zx c1 t1 dc_Integer tIntegerzh e tInteger
-create_uintegralCast_fromInt c2 t2 e t = create_integralCast Op.U2U dc_Int tIntzh c2 t2 e t
-create_uintegralCast_fromInteger c2 t2 e t = create_integralCast Op.Lobits dc_Integer tIntegerzh c2 t2 e t
--}
hunk ./src/DataConstructors.hs 548
-                conInhabits = tHash,
+                conInhabits = s_Hash,
hunk ./src/DataConstructors.hs 634
-            conInhabits = if theTypeFKind == eStar then tStar else tHash,
+            conInhabits = if theTypeFKind == eStar then s_Star else s_Hash,
hunk ./src/DataConstructors.hs 919
-    (tc_World__,  "void")
+    (tc_State_,  "void")
hunk ./src/E/Annotate.hs 29
-    let nimap = fromList [ (combIdent c, Just . EVar $ combHead c) | c <- cs ] `mappend` imap
+    let nimap = fromList [ (combIdent c, Just . EVar $ combHead c) | c <- cs ]
+            `mappend` imap
hunk ./src/E/E.hs 38
-    tStar = eStar
hunk ./src/E/E.hs 45
-    tWorld__ = ELit (litCons { litName = tWorld__, litArgs = [], litType = eHash })
+--    tWorld__ = ELit (litCons { litName = tWorld__, litArgs = [], litType = eHash })
+    tWorld__ = ELit (litCons { litName = tc_State_, litArgs = [realWorld], litType = eHash }) where
+        realWorld = ELit (litCons { litName = tc_RealWorld, litArgs = [], litType = eStar })
hunk ./src/E/E.hs 50
-    tIntegerzh = ELit (litCons { litName = tIntegerzh, litArgs = [], litType = eHash })
hunk ./src/E/E.hs 52
+tIntegerzh = ELit (litCons { litName = rt_bits_max_, litArgs = [], litType = eHash })
+
hunk ./src/E/FromHs.hs 120
+monadicLookup' k m = case Map.lookup k m of
+    Just x  -> return x
+    Nothing -> fail $ "key not found: " ++ show k
+
hunk ./src/E/FromHs.hs 127
-    t <- monadicLookup n assumps
+    t <- monadicLookup' n assumps
hunk ./src/E/FromHs.hs 158
-  let funcs = runIdentity $ T.mapM (\n -> return . EVar . fst $ runEither (show n) $ monadicLookup n ds) sFuncNames
+  let funcs = runIdentity $ T.mapM (\n -> return . EVar . fst $ runEither (show n) $ monadicLookup' n ds) sFuncNames
hunk ./src/E/LetFloat.hs 86
-canFloatPast t | getType t == tWorldzh = True
+--canFloatPast t | getType t == tWorldzh = True
+canFloatPast t | isState_ (getType t) = True
hunk ./src/E/TypeCheck.hs 191
-        | otherwise = maybe (error $ "getType: " ++ show e) ESort $ do
+        | otherwise = maybe (error $ "E.TypeCheck.getType: " ++ show (e,getType a,getType b)) ESort $ do
hunk ./src/E/Values.hs 162
-tWorldzh = ELit litCons { litName = tc_World__, litArgs = [], litType = eHash }
+--tWorldzh = ELit litCons { litName = tc_World__, litArgs = [], litType = eHash }
+isState_ e = case e of
+    ELit (LitCons { litName = name }) | name == tc_State_ -> True
+    _ -> False
hunk ./src/FrontEnd/HsParser.y 1080
-tuple_con_name i      = toName DataConstructor ("Jhc.Basics","("++replicate i ','++")")
+tuple_con_name i      = toName DataConstructor ("Jhc.Prim.Prim","("++replicate i ','++")")
hunk ./src/FrontEnd/Rename.hs 71
-            | Just _ <- V.fromTupname hsName, Module "Jhc.Basics" <- mod
+            | Just _ <- V.fromTupname hsName, Module "Jhc.Prim.Prim" <- mod
hunk ./src/FrontEnd/Rename.hs 73
-            | nameName tc_Arrow == hsName, Module "Jhc.Basics" == mod
+            | nameName tc_Arrow == hsName, Module "Jhc.Prim.Prim" == mod
hunk ./src/FrontEnd/Rename.hs 849
-
hunk ./src/FrontEnd/Tc/Main.hs 408
-        _ -> ty `boxyMatch` (TCon (Tycon tc_Int__ kindHash))
+        _ -> ty `boxyMatch` (TCon (Tycon tc_Bits32 kindHash))
hunk ./src/FrontEnd/Tc/Main.hs 869
-
-
hunk ./src/Grin/FromE.hs 66
-    (tc_World__,TyUnit),
+    (tc_State_,TyUnit),
hunk ./src/Ho/Build.hs 107
-    | ModLibrary Bool ModuleGroup Library
+    | ModLibrary !Bool ModuleGroup Library
hunk ./src/Ho/Build.hs 621
-hsModuleRequires x = snub (Module "Jhc.Prim.Bits":ans) where
+hsModuleRequires x = snub (Module "Jhc.Prim.Prim":ans) where
hunk ./src/Name/Names.hs 23
-    tStar = s_Star
-    tHash = s_Hash
hunk ./src/Name/Names.hs 27
-    tIntegerzh = rt_bits_max_
-    tWorld__ = tc_World__
+--    tWorld__ = tc_World__
hunk ./src/Name/Names.hs 42
-    fromTupname name | m == "Jhc.Basics" = fromTupname (nn::String) where
+    fromTupname name | m == "Jhc.Prim.Prim" = fromTupname (nn::String) where
hunk ./src/Name/Names.hs 46
-tc_Arrow = toName TypeConstructor  ("Jhc.Basics","->")
-
hunk ./src/Name/VConsts.hs 16
-    tIntegerzh :: a
hunk ./src/Name/VConsts.hs 17
-    tStar :: a
-    tHash :: a
hunk ./src/Name/VConsts.hs 27
---    tEnumzh = error "tEnumzh"
-    tIntegerzh = error "tIntegerzh"
+    tEnumzh = error "tEnumzh"
hunk ./src/Name/VConsts.hs 29
-    tStar = error "VConsts: tStar"
hunk ./src/Name/VConsts.hs 33
-    tHash = error "tHash"
hunk ./src/Name/VConsts.hs 38
-    vEmptyList :: a
hunk ./src/Name/VConsts.hs 40
-    vOrdering :: Ordering -> a
hunk ./src/Name/VConsts.hs 43
-    vEmptyList = error "vEmptyList"
hunk ./src/Name/VConsts.hs 45
-    vOrdering x = error $ "v" ++ show x
hunk ./src/Name/VConsts.hs 54
-    fromTupname ("Jhc.Basics",n) = fromTupname n
+    fromTupname ("Jhc.Prim.Prim",n) = fromTupname n
hunk ./src/Name/VConsts.hs 64
-    toTuple n = ("Jhc.Basics",toTuple n)
+    toTuple n = ("Jhc.Prim.Prim",toTuple n)
hunk ./src/data/names.txt 1
-
hunk ./src/data/names.txt 3
+Arrow      Jhc.Prim.Prim.->
hunk ./src/data/names.txt 8
-IO         Jhc.Prim.IO
-World__    Jhc.Prim.World__
-Int__      Jhc.Prim.Int__
+IO         Jhc.Prim.IO.IO
+ACIO       Jhc.Prim.IO.ACIO
+State_     Jhc.Prim.IO.State_
+RealWorld  Jhc.Prim.IO.RealWorld
+#World__   Jhc.Prim.World__
+#Int__     Jhc.Prim.Int__
hunk ./src/data/names.txt 20
-Unit       Jhc.Basics.()
+Unit       Jhc.Prim.Prim.()
hunk ./src/data/names.txt 76
-Unit       Jhc.Basics.()
+Unit       Jhc.Prim.Prim.()
hunk ./src/data/names.txt 155
-runRaw               Jhc.Prim.runRaw
+runRaw               Jhc.Prim.Wrapper.runRaw
hunk ./src/data/names.txt 157
-runNoWrapper         Jhc.Prim.runNoWrapper
+runNoWrapper         Jhc.Prim.Wrapper.runNoWrapper
hunk ./utils/op_names.prl 71
-    /^([_A-Za-z0-9]+)\s+(([0-9_A-Za-z.@]+)\.)?([0-9)(#&|><=\/A-Za-z%:_\[\]]+)\s*$/ or die "unrecognized line $_";
+    /^([_A-Za-z0-9]+)\s+(([0-9_A-Za-z.@]+)\.)?([-0-9)(#&|><=\/A-Za-z%:_\[\]]+)\s*$/ or die "unrecognized line $_";