1	import Base
2	import entity_key.bend as Key
3	import entity_allocator.bend as Alloc
4	import relation_types.bend as G
5	import relation_graph.bend as C
6	import relation_commands.bend as A
7	import world.bend as W
8	
9	# Explicit experiment continuation. Exhaustion retains every affine owner/frame.
10	type CleanupResult<S: Data,C: Type,R: Type,E: Data> is Type:
11	  Complete{world: W.World<S,A.Store<S,C>,R,A.Notice<S,E>>}
12	  Incomplete{world: W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,frames: List<&2,G.CleanupFrame<S>>}
13	def snapshot(~S: Data,~C: Type,store: A.Store<S,C>,descriptor: G.Descriptor<S>,id:Key.Key) -> A.Store<S,C> & List<&2,Key.Key>:
14	  A.store_inverse(~S,~C,store,descriptor,id)
15	def clear_join(~S:Data,~C:Type,~E:Data,cleared:C & List<&2,A.Notice<S,E>>,graph:G.Graph<S>) -> A.Store<S,C> & List<&2,A.Notice<S,E>>:
16	  (components,notices) = cleared
17	  (A.Store{components,graph},notices)
18	def clear_store(~S: Data,~C: Type,~E: Data,~clear: C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,store: A.Store<S,C>,handle: W.Handle<S>) -> A.Store<S,C> & List<&2,A.Notice<S,E>>:
19	  match store:
20	    case A.Store{components,graph}: clear_join(~S,~C,~E,clear(components,handle),graph)
21	def publish_final(~S:Data,~C:Type,~R:Type,~E:Data,~record:W.Handle<S> -> A.Notice<S,E>,deactivated:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & W.Status,notices:List<&2,A.Notice<S,E>>,+handle:W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
22	  (world,_) = deactivated
23	  W.release_cleared(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,W.event_publish(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,List.append(&2,A.Notice<S,E>,notices,[record(handle)])),handle)
24	def finalized(~S: Data,~C: Type,~R: Type,~E: Data,~record: W.Handle<S> -> A.Notice<S,E>,cleared: W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,A.Notice<S,E>>,+handle: W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
25	  (world,notices) = cleared
26	  publish_final(~S,~C,~R,~E,~record,W.deactivate(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,handle),notices,handle)
27	def finish_live(~S: Data,~C: Type,~R: Type,~E: Data,~clear: C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record: W.Handle<S> -> A.Notice<S,E>,world: W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,+handle: W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
28	  finalized(~S,~C,~R,~E,~record,W.with_store(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,~List<&2,A.Notice<S,E>>,store => clear_store(~S,~C,~E,~clear,store,handle),world),handle)
29	# A paused continuation may outlive its full entity key. Validate before clear.
30	def finish_checked(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,checked:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Bool,handle:W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
31	  match checked:
32	    case (world,False{}):world
33	    case (world,True{}):finish_live(~S,~C,~R,~E,~clear,~record,world,handle)
34	def finish(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,+handle:W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
35	  finish_checked(~S,~C,~R,~E,~clear,~record,W.valid(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,handle),handle)
36	def entered(~S: Data,~C: Type,~R: Type,~E: Data,checked: W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Bool,id:Key.Key,descriptors: List<&2,G.Descriptor<S>>,frames: List<&2,G.CleanupFrame<S>>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.CleanupFrame<S>>:
37	  match checked:
38	    case (world,False{}): (world,frames)
39	    case (world,True{}): (world,G.CleanupDescriptors{id,descriptors} <> frames)
40	def children_start(~S: Data,~C: Type,~R: Type,~E: Data,observed: W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,Key.Key>,id:Key.Key,descriptor: G.Descriptor<S>,remaining: List<&2,G.Descriptor<S>>,frames: List<&2,G.CleanupFrame<S>>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.CleanupFrame<S>>:
41	  (world,children) = observed
42	  (world,G.CleanupChildren{id,descriptor,remaining,children} <> frames)
43	def child_step(~S: Data,~C: Type,~R: Type,~E: Data,kind: G.RelationKind,world: W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,namespace: U32,id:Key.Key,+descriptor: G.Descriptor<S>,remaining: List<&2,G.Descriptor<S>>,child:Key.Key,children: List<&2,Key.Key>,frames: List<&2,G.CleanupFrame<S>>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.CleanupFrame<S>>:
44	  match kind:
45	    case G.Hierarchy{}: (world,G.CleanupEnter{child} <> G.CleanupChildren{id,descriptor,remaining,children} <> frames)
46	    case G.Ordinary{}: (A.apply_unrelate(~S,~C,~R,~E,world,descriptor,W.Handle{namespace,child}),G.CleanupChildren{id,descriptor,remaining,children} <> frames)
47	def kind(~S: Data,d: G.Descriptor<S>) -> G.RelationKind:
48	  match d:
49	    case G.Descriptor{_,_,_,kind}: kind
50	def step(~S: Data,~C: Type,~R: Type,~E: Data,~clear: C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record: W.Handle<S> -> A.Notice<S,E>,frame: G.CleanupFrame<S>,world: W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,+namespace: U32,+descriptors: List<&2,G.Descriptor<S>>,frames: List<&2,G.CleanupFrame<S>>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.CleanupFrame<S>>:
51	  match frame:
52	    case G.CleanupEnter{+id}: entered(~S,~C,~R,~E,W.valid(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,W.Handle{namespace,id}),id,descriptors,frames)
53	    case G.CleanupDescriptors{id,[]}: (world,G.CleanupFinish{id} <> frames)
54	    case G.CleanupDescriptors{+id,+d <> remaining}: children_start(~S,~C,~R,~E,W.with_store(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,~List<&2,Key.Key>,store => snapshot(~S,~C,store,d,id),world),id,d,remaining,frames)
55	    case G.CleanupChildren{+id,d,remaining,[]}: (A.apply_unrelate(~S,~C,~R,~E,world,d,W.Handle{namespace,id}),G.CleanupDescriptors{id,remaining} <> frames)
56	    case G.CleanupChildren{id,+d,remaining,child <> children}: child_step(~S,~C,~R,~E,kind(~S,d),world,namespace,id,d,remaining,child,children,frames)
57	    case G.CleanupFinish{id}: (finish(~S,~C,~R,~E,~clear,~record,world,W.Handle{namespace,id}),frames)
58	def resumed(~S:Data,~C:Type,~R:Type,~E:Data,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.CleanupFrame<S>>,next:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> -> List<&2,G.CleanupFrame<S>> -> CleanupResult<S,C,R,E>) -> CleanupResult<S,C,R,E>:
59	  (world,frames) = observed
60	  next(world,frames)
61	def drive(~S: Data,~C: Type,~R: Type,~E: Data,~clear: C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record: W.Handle<S> -> A.Notice<S,E>,fuel: Nat,frames: List<&2,G.CleanupFrame<S>>,world: W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,+namespace: U32,+descriptors: List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
62	  match fuel frames:
63	    case _ Nil{}: Complete{world}
64	    case 0n frames: Incomplete{world,frames}
65	    case 1n+rest Con{frame,frames}: resumed(~S,~C,~R,~E,step(~S,~C,~R,~E,~clear,~record,frame,world,namespace,descriptors,frames),world => frames => drive(~S,~C,~R,~E,~clear,~record,rest,frames,world,namespace,descriptors))
66	
67	
68	# Structural product budget. No scalar Nat aggregate/product is computed.
69	# Small units retain one affine World+continuation and short-circuit Complete.
70	def units(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,fuel:Nat,result:CleanupResult<S,C,R,E>,namespace:U32,descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
71	  match result:
72	    case Complete{world}: Complete{world}
73	    case Incomplete{world,frames}: drive(~S,~C,~R,~E,~clear,~record,fuel,frames,world,namespace,descriptors)
74	def edge_units(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,remaining:List<&2,G.Edge<S>>,result:CleanupResult<S,C,R,E>,+namespace:U32,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
75	  match remaining result:
76	    case Nil{} result: result
77	    case Con{_,rest} Complete{world}: Complete{world}
78	    case Con{_,rest} result: edge_units(~S,~C,~R,~E,~clear,~record,rest,units(~S,~C,~R,~E,~clear,~record,2n,result,namespace,descriptors),namespace,descriptors)
79	def descriptor_units(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,remaining:List<&2,G.Descriptor<S>>,result:CleanupResult<S,C,R,E>,edges:List<&2,G.Edge<S>>,+namespace:U32,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
80	  match remaining result:
81	    case Nil{} result: edge_units(~S,~C,~R,~E,~clear,~record,edges,result,namespace,descriptors)
82	    case Con{_,rest} Complete{world}: Complete{world}
83	    case Con{_,rest} result: descriptor_units(~S,~C,~R,~E,~clear,~record,rest,units(~S,~C,~R,~E,~clear,~record,2n,result,namespace,descriptors),edges,namespace,descriptors)
84	def block(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,result:CleanupResult<S,C,R,E>,edges:List<&2,G.Edge<S>>,+namespace:U32,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
85	  descriptor_units(~S,~C,~R,~E,~clear,~record,descriptors,units(~S,~C,~R,~E,~clear,~record,3n,result,namespace,descriptors),edges,namespace,descriptors)
86	def node_blocks(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,remaining:Nat,result:CleanupResult<S,C,R,E>,+edges:List<&2,G.Edge<S>>,+namespace:U32,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
87	  match remaining result:
88	    case _ Complete{world}: Complete{world}
89	    case 0n result: block(~S,~C,~R,~E,~clear,~record,result,edges,namespace,descriptors)
90	    case 1n+rest result: node_blocks(~S,~C,~R,~E,~clear,~record,rest,block(~S,~C,~R,~E,~clear,~record,result,edges,namespace,descriptors),edges,namespace,descriptors)
91	def phase_blocks(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,remaining:List<&2,G.Edge<S>>,result:CleanupResult<S,C,R,E>,nodes:Nat,+edges:List<&2,G.Edge<S>>,+namespace:U32,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
92	  match remaining result:
93	    case _ Complete{world}: Complete{world}
94	    case Nil{} result: node_blocks(~S,~C,~R,~E,~clear,~record,nodes,result,edges,namespace,descriptors)
95	    case Con{_,rest} result: phase_blocks(~S,~C,~R,~E,~clear,~record,rest,block(~S,~C,~R,~E,~clear,~record,result,edges,namespace,descriptors),nodes,edges,namespace,descriptors)
96	def owner_blocks(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,remaining:Nat,result:CleanupResult<S,C,R,E>,+nodes:Nat,+edges:List<&2,G.Edge<S>>,+namespace:U32,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
97	  match remaining result:
98	    case _ Complete{world}: Complete{world}
99	    case 0n result: result
100	    case 1n+rest result: owner_blocks(~S,~C,~R,~E,~clear,~record,rest,phase_blocks(~S,~C,~R,~E,~clear,~record,edges,result,nodes,edges,namespace,descriptors),nodes,edges,namespace,descriptors)
101	def original_edges(~S:Data,~C:Type,store:A.Store<S,C>) -> A.Store<S,C> & List<&2,G.Edge<S>>:
102	  match store:
103	    case A.Store{components,G.Graph{+edges,inverses}}: (A.Store{components,G.Graph{edges,inverses}},edges)
104	def automatic_start(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,+nodes:Nat,+edges:List<&2,G.Edge<S>>,+namespace:U32,id:Key.Key,+descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
105	  owner_blocks(~S,~C,~R,~E,~clear,~record,nodes,drive(~S,~C,~R,~E,~clear,~record,1n,[G.CleanupEnter{id}],world,namespace,descriptors),nodes,edges,namespace,descriptors)
106	def automatic_inventory(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.Edge<S>>,namespace:U32,id:Key.Key,descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
107	  match observed:
108	    case (W.World{+ns,Alloc.Allocator{+next,+highWater,slots,+capacity,+depth,+free,+order},store,resource,+events,pending,+registrations,+nextSystemId,+clock},edges): automatic_start(~S,~C,~R,~E,~clear,~record,W.World{ns,Alloc.Allocator{next,highWater,slots,capacity,depth,free,order},store,resource,events,pending,registrations,nextSystemId,clock},U32.to_nat(highWater),edges,namespace,id,descriptors)
109	def automatic(~S:Data,~C:Type,~R:Type,~E:Data,~clear:C -> W.Handle<S> -> C & List<&2,A.Notice<S,E>>,~record:W.Handle<S> -> A.Notice<S,E>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,handle:W.Handle<S>,descriptors:List<&2,G.Descriptor<S>>) -> CleanupResult<S,C,R,E>:
110	  match handle:
111	    case W.Handle{namespace,id}: automatic_inventory(~S,~C,~R,~E,~clear,~record,W.with_store(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,~List<&2,G.Edge<S>>,store => original_edges(~S,~C,store),world),namespace,id,descriptors)