From 693ab11c659a0fd31186918dc82dc9588d795e38 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Fri, 22 Jun 2018 15:20:52 -0700 Subject: [PATCH] Add the %walk schematic --- gen/ford-turbo.hoon | 365 ++++++++++++++++++++++++++++++++++++++++++++ sys/vane/turbo.hoon | 295 ++++++++++++++++++++++++++++++++++- sys/zuse.hoon | 23 +++ 3 files changed, 682 insertions(+), 1 deletion(-) diff --git a/gen/ford-turbo.hoon b/gen/ford-turbo.hoon index dd81d3124..a40ab101a 100644 --- a/gen/ford-turbo.hoon +++ b/gen/ford-turbo.hoon @@ -120,6 +120,8 @@ test-list test-mash test-multi-core-same-dependency + test-walk-prefer-grab + test-walk-large-graph == ++ test-tear :- `tank`leaf+"test-tear" @@ -6738,6 +6740,369 @@ results3 results4 == +:: tests that we can do the simple adjacent mark case, and that we use grab +:: when both available. +:: +++ test-walk-prefer-grab + :- `tank`leaf+"test-walk-prefer-grab" + :: + =/ hoon-src-type=type [%atom %$ ~] + =/ arch-type=type -:!>(*arch) + :: + =/ scry-results=(map [term beam] (unit cage)) + %- my :~ + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/one/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ [a=tape b=@ud] + :: convert to + ++ grow + |% + ++ two [b a "grow"] + -- + -- + ''' + :: + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/two/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ [a=@ud b=tape c=type] + ++ grab + |% + ++ one |=([a=tape b=@ud] [b a "grab"]) + -- + -- + ''' + :: + :: make sure we can deal with random not-hoon files in mar + :- [%cy [[~nul %home %da ~1234.5.6] /js/dummy/mar]] + :- ~ + :- %js + :- hoon-src-type + ''' + window.onload = function() + ''' + :: + :- [%cy [[~nul %home %da ~1234.5.6] /mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.one ~] [~.two ~] [~.dummy ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /one/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /two/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /dummy/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.js ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/one/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v1] + ~ + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/two/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v2] + ~ + :: + :- [%cy [[~nul %home %da ~1234.5.6] /js/dummy/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v3] + ~ + == + :: + =^ results1 ford-gate + %- test-ford-call :* + ford-gate + now=~1234.5.6 + scry=(scry-with-results-and-failures scry-results) + :: + ^= call-args + :* duct=~[/walk] type=~ %build ~nul + %walk [~nul %home] %one %two + == + :: + ^= moves + :~ ^- move:ford-gate + :* duct=~[/walk] %give %made ~1234.5.6 + %complete %success %walk + [%grab %one %two]~ + == + ^- move:ford-gate + :* duct=~[/walk] %pass /~nul/clay-sub/~nul/home + %c %warp [~nul ~nul] %home ~ %mult [%da ~1234.5.6] + %- sy :~ + [%y /mar/dummy] [%y /mar/two/hoon] [%y /mar/two] + [%y /mar/one] [%y /mar] [%y /mar/dummy/js] + [%y /mar/one/hoon] [%x /mar/two/hoon] [%x /mar/one/hoon] + == == == == + :: + =^ results2 ford-gate + %- test-ford-call :* + ford-gate + now=~1234.5.6 + scry=scry-is-forbidden + :: + call-args=[duct=~[/walk] type=~ %kill ~nul] + :: + ^= moves + :~ :* duct=~[/walk] %pass /~nul/clay-sub/~nul/home + %c %warp [~nul ~nul] %home ~ + == == == + :: + ;: weld + results1 + results2 + (expect-ford-empty ford-gate ~nul) + == +:: +++ test-walk-large-graph + :- `tank`leaf+"test-walk-large-graph" + :: + =/ hoon-src-type=type [%atom %$ ~] + =/ arch-type=type -:!>(*arch) + :: + =/ scry-results=(map [term beam] (unit cage)) + %- my :~ + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/one/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ [a=tape b=@ud] + :: convert to + ++ grow + |% + ++ two [b a "grow"] + ++ five b + -- + -- + ''' + :: + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/two/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ [a=@ud b=tape c=tape] + ++ grab + |% + ++ one |=([a=tape b=@ud] [b a "grab"]) + -- + -- + ''' + :: + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/three/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ [b=tape c=tape] + ++ grab + |% + ++ one |=([a=tape b=@ud] [a "grab"]) + -- + ++ grow + |% + ++ two + [b c] + -- + -- + ''' + :: + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/four/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ [c=tape b=tape] + ++ grab + |% + ++ two + |= [a=@ud b=tape c=tape] + [c b] + -- + -- + ''' + :: + :- [%cx [[~nul %home %da ~1234.5.6] /hoon/five/mar]] + :- ~ + :- %hoon + :- hoon-src-type + ''' + |_ a=@u + ++ grab + |% + ++ four + :: ignore the value entirely + |= [c=tape b=tape] + 5 + -- + ++ grow + |% + ++ one + [a "empty" "grow"] + -- + -- + ''' + :: + :- [%cy [[~nul %home %da ~1234.5.6] /mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.one ~] [~.two ~] [~.three ~] [~.four ~] [~.five ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /one/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /two/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /three/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /four/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /five/mar]] + :- ~ + :- %arch + :- arch-type + :- ~ + (my ~[[~.hoon ~]]) + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/one/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v1] + ~ + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/two/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v2] + ~ + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/three/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v3] + ~ + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/four/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v4] + ~ + :: + :- [%cy [[~nul %home %da ~1234.5.6] /hoon/five/mar]] + :- ~ + :- %arch + :- arch-type + :- fil=[~ u=0v5] + ~ + == + :: + =^ results1 ford-gate + %- test-ford-call :* + ford-gate + now=~1234.5.6 + scry=(scry-with-results-and-failures scry-results) + :: + ^= call-args + :* duct=~[/walk] type=~ %build ~nul + %walk [~nul %home] %one %four + == + :: + ^= moves + :~ ^- move:ford-gate + :* duct=~[/walk] %give %made ~1234.5.6 + %complete %success %walk + [[%grab %one %two] [%grab %two %four] ~] + == + ^- move:ford-gate + :* duct=~[/walk] %pass /~nul/clay-sub/~nul/home + %c %warp [~nul ~nul] %home ~ %mult [%da ~1234.5.6] + %- sy :~ + [%y /mar] + :: + [%y /mar/one] [%y /mar/two] [%y /mar/three] [%y /mar/four] + [%y /mar/five] + :: + [%y /mar/one/hoon] [%y /mar/two/hoon] [%y /mar/three/hoon] + [%y /mar/four/hoon] [%y /mar/five/hoon] + :: + [%x /mar/one/hoon] [%x /mar/two/hoon] [%x /mar/three/hoon] + [%x /mar/four/hoon] [%x /mar/five/hoon] + == == == == + :: + =^ results2 ford-gate + %- test-ford-call :* + ford-gate + now=~1234.5.6 + scry=scry-is-forbidden + :: + call-args=[duct=~[/walk] type=~ %kill ~nul] + :: + ^= moves + :~ :* duct=~[/walk] %pass /~nul/clay-sub/~nul/home + %c %warp [~nul ~nul] %home ~ + == == == + :: + ;: weld + results1 + results2 + (expect-ford-empty ford-gate ~nul) + == + + :: :: |utilities: helper arms :: ::+| utilities diff --git a/sys/vane/turbo.hoon b/sys/vane/turbo.hoon index 621881db8..819406da1 100644 --- a/sys/vane/turbo.hoon +++ b/sys/vane/turbo.hoon @@ -1,3 +1,4 @@ +!: :: pit: a +vase of the hoon+zuse kernel, which is a deeply nested core :: |= pit=vase @@ -533,6 +534,7 @@ %slit ~ %vale ~ %volt ~ + %walk ~ == :: +date-from-schematic: finds the latest pin date from this schematic tree. :: @@ -2008,10 +2010,10 @@ ++ make |= =build ^- build-receipt - ~& [%turbo-make (build-to-tape build)] :: accessed-builds: builds accessed/depended on during this run. :: =| accessed-builds=(list ^build) + :: ~& [%turbo-make (build-to-tape build)] :: dispatch based on the kind of +schematic in :build :: :: @@ -2048,6 +2050,7 @@ %slit (make-slit gate sample) %vale (make-vale disc mark input) %volt (make-volt disc mark input) + %walk (make-walk disc source target) == :: |schematic-handlers:make: implementation of the schematics :: @@ -4487,6 +4490,296 @@ %- return-error =/ =beam [[ship.disc desk.disc %da date.build] spur.rail.u.path-result] [leaf+"ford: %vale failed: invalid input for mark: {<(en-beam beam)>}"]~ + :: + ++ make-walk + |= [=disc source=term target=term] + ^- build-receipt + :: + |^ ^- build-receipt + :: load all marks. + :: + :: Any random mark can implement a +grab arm, so we must load all + :: the marks if we want the mark graph to be complete. + :: + =^ load-directory-result accessed-builds + (load-directory /mar "" "") + ?: ?=([%error *] load-directory-result) + :* build + [%build-result %error message.load-directory-result] + accessed-builds + == + ?: ?=([%block *] load-directory-result) + :* build + [%blocks builds.load-directory-result ~] + accessed-builds + == + :: build an edge graph + :: + :: :load-directory-result is a raw set of mark names and compiled + :: cores. +build-edges reads that data into a consistent build + :: graph. + :: + =/ edges (build-edges ~(tap in results.load-directory-result)) + :: find a path through the graph + :: + :: Make a list of individual mark translation actions which will + :: take us from :source to :term. + :: + =/ path (find-path-through edges) + :: if there is no path between these marks, give a nice error message. + :: + ?~ path + :* build + :* %build-result %error + [leaf+"ford: no mark path from {} to {}"]~ + == + accessed-builds + == + :: + :* build + [%build-result %success %walk path] + accessed-builds + == + :: +load-result: either a complete map, some blocks, or an error + :: + += load-result + $% [%result results=(map tape vase)] + [%block builds=(list ^build)] + [%error message=tang] + == + :: +load-directory: recursively walks the directory tree, loading marks + :: + :: This either returns a map of all the mark cores on the specified + :: :disc, a list of blocked builds or a fatal error. + :: + :: We must load all the marks on :disc because any random mark may + :: have a +grab arm which we must consider when doing the mark graph + :: traversal. + :: + ++ load-directory + |= [=path prev-name=tape name=tape] + ^- [load-result _accessed-builds] + :: load the directory directly + :: + =/ dir-build=^build [date.build [%scry %c %y [disc path]]] + =^ dir-result accessed-builds (depend-on dir-build) + ?~ dir-result + [[%block [dir-build]~] accessed-builds] + :: + ?. ?=([~ %success %scry *] dir-result) + :: when directory scrys fail, this is a hard error. + ?> ?=([~ %error *] dir-result) + [[%error message.u.dir-result] accessed-builds] + :: + =/ dir-arch=arch ;;(arch q.q.cage.u.dir-result) + :: try loading the file here + :: + =^ fil-result=load-result accessed-builds + ?~ fil.dir-arch + :: we have no file at this node. ignore it. + :: + [[%result ~] accessed-builds] + ?. =(name "hoon") + :: this is a non-hoon file in the mark directory. ignore it. + :: + [[%result ~] accessed-builds] + :: load the file and return it + :: + =/ core-build=^build [date.build [%core [disc path]]] + =^ core-result accessed-builds (depend-on core-build) + ?~ core-result + [[%block [core-build]~] accessed-builds] + :: + ?. ?=([~ %success %core *] core-result) + :: it is not a hard error if there's a hoon file which failed to compile. + :: + [[%result ~] accessed-builds] + :: + [[%result (my [prev-name vase.u.core-result]~)] accessed-builds] + :: + =/ valid-marks=(list @ta) + (skim (turn ~(tap by dir.dir-arch) head) (sane %tas)) + :: block on recursing into each directory + :: + =^ sub-results accessed-builds + =| results=(list load-result) + |- ^+ [results accessed-builds] + ?~ valid-marks [results accessed-builds] + :: + =* current-name i.valid-marks + =/ new-prev-name + ?~ prev-name + name + :(weld prev-name "-" name) + =^ sub-result accessed-builds + (load-directory [current-name path] new-prev-name (trip current-name)) + :: + =. results [sub-result results] + :: + $(valid-marks t.valid-marks) + :: our results are the file node and the directory results + :: + =. sub-results [fil-result sub-results] + :: return the first error, if exists + :: + =/ errors=(list tang) + %+ murn sub-results + |= result=load-result + ^- (unit tang) + ?. ?=([%error *] result) + ~ + `message.result + ?^ errors + [[%error i.errors] accessed-builds] + :: return all blocks, if exists + :: + =/ blocks=(list ^build) + %+ roll sub-results + |= [result=load-result blocks=(list ^build)] + ^- (list ^build) + ?. ?=([%block *] result) + blocks + (welp builds.result blocks) + ?^ blocks + [[%block blocks] accessed-builds] + :: our list only has results. merge them. + :: + =/ merged=(map tape vase) + %+ roll sub-results + |= [result=load-result merged=(map tape vase)] + ^- (map tape vase) + ?> ?=([%result *] result) + (~(uni by merged) results.result) + [[%result merged] accessed-builds] + :: edge-jug: type of our graph representation + :: + += edge-jug (jug source=term [target=term arm=?(%grow %grab)]) + :: +build-edges: build an edge database out of raw mark vases + :: + ++ build-edges + |= marks=(list [name=tape =vase]) + ^- edge-jug + :: + =| edges=edge-jug + |- + ^+ edges + ?~ marks edges + :: + =/ mark-name (crip name.i.marks) + =/ mark-vase vase.i.marks + :: + =? edges (slob %grab p.mark-vase) + =/ grab-arms (sloe p:(slap mark-vase [%limb %grab])) + |- + ^+ edges + ?~ grab-arms edges + =. edges (~(put ju edges) i.grab-arms [mark-name %grab]) + $(grab-arms t.grab-arms) + :: + =? edges (slob %grow p.mark-vase) + =/ grow-arms (sloe p:(slap mark-vase [%limb %grow])) + |- + ^+ edges + ?~ grow-arms edges + =. edges (~(put ju edges) mark-name [i.grow-arms %grow]) + $(grow-arms t.grow-arms) + :: + $(marks t.marks) + :: mark-path: a path through the mark graph + :: + += mark-path (list mark-action) + :: +find-path-through: breadth first search over the mark graph + :: + ++ find-path-through + |= edges=edge-jug + ^- mark-path + :: the source node starts out visited + =/ visited-nodes=(set mark) [source ~ ~] + :: these paths are flopped so we're always inserting to the front. + =| path-queue=(qeu mark-path) + :: start the queue with all the edges which start at the source mark + :: + =. path-queue + =/ start-links (find-links-in-edges edges source) + :: + |- + ^+ path-queue + ?~ start-links + path-queue + :: + =. path-queue (~(put to path-queue) [i.start-links]~) + :: + $(start-links t.start-links) + :: + |- + ^- mark-path + :: + ?: =(~ path-queue) + :: no path found + ~ + =^ current path-queue [p q]:~(get to path-queue) + ?> ?=(^ current) + :: + ?: =(target target.i.current) + :: we have a completed path. paths in the queue are backwards + (flop current) + :: + =+ next-steps=(find-links-in-edges edges target.i.current) + :: filter out already visited nodes + :: + =. next-steps + %+ skip next-steps + |= link=mark-action + (~(has in visited-nodes) source.link) + :: then add the new ones to the set of already visited nodes + :: + =. visited-nodes + (~(gas in visited-nodes) (turn next-steps |=(mark-action source))) + :: now all next steps go in the queue + :: + =. path-queue + %- ~(gas to path-queue) + %+ turn next-steps + |= new-link=mark-action + [new-link current] + :: + $ + :: +find-links-in-edges: gets edges usable by +find-path-through + :: + :: This deals with disambiguating between %grab and %grow so we always + :: pick %grab over %grow. + :: + ++ find-links-in-edges + |= [edges=edge-jug source=term] + ^- (list mark-action) + :: + =+ links=~(tap in (~(get ju edges) source)) + :: + =| results=(set mark-action) + |- + ^- (list mark-action) + ?~ links + ~(tap in results) + :: + ?- arm.i.links + %grab + :: if :results has a %grow entry, remove it before adding our %grab + =/ grow-entry=mark-action [%grow source target.i.links] + =? results (~(has in results) grow-entry) + (~(del in results) grow-entry) + :: + =. results (~(put in results) [%grab source target.i.links]) + $(links t.links) + :: + %grow + :: if :results has a %grab entry, don't add a %grow entry + ?: (~(has in results) [%grab source target.i.links]) + $(links t.links) + :: + =. results (~(put in results) [%grow source target.i.links]) + $(links t.links) + == + -- :: |utilities:make: helper arms :: ::+| utilities diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 452300c68..a3bc03c61 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -995,7 +995,16 @@ [%slit =type] [%vale =cage] [%volt =cage] + [%walk results=(list mark-action)] == == == + :: +mark-action: represents a single mark conversion step + :: + :: In mark conversion, we want to convert from :source to :target. We also + :: need to keep track of what type of conversion this is. If %grab, we + :: want to use the definitions in the :target mark. If %grow, we want to + :: use the :source mark. + :: + += mark-action [type=?(%grow %grab) source=term target=term] :: :: +schematic: plan for building :: @@ -1313,6 +1322,19 @@ :: input=* == + :: %walk: finds a mark conversion path between two marks + :: + $: %walk + :: disc in clay to load the marks from + :: + =disc + :: source: the original mark type + :: + source=term + :: target: the destination mark type + :: + target=term + == == :: :: +scaffold: program construction in progress @@ -1544,6 +1566,7 @@ %slit [%noun !>(type.result)] %vale cage.result %volt cage.result + %walk [%noun !>(results.result)] == :: +result-as-error: extracts a tang out of a made-result ::