| ... |
... |
@@ -42,21 +42,27 @@ createBCOs objs = do |
|
42
|
42
|
|
|
43
|
43
|
let (unl_objs, bcos) = partition isUnliftedObj objs
|
|
44
|
44
|
|
|
45
|
|
- -- First, construct the array of unlifted static cons.
|
|
46
|
|
- -- Top-level unlifted constructors are never mutual recursive, so we can do
|
|
47
|
|
- -- this by filling the array on demand
|
|
48
|
|
- -- (it's also not possible to define a mutually recursive unlifted
|
|
49
|
|
- -- top-level value, see [GHC-20185]),
|
|
50
|
|
- (unl_cons, unl_hvals) <- createUnliftedStaticCons unl_objs
|
|
51
|
|
-
|
|
52
|
|
- -- Second, construct the lifted BCOs and static cons which may have
|
|
53
|
|
- -- (circular) references to one another in this group. References from this
|
|
54
|
|
- -- group to the unlifted static cons will be resolved by looking them up in
|
|
55
|
|
- -- the array constructed in the first pass.
|
|
|
45
|
+ -- [BCO, BCO, BCO{ INSTRS=[0, 3] }, BCO{ INSTRS=[2, 3] }]
|
|
|
46
|
+
|
|
|
47
|
+ -- unl_arr = [newConApp {PtrArr lifted:(arr ! 0), UNLIFTED:seq (unl_arr!0) --- is that 0 has already been computed}]
|
|
|
48
|
+ -- arr = [newBCO {PtrArr (arr ! 0) UNLIFTED_KIND}, newBCO {PtrArr (arr ! 2) (arr ! 3)]
|
|
|
49
|
+
|
|
56
|
50
|
let n_bcos = length bcos
|
|
57
|
|
- hvals <- fixIO $ \hvs -> do
|
|
58
|
|
- let arr = listArray (0, n_bcos-1) hvs
|
|
59
|
|
- mapM (createBCO arr unl_cons) bcos
|
|
|
51
|
+ (unl_hvals, hvals) <- fixIO $ \ ~(_, hvs) -> do
|
|
|
52
|
+
|
|
|
53
|
+ let arr = listArray (0, n_bcos-1) hvs
|
|
|
54
|
+
|
|
|
55
|
+ -- First, construct the array of unlifted static cons.
|
|
|
56
|
+ -- Top-level unlifted constructors are never mutual recursive, so we can do
|
|
|
57
|
+ -- this by filling the array on demand (with lazy references to lifted things)
|
|
|
58
|
+ (unl_cons, unl_hvals) <- createUnliftedStaticCons unl_objs arr
|
|
|
59
|
+
|
|
|
60
|
+ -- Second, construct the lifted BCOs and static cons which may have
|
|
|
61
|
+ -- (circular) references to one another in this group. References from this
|
|
|
62
|
+ -- group to the unlifted static cons will be resolved by looking them up in
|
|
|
63
|
+ -- the array constructed in the first pass.
|
|
|
64
|
+ hvals <- mapM (createBCO arr unl_cons) bcos
|
|
|
65
|
+ return (unl_hvals, hvals)
|
|
60
|
66
|
|
|
61
|
67
|
mapM mkRemoteRef (unl_hvals ++ hvals)
|
|
62
|
68
|
|
| ... |
... |
@@ -109,10 +115,12 @@ data LinkedBCO |
|
109
|
115
|
|
|
110
|
116
|
-- | From a list of 'UnliftedStaticCon's, create an array of unlifted heap closures
|
|
111
|
117
|
-- Invariant: All ResolvedBCOs are UnliftedStaticCons
|
|
112
|
|
-createUnliftedStaticCons :: [ResolvedBCO] -> IO (UnlConsArr, [HValue {- references to actually unlifted values, but we "forget" that -}])
|
|
113
|
|
-createUnliftedStaticCons objs = do
|
|
|
118
|
+createUnliftedStaticCons :: [ResolvedBCO] -> Array Int HValue
|
|
|
119
|
+ -> IO (UnlConsArr, [HValue {- references to actually unlifted values, but we "forget" that -}])
|
|
|
120
|
+createUnliftedStaticCons objs lif_arr = do
|
|
114
|
121
|
-- Ensure objs are topologically sorted by their dependencies
|
|
115
|
|
- -- Then, just fill them in in order!
|
|
|
122
|
+ -- Then, just fill them in in order! TODOOOOO
|
|
|
123
|
+ -- assert ... TOPO Sort
|
|
116
|
124
|
let !(I# arr_size#) = length objs
|
|
117
|
125
|
!(EmptyArr emp_arr#) = emptyArr
|
|
118
|
126
|
ucarr@(UnlConsArr unl_arr#) <- IO $ \s ->
|
| ... |
... |
@@ -123,8 +131,9 @@ createUnliftedStaticCons objs = do |
|
123
|
131
|
| resolvedStaticConIsUnlifted
|
|
124
|
132
|
-> do
|
|
125
|
133
|
-- Because we topologically sort the objs, it's safe to assume all
|
|
126
|
|
- -- references will already be filled in.
|
|
127
|
|
- lbc <- linkBCO' (error "there should be no lifted dependencies for unlifted objs") ucarr obj
|
|
|
134
|
+ -- references we care about here will already be filled in.
|
|
|
135
|
+ -- todo: assert all references are lower than current ix.
|
|
|
136
|
+ lbc <- linkBCO' lif_arr ucarr obj
|
|
128
|
137
|
case lbc of
|
|
129
|
138
|
LinkedUnliftedStaticCon linked_static_con -> do
|
|
130
|
139
|
IO $ \s ->
|