@@ -47,7 +47,7 @@
4747 ==
4848+$ import-diagnostic
4949 $% [%ok value=imported]
50− [%invalid code=?(%aura %core) message=@t]
50+ [%invalid code=?(%aura %core %overlap) message=@t]
5151 [%unsupported message=@t]
5252 ==
5353+$ signatures (list [name=term code=hoon])
@@ -132,6 +132,35 @@
132132 =/ rest $(cases t.cases, tags [u.tag tags])
133133 ?~ rest ~
134134 `[[u.tag i.cases] u.rest]
135+
136+::
137+:: Bound the new $? branch screen independently of the existing $% path.
138+:: Count raw noun nodes across all cases, and cap pairwise tag comparisons.
139+++ bounded-no-spec-unions
140+ |= [h=* fuel=@ud]
141+ ^- (unit @ud)
142+ ?: =(fuel 0) ~
143+ =. fuel (dec fuel)
144+ ?@ h `fuel
145+ ?: ?=([%bckt ^ ^] h) ~
146+ ?: ?=([%bcwt [^ [^ *]]] h) ~
147+ ?: ?=([%bccn [^ [^ *]]] h) ~
148+ =/ left=(unit @ud) $(h -.h)
149+ ?~ left ~
150+ $(h +.h, fuel u.left)
151+++ tagged-bounded-cases
152+ |= [cases=(list spec) tags=(list @) fuel=@ud left=@ud]
153+ ^- (unit (list tagged-case))
154+ ?~ cases `~
155+ ?: =(left 0) ~
156+ =/ remaining=(unit @ud) (bounded-no-spec-unions i.cases fuel)
157+ ?~ remaining ~
158+ =/ tag=(unit @) (tagged-head i.cases)
159+ ?~ tag ~
160+ ?: (lien tags |=(x=@ =(x u.tag))) ~
161+ =/ rest $(cases t.cases, tags [u.tag tags], fuel u.remaining, left (dec left))
162+ ?~ rest ~
163+ `[[u.tag i.cases] u.rest]
135164::
136165:: Benign source annotations have different typed representations on
137166:: Clay and under eval. Inspect the wrapper as a noun, and validate the
@@ -170,11 +199,19 @@
170199 ?~ found ~
171200 =/ body=(unit spec) (tagged-default-union u.found 4)
172201 ?~ body ~
173− ?. ?=([%bccn *] u.body) ~
174− =/ cases=(list spec) p.u.body
175− ?~ cases ~
176− ?~ t.cases ~
177− (tagged-cases cases ~)
202+ ?- u.body
203+ [%bccn *]
204+ =/ cases=(list spec) p.u.body
205+ ?~ cases ~
206+ ?~ t.cases ~
207+ (tagged-cases cases ~)
208+ [%bcwt *]
209+ =/ cases=(list spec) p.u.body
210+ ?~ cases ~
211+ ?~ t.cases ~
212+ (tagged-bounded-cases cases ~ 4.096 128)
213+ * ~
214+ ==
178215::
179216:: Source proof for dependencies of an explicitly tagged union. Only
180217:: simple local molds, standard collections and distinct term enums are
@@ -346,6 +383,63 @@
346383 ?. ?=([%cell [%atom %tas [~ @]] *] i.ys) ~
347384 ?. =(tag.i.xs u.value.head.i.ys) ~
348385 $(xs t.xs, ys t.ys)
386+
387+::
388+:: A finite, positive witness for two three-field tagged source cases.
389+:: The final @t fields admit noun zero. Each middle field is either an
390+:: explicit singleton or exactly two explicit singletons. Match noun
391+:: values independently of their aura labels; other shapes are unknown.
392+++ witness-atom-values
393+ |= node=imported
394+ ^- (unit (list @))
395+ ?: ?=([%atom *] node)
396+ ?~ value.node ~
397+ `~[u.value.node]
398+ ?. ?=([%fork [* [* ~]]] node) ~
399+ ?. &(?=([%atom *] i.cases.node) ?=([%atom *] i.t.cases.node)) ~
400+ ?~ value.i.cases.node ~
401+ ?~ value.i.t.cases.node ~
402+ `~[u.value.i.cases.node u.value.i.t.cases.node]
403+++ witness-tagged-case
404+ |= node=imported
405+ ^- (unit [head=@ middle=(list @)])
406+ ?. ?=([%cell [%atom %tas [~ @]] [%cell * [%atom %t ~]]] node) ~
407+ =/ middle (witness-atom-values head.tail.node)
408+ ?~ middle ~
409+ `[u.value.head.node u.middle]
410+++ overlap-zero-source
411+ |= [module=term name=term cor=type]
412+ ^- ?
413+ ?. ?=([%core *] cor) |
414+ =/ selected=(unit hoon) (local-arm-source cor name)
415+ ?~ selected |
416+ =/ shape=(unit spec) (local-mold-spec u.selected name)
417+ ?~ shape |
418+ =/ body=(unit spec) (tagged-default-union u.shape 4)
419+ ?~ body |
420+ ?. ?=([%bcwt [* [* ~]]] u.body) |
421+ =/ one=spec i.p.u.body
422+ =/ two=spec i.t.p.u.body
423+ =/ first=(unit @) (tagged-head one)
424+ =/ second=(unit @) (tagged-head two)
425+ ?~ first |
426+ ?~ second |
427+ ?. =(u.first u.second) |
428+ =/ cases=(list tagged-case) ~[[u.first one] [u.second two]]
429+ ?. ?=(^ (safe-source-tagged-fuel-mode cases cor ~[name] 4.096 |)) |
430+ =/ tried=(each (list type) tang)
431+ (mule |.((turn cases |=(c=tagged-case (~(play ut cor) [%kttr branch.c])))))
432+ ?. ?=([%& [* [* ~]]] tried) |
433+ =/ projected=(each (list imported) tang)
434+ (mule |.((turn p.tried |=(t=type (walk module t catalog ~ `cor)))))
435+ ?. ?=([%& [* [* ~]]] projected) |
436+ ?^ (first-bads p.projected) |
437+ =/ a (witness-tagged-case i.p.projected)
438+ =/ b (witness-tagged-case i.t.p.projected)
439+ ?~ a |
440+ ?~ b |
441+ ?. &(=(head.u.a u.first) =(head.u.b u.second) =(head.u.a head.u.b)) |
442+ (lien middle.u.a |=(n=@ (lien middle.u.b |=(m=@ =(n m)))))
349443::
350444:: +read-mold-in: accept the /sur core as provenance. The core must be
351445:: built against zuse or validated Ford imports, and its selected arm
@@ -361,6 +455,8 @@
361455 [%| (crip "Hoon mold `{(trip name)}` is not declared")]
362456 ?. =(typ (~(play ut cor) (ream (cat 3 '*' name))))
363457 [%| 'Hoon module provenance does not match the selected mold']
458+ =/ overlap=(each ? tang) (mule |.((overlap-zero-source module name cor)))
459+ ?: &(?=(%& -.overlap) p.overlap) [%| 'Hoon union cases overlap']
364460 =/ result (read-with module name typ [~ cor])
365461 ?: ?=([%& *] result) result
366462 =/ fallback=(each (unit (each imported @t)) tang)
@@ -461,6 +557,8 @@
461557 [%unsupported p.result]
462558 =/ selected=(each type tang) (mule |.((~(play ut cor) (ream (cat 3 '*' name)))))
463559 ?. ?=(%& -.selected) [%unsupported p.result]
560+ =/ overlap=(each ? tang) (mule |.((overlap-zero-source module name cor)))
561+ ?: &(?=(%& -.overlap) p.overlap) [%invalid %overlap 'Hoon union cases overlap']
464562 =/ again=(each imported tang) (mule |.((walk module p.selected catalog ~ [~ cor])))
465563 ?. ?=(%& -.again) [%unsupported p.result]
466564 =/ evidence=(unit import-diagnostic) (first-invalid p.again)