@@ -385,29 +385,35 @@
385385 $(xs t.xs, ys t.ys)
386386
387387::
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
388+:: Unlike the disjoint-reader fallback, source overlap may have repeated
389+:: tags. Bound both raw case traversal and the number of pair attempts.
390+++ overlap-source-cases
391+ |= [cases=(list spec) fuel=@ud left=@ud]
392+ ^- (unit (list tagged-case))
393+ ?~ cases `~
394+ ?: =(left 0) ~
395+ =/ remaining=(unit @ud) (bounded-no-spec-unions i.cases fuel)
396+ ?~ remaining ~
397+ =/ tag=(unit @) (tagged-head i.cases)
398+ ?~ tag ~
399+ =/ rest $(cases t.cases, fuel u.remaining, left (dec left))
400+ ?~ rest ~
401+ `[[u.tag i.cases] u.rest]
402+++ overlap-repeated-tag
403+ |= cases=(list tagged-case)
404+ ^- ?
405+ ?~ cases |
406+ ?: (lien t.cases |=(c=tagged-case =(tag.c tag.i.cases))) &
407+ $(cases t.cases)
408+++ overlap-projections-match
409+ |= [xs=(list tagged-case) ys=(list imported)]
410+ ^- ?
411+ ?~ xs ?=(~ ys)
412+ ?~ ys |
413+ ?. ?=([%cell [%atom %tas [~ @]] *] i.ys) |
414+ ?. =(tag.i.xs u.value.head.i.ys) |
415+ $(xs t.xs, ys t.ys)
416+++ overlap-source-witness
411417 |= [module=term name=term cor=type]
412418 ^- ?
413419 ?. ?=([%core *] cor) |
@@ -417,29 +423,100 @@
417423 ?~ shape |
418424 =/ body=(unit spec) (tagged-default-union u.shape 4)
419425 ?~ 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 |)) |
426+ ?. ?=([%bcwt *] u.body) |
427+ =/ cases=(unit (list tagged-case)) (overlap-source-cases p.u.body 4.096 128)
428+ ?~ cases |
429+ ?. (overlap-repeated-tag u.cases) |
430+ ?. ?=(^ (safe-source-tagged-fuel-mode u.cases cor ~[name] 4.096 |)) |
430431 =/ tried=(each (list type) tang)
431− (mule |.((turn cases |=(c=tagged-case (~(play ut cor) [%kttr branch.c])))))
432− ?. ?=([%& [* [* ~]]] tried) |
432+ (mule |.((turn u.cases |=(c=tagged-case (~(play ut cor) [%kttr branch.c])))))
433+ ?. ?=([%& *] tried) |
433434 =/ projected=(each (list imported) tang)
434435 (mule |.((turn p.tried |=(t=type (walk module t catalog ~ `cor)))))
435− ?. ?=([%& [* [* ~]]] projected) |
436+ ?. ?=([%& *] projected) |
436437 ?^ (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)))))
438+ ?. (overlap-projections-match u.cases p.projected) |
439+ =/ witness=(unit overlap-proof-result) (overlap-case-pairs p.projected 4.096)
440+ ?~ witness |
441+ found.u.witness
442+::
443+:: Positive overlap evidence only: false means no proof, not disjointness.
444+:: Fuel is shared across all examined nodes and sibling alternatives.
445++$ overlap-proof-result [found=? left=@ud]
446+++ overlap-known-atom
447+ |= aura=term
448+ ^- ?
449+ (lien `(list term)`~[%t %tas %ud %f] |=(n=term =(n aura)))
450+++ overlap-inhabited-list
451+ |= [xs=(list imported) fuel=@ud]
452+ ^- (unit overlap-proof-result)
453+ ?~ xs `[| fuel]
454+ ?: =(0 fuel) ~
455+ =/ one=(unit overlap-proof-result) (overlap-inhabited i.xs (dec fuel))
456+ ?~ one ~
457+ ?: found.u.one one
458+ $(xs t.xs, fuel left.u.one)
459+++ overlap-inhabited
460+ |= [x=imported fuel=@ud]
461+ ^- (unit overlap-proof-result)
462+ ?: =(0 fuel) ~
463+ =. fuel (dec fuel)
464+ ?- x
465+ [%noun *] `[& fuel]
466+ [%void *] `[| fuel]
467+ [%atom *] `[|(?=(^ value.x) (overlap-known-atom aura.x)) fuel]
468+ [%face *] $(x body.x)
469+ [%named *] $(x body.x)
470+ [%fork *] (overlap-inhabited-list cases.x fuel)
471+ [%cell *]
472+ =/ a=(unit overlap-proof-result) $(x head.x)
473+ ?~ a ~
474+ ?. found.u.a a
475+ $(x tail.x, fuel left.u.a)
476+ * `[| fuel]
477+ ==
478+++ overlap-pair-list
479+ |= [xs=(list imported) y=imported fuel=@ud]
480+ ^- (unit overlap-proof-result)
481+ ?~ xs `[| fuel]
482+ ?: =(0 fuel) ~
483+ =/ p=(unit overlap-proof-result) (overlap-pair i.xs y (dec fuel))
484+ ?~ p ~
485+ ?: found.u.p p
486+ $(xs t.xs, fuel left.u.p)
487+++ overlap-pair
488+ |= [a=imported b=imported fuel=@ud]
489+ ^- (unit overlap-proof-result)
490+ ?: =(0 fuel) ~
491+ =. fuel (dec fuel)
492+ ?: ?=([%face *] a) $(a body.a)
493+ ?: ?=([%face *] b) $(b body.b)
494+ ?: ?=([%named *] a) $(a body.a)
495+ ?: ?=([%named *] b) $(b body.b)
496+ ?: ?=([%fork *] a) (overlap-pair-list cases.a b fuel)
497+ ?: ?=([%fork *] b) (overlap-pair-list cases.b a fuel)
498+ ?: ?=([%noun *] a) (overlap-inhabited b fuel)
499+ ?: ?=([%noun *] b) (overlap-inhabited a fuel)
500+ ?: &(?=([%cell *] a) ?=([%cell *] b))
501+ =/ p=(unit overlap-proof-result) $(a head.a, b head.b)
502+ ?~ p ~
503+ ?. found.u.p p
504+ $(a tail.a, b tail.b, fuel left.u.p)
505+ ?. &(?=([%atom *] a) ?=([%atom *] b)) `[| fuel]
506+ ?^ value.a
507+ ?^ value.b `[=(u.value.a u.value.b) fuel]
508+ `[&(=(u.value.a 0) (overlap-known-atom aura.b)) fuel]
509+ ?^ value.b `[&(=(u.value.b 0) (overlap-known-atom aura.a)) fuel]
510+ `[&((overlap-known-atom aura.a) (overlap-known-atom aura.b)) fuel]
511+++ overlap-case-pairs
512+ |= [xs=(list imported) fuel=@ud]
513+ ^- (unit overlap-proof-result)
514+ ?~ xs `[| fuel]
515+ ?: =(0 fuel) ~
516+ =/ p=(unit overlap-proof-result) (overlap-pair-list t.xs i.xs (dec fuel))
517+ ?~ p ~
518+ ?: found.u.p p
519+ $(xs t.xs, fuel left.u.p)
443520::
444521:: +read-mold-in: accept the /sur core as provenance. The core must be
445522:: built against zuse or validated Ford imports, and its selected arm
@@ -455,7 +532,7 @@
455532 [%| (crip "Hoon mold `{(trip name)}` is not declared")]
456533 ?. =(typ (~(play ut cor) (ream (cat 3 '*' name))))
457534 [%| 'Hoon module provenance does not match the selected mold']
458− =/ overlap=(each ? tang) (mule |.((overlap-zero-source module name cor)))
535+ =/ overlap=(each ? tang) (mule |.((overlap-source-witness module name cor)))
459536 ?: &(?=(%& -.overlap) p.overlap) [%| 'Hoon union cases overlap']
460537 =/ result (read-with module name typ [~ cor])
461538 ?: ?=([%& *] result) result
@@ -557,7 +634,7 @@
557634 [%unsupported p.result]
558635 =/ selected=(each type tang) (mule |.((~(play ut cor) (ream (cat 3 '*' name)))))
559636 ?. ?=(%& -.selected) [%unsupported p.result]
560− =/ overlap=(each ? tang) (mule |.((overlap-zero-source module name cor)))
637+ =/ overlap=(each ? tang) (mule |.((overlap-source-witness module name cor)))
561638 ?: &(?=(%& -.overlap) p.overlap) [%invalid %overlap 'Hoon union cases overlap']
562639 =/ again=(each imported tang) (mule |.((walk module p.selected catalog ~ [~ cor])))
563640 ?. ?=(%& -.again) [%unsupported p.result]