1	import Base
2	import ./change_tick.bend as Tick
3	import ./world.bend as W
4	import ./system.bend as Sys
5	
6	# Detached facts copied from the single outer registration. The affine
7	# Registry stays with its provider and is never copied into a Param owner.
8	type RegistrationFacts is Data:
9	  RegistrationFacts{namespace:U32,id:U32,name:String,access:List<&2,String>}
10	
11	def registration_facts(~S:Data,~C:Type,~R:Type,~E:Data,~Args:Type,~Error:Data,~Output:Type,~runner:W.World<S,C,R,E> -> Args -> Sys.Outcome<W.World<S,C,R,E>,Error,Output>,registry:Sys.Registry<S,C,R,E,Args,Error,Output,runner>) -> Sys.Registry<S,C,R,E,Args,Error,Output,runner> & RegistrationFacts:
12	  match registry:
13	    case Sys.Registry{+namespace,+id,+name,+access,+cursor}:(Sys.Registry{namespace,id,name,access,cursor},RegistrationFacts{namespace,id,name,access})
14	
15	# A typed read parameter. The functions are template indices so the descriptor
16	# stores only its declaration metadata while retaining arbitrary affine owners.
17	type Param<W:Type,Owner:Type,View:Data,Delta:Type,-validateFn:W -> Owner -> W & (Owner & Bool),-prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),-commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,-releaseFn:W -> Owner -> W> is Data:
18	  Param{access:List<&2,String>}
19	
20	type ViewPair<L:Data,R:Data> is Data:
21	  ViewPair{left:L,right:R}
22	
23	def make(~W:Type,~Owner:Type,~View:Data,~Delta:Type,~validateFn:W -> Owner -> W & (Owner & Bool),~prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),~commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,~releaseFn:W -> Owner -> W,access:List<&2,String>) -> Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn>:
24	  Param{access}
25	
26	def access(~W:Type,~Owner:Type,~View:Data,~Delta:Type,~validateFn:W -> Owner -> W & (Owner & Bool),~prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),~commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,~releaseFn:W -> Owner -> W,param:Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn>) -> Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn> & List<&2,String>:
27	  match param:
28	    case Param{+access}:(Param{access},access)
29	
30	def validate(~W:Type,~Owner:Type,~View:Data,~Delta:Type,~validateFn:W -> Owner -> W & (Owner & Bool),~prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),~commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,~releaseFn:W -> Owner -> W,param:Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn>,world:W,owner:Owner) -> W & (Owner & Bool):
31	  match param:
32	    case Param{_}:validateFn(world,owner)
33	
34	def prepare(~W:Type,~Owner:Type,~View:Data,~Delta:Type,~validateFn:W -> Owner -> W & (Owner & Bool),~prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),~commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,~releaseFn:W -> Owner -> W,param:Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn>,world:W,cursor:Maybe<&2,Tick.Tick>,owner:Owner) -> W & (Owner & (View & Delta)):
35	  match param:
36	    case Param{_}:prepareFn(world,cursor,owner)
37	
38	def commit(~W:Type,~Owner:Type,~View:Data,~Delta:Type,~validateFn:W -> Owner -> W & (Owner & Bool),~prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),~commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,~releaseFn:W -> Owner -> W,param:Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn>,world:W,owner:Owner,delta:Delta,cursor:Tick.Tick) -> W & Owner:
39	  match param:
40	    case Param{_}:commitFn(world,owner,delta,cursor)
41	
42	def release(~W:Type,~Owner:Type,~View:Data,~Delta:Type,~validateFn:W -> Owner -> W & (Owner & Bool),~prepareFn:W -> @+cursor:Maybe<&2,Tick.Tick> -> Owner -> W & (Owner & (View & Delta)),~commitFn:W -> Owner -> Delta -> @+cursor:Tick.Tick -> W & Owner,~releaseFn:W -> Owner -> W,param:Param<W,Owner,View,Delta,validateFn,prepareFn,commitFn,releaseFn>,world:W,owner:Owner) -> W:
43	  match param:
44	    case Param{_}:releaseFn(world,owner)
45	
46	def unit_prepare(~W:Type,world:W,+cursor:Maybe<&2,Tick.Tick>,owner:Unit) -> W & (Unit & (Unit & Unit)):
47	  (world,(owner,(Unit{},Unit{})))
48	
49	def unit_commit(~W:Type,world:W,owner:Unit,delta:Unit,+cursor:Tick.Tick) -> W & Unit:
50	  (world,owner)
51	
52	def unit_release(~W:Type,world:W,owner:Unit) -> W:
53	  match owner:
54	    case Unit{}:world
55	
56	def unit_validate(~W:Type,world:W,owner:Unit) -> W & (Unit & Bool):
57	  (world,(owner,True{}))
58	
59	def unit(~W:Type) -> Param<W,Unit,Unit,Unit,unit_validate(~W),unit_prepare(~W),unit_commit(~W),unit_release(~W)>:
60	  Param{[]}
61	
62	def pair_access_second(~W:Type,~OwnerA:Type,~ViewA:Data,~DeltaA:Type,~validateA:W -> OwnerA -> W & (OwnerA & Bool),~prepareA:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerA -> W & (OwnerA & (ViewA & DeltaA)),~commitA:W -> OwnerA -> DeltaA -> @+cursor:Tick.Tick -> W & OwnerA,~releaseA:W -> OwnerA -> W,~OwnerB:Type,~ViewB:Data,~DeltaB:Type,~validateB:W -> OwnerB -> W & (OwnerB & Bool),~prepareB:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerB -> W & (OwnerB & (ViewB & DeltaB)),~commitB:W -> OwnerB -> DeltaB -> @+cursor:Tick.Tick -> W & OwnerB,~releaseB:W -> OwnerB -> W,first:List<&2,String>,second:Param<W,OwnerB,ViewB,DeltaB,validateB,prepareB,commitB,releaseB>) -> List<&2,String>:
63	  match second:
64	    case Param{access}:List.append(&2,String,first,access)
65	
66	def pair_access(~W:Type,~OwnerA:Type,~ViewA:Data,~DeltaA:Type,~validateA:W -> OwnerA -> W & (OwnerA & Bool),~prepareA:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerA -> W & (OwnerA & (ViewA & DeltaA)),~commitA:W -> OwnerA -> DeltaA -> @+cursor:Tick.Tick -> W & OwnerA,~releaseA:W -> OwnerA -> W,~OwnerB:Type,~ViewB:Data,~DeltaB:Type,~validateB:W -> OwnerB -> W & (OwnerB & Bool),~prepareB:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerB -> W & (OwnerB & (ViewB & DeltaB)),~commitB:W -> OwnerB -> DeltaB -> @+cursor:Tick.Tick -> W & OwnerB,~releaseB:W -> OwnerB -> W,left:Param<W,OwnerA,ViewA,DeltaA,validateA,prepareA,commitA,releaseA>,right:Param<W,OwnerB,ViewB,DeltaB,validateB,prepareB,commitB,releaseB>) -> List<&2,String>:
67	  match left:
68	    case Param{access}:pair_access_second(~W,~OwnerA,~ViewA,~DeltaA,~validateA,~prepareA,~commitA,~releaseA,~OwnerB,~ViewB,~DeltaB,~validateB,~prepareB,~commitB,~releaseB,access,right)
69	
70	def pair_validate_join(~W:Type,~OwnerA:Type,~OwnerB:Type,left_valid:Bool,validatedB:W & (OwnerB & Bool),ownerA:OwnerA) -> W & ((OwnerA & OwnerB) & Bool):
71	  match validatedB:
72	    case (world,(ownerB,right_valid)):(world,((ownerA,ownerB),Bool.and(left_valid,right_valid)))
73	
74	def pair_validate_after_left(~W:Type,~OwnerA:Type,~OwnerB:Type,~validateB:W -> OwnerB -> W & (OwnerB & Bool),ownerB:OwnerB,validatedA:W & (OwnerA & Bool)) -> W & ((OwnerA & OwnerB) & Bool):
75	  match validatedA:
76	    case (world,(ownerA,left_valid)):pair_validate_join(~W,~OwnerA,~OwnerB,left_valid,validateB(world,ownerB),ownerA)
77	
78	def pair_validate_fn(~W:Type,~OwnerA:Type,~OwnerB:Type,~validateA:W -> OwnerA -> W & (OwnerA & Bool),~validateB:W -> OwnerB -> W & (OwnerB & Bool),world:W,owners:OwnerA & OwnerB) -> W & ((OwnerA & OwnerB) & Bool):
79	  match owners:
80	    case (ownerA,ownerB):pair_validate_after_left(~W,~OwnerA,~OwnerB,~validateB,ownerB,validateA(world,ownerA))
81	
82	def pair_prepare_join(~W:Type,~OwnerA:Type,~OwnerB:Type,~ViewA:Data,~ViewB:Data,~DeltaA:Type,~DeltaB:Type,ownerA:OwnerA,viewA:ViewA,deltaA:DeltaA,preparedB:W & (OwnerB & (ViewB & DeltaB))) -> W & ((OwnerA & OwnerB) & (ViewPair<ViewA,ViewB> & (DeltaA & DeltaB))):
83	  match preparedB:
84	    case (world,(ownerB,(viewB,deltaB))):(world,((ownerA,ownerB),(ViewPair{viewA,viewB},(deltaA,deltaB))))
85	
86	def pair_prepare_after_left(~W:Type,~OwnerA:Type,~OwnerB:Type,~ViewA:Data,~ViewB:Data,~DeltaA:Type,~DeltaB:Type,~prepareB:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerB -> W & (OwnerB & (ViewB & DeltaB)),cursor:Maybe<&2,Tick.Tick>,ownerB:OwnerB,preparedA:W & (OwnerA & (ViewA & DeltaA))) -> W & ((OwnerA & OwnerB) & (ViewPair<ViewA,ViewB> & (DeltaA & DeltaB))):
87	  match preparedA:
88	    case (world,(ownerA,(viewA,deltaA))):pair_prepare_join(~W,~OwnerA,~OwnerB,~ViewA,~ViewB,~DeltaA,~DeltaB,ownerA,viewA,deltaA,prepareB(world,cursor,ownerB))
89	
90	def pair_prepare_fn(~W:Type,~OwnerA:Type,~OwnerB:Type,~ViewA:Data,~ViewB:Data,~DeltaA:Type,~DeltaB:Type,~prepareA:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerA -> W & (OwnerA & (ViewA & DeltaA)),~prepareB:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerB -> W & (OwnerB & (ViewB & DeltaB)),world:W,+cursor:Maybe<&2,Tick.Tick>,owners:OwnerA & OwnerB) -> W & ((OwnerA & OwnerB) & (ViewPair<ViewA,ViewB> & (DeltaA & DeltaB))):
91	  match owners:
92	    case (ownerA,ownerB):pair_prepare_after_left(~W,~OwnerA,~OwnerB,~ViewA,~ViewB,~DeltaA,~DeltaB,~prepareB,cursor,ownerB,prepareA(world,cursor,ownerA))
93	
94	def pair_commit_join(~W:Type,~OwnerA:Type,~OwnerB:Type,ownerA:OwnerA,committedB:W & OwnerB) -> W & (OwnerA & OwnerB):
95	  match committedB:
96	    case (world,ownerB):(world,(ownerA,ownerB))
97	
98	def pair_commit_after_left(~W:Type,~OwnerA:Type,~OwnerB:Type,~DeltaB:Type,~commitB:W -> OwnerB -> DeltaB -> @+cursor:Tick.Tick -> W & OwnerB,cursor:Tick.Tick,ownerB:OwnerB,deltaB:DeltaB,committedA:W & OwnerA) -> W & (OwnerA & OwnerB):
99	  match committedA:
100	    case (world,ownerA):pair_commit_join(~W,~OwnerA,~OwnerB,ownerA,commitB(world,ownerB,deltaB,cursor))
101	
102	def pair_commit_fn(~W:Type,~OwnerA:Type,~OwnerB:Type,~DeltaA:Type,~DeltaB:Type,~commitA:W -> OwnerA -> DeltaA -> @+cursor:Tick.Tick -> W & OwnerA,~commitB:W -> OwnerB -> DeltaB -> @+cursor:Tick.Tick -> W & OwnerB,world:W,owners:OwnerA & OwnerB,deltas:DeltaA & DeltaB,+cursor:Tick.Tick) -> W & (OwnerA & OwnerB):
103	  match owners:
104	    case (ownerA,ownerB):
105	      match deltas:
106	        case (deltaA,deltaB):pair_commit_after_left(~W,~OwnerA,~OwnerB,~DeltaB,~commitB,cursor,ownerB,deltaB,commitA(world,ownerA,deltaA,cursor))
107	
108	def pair_release_after_left(~W:Type,~OwnerB:Type,~releaseB:W -> OwnerB -> W,ownerB:OwnerB,context:W) -> W:
109	  releaseB(context,ownerB)
110	
111	def pair_release_fn(~W:Type,~OwnerA:Type,~OwnerB:Type,~releaseA:W -> OwnerA -> W,~releaseB:W -> OwnerB -> W,context:W,owners:OwnerA & OwnerB) -> W:
112	  match owners:
113	    case (ownerA,ownerB):pair_release_after_left(~W,~OwnerB,~releaseB,ownerB,releaseA(context,ownerA))
114	
115	def pair(~W:Type,~OwnerA:Type,~ViewA:Data,~DeltaA:Type,~validateA:W -> OwnerA -> W & (OwnerA & Bool),~prepareA:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerA -> W & (OwnerA & (ViewA & DeltaA)),~commitA:W -> OwnerA -> DeltaA -> @+cursor:Tick.Tick -> W & OwnerA,~releaseA:W -> OwnerA -> W,~OwnerB:Type,~ViewB:Data,~DeltaB:Type,~validateB:W -> OwnerB -> W & (OwnerB & Bool),~prepareB:W -> @+cursor:Maybe<&2,Tick.Tick> -> OwnerB -> W & (OwnerB & (ViewB & DeltaB)),~commitB:W -> OwnerB -> DeltaB -> @+cursor:Tick.Tick -> W & OwnerB,~releaseB:W -> OwnerB -> W,left:Param<W,OwnerA,ViewA,DeltaA,validateA,prepareA,commitA,releaseA>,right:Param<W,OwnerB,ViewB,DeltaB,validateB,prepareB,commitB,releaseB>) -> Param<W,OwnerA & OwnerB,ViewPair<ViewA,ViewB>,DeltaA & DeltaB,pair_validate_fn(~W,~OwnerA,~OwnerB,~validateA,~validateB),pair_prepare_fn(~W,~OwnerA,~OwnerB,~ViewA,~ViewB,~DeltaA,~DeltaB,~prepareA,~prepareB),pair_commit_fn(~W,~OwnerA,~OwnerB,~DeltaA,~DeltaB,~commitA,~commitB),pair_release_fn(~W,~OwnerA,~OwnerB,~releaseA,~releaseB)>:
116	  Param{pair_access(~W,~OwnerA,~ViewA,~DeltaA,~validateA,~prepareA,~commitA,~releaseA,~OwnerB,~ViewB,~DeltaB,~validateB,~prepareB,~commitB,~releaseB,left,right)}
117	
118	# Build two declarations against the same registration while threading one
119	# affine shared context through both initializers.
120	def initialize_pair_finish(~Context:Type,~Facts:Data,~OwnerA:Type,~ParameterA:Type,
121	  ~OwnerB:Type,~ParameterB:Type,~Parameter:Type,
122	  ~pair:ParameterA -> ParameterB -> Parameter,
123	  ownerA:OwnerA,paramA:ParameterA,
124	  initializedB:Context & (OwnerB & ParameterB)) -> Context & ((OwnerA & OwnerB) & Parameter):
125	  match initializedB:
126	    case (contextB,(ownerB,paramB)):
127	      (contextB,((ownerA,ownerB),pair(paramA,paramB)))
128	
129	def initialize_pair_after_first(~Context:Type,~Facts:Data,~OwnerA:Type,~ParameterA:Type,
130	  ~OwnerB:Type,~ParameterB:Type,~Parameter:Type,
131	  ~initB:Context -> Facts -> Context & (OwnerB & ParameterB),
132	  ~pair:ParameterA -> ParameterB -> Parameter,
133	  +facts:Facts,
134	  initializedA:Context & (OwnerA & ParameterA)) -> Context & ((OwnerA & OwnerB) & Parameter):
135	  match initializedA:
136	    case (contextAfterA,(ownerA,paramA)):
137	      initialize_pair_finish(~Context,~Facts,~OwnerA,~ParameterA,~OwnerB,~ParameterB,~Parameter,
138	        ~pair,ownerA,paramA,initB(contextAfterA,facts))
139	
140	def initialize_pair(~Context:Type,~Facts:Data,~OwnerA:Type,~ParameterA:Type,
141	  ~OwnerB:Type,~ParameterB:Type,~Parameter:Type,
142	  ~initA:Context -> Facts -> Context & (OwnerA & ParameterA),
143	  ~initB:Context -> Facts -> Context & (OwnerB & ParameterB),
144	  ~pair:ParameterA -> ParameterB -> Parameter,
145	  context:Context,+facts:Facts) -> Context & ((OwnerA & OwnerB) & Parameter):
146	  initialize_pair_after_first(~Context,~Facts,~OwnerA,~ParameterA,~OwnerB,~ParameterB,~Parameter,
147	    ~initB,~pair,facts,initA(context,facts))