diff --git a/gen/cosmetic.hoon b/gen/cosmetic.hoon deleted file mode 100644 index 8807d06c01..0000000000 --- a/gen/cosmetic.hoon +++ /dev/null @@ -1,1039 +0,0 @@ -:: "Hello world" sample generator -:: -:::: /hoon/hello/gen - :: -/? 310 -!: -:: -:::: - :: -:- %say -|= {^ {{subject=type ~} ~}} -:- %txt -^- wain -=< =/ spec=spec ~(structure cosmetic subject) - =/ plum=plum (spec-to-plum spec) - ~(tall plume plum) -|% -:: -:: *cosmetic-state: for cosmetic below -:: -+* cosmetic-state [form] - $: :: count: cumulative blocks detected - :: pairs: blocking numbers and specs - :: - count=@ud - pairs=(map type (pair @ud form)) - == -:: -+* analyst [form] - $_ ^? - |% - ++ atom *$-([aura=term constant=(unit @)] form) - ++ cell *$-([=form =form] form) - ++ core *$-([=vair =form =(map term form)] form) - ++ face *$-([decor=$@(term tune) =form] form) - ++ fork *$-(=(list form) form) - ++ loop *$-([=form =(map @ud form)] form) - -- -:: -:: $xray: initial type analysis -:: - -+$ scan - $- - $@ $? %noun - %void - == - $% [%bare =atom =aura] :: constant - [%bark =(map atom aura)] :: constant set - - - -+$ shoe - $@ %void :: empty - $% [%bark =(map atom type)] :: flat constants - [%bush wide=shoe long=shoe] :: by cell/atom head - [%leaf =type] :: any atom - [%root flat=shoe deep=shoe] :: by atom/cell - [%tree =type] :: any cell - [%wood =(map atom (pair type type))] :: by atom head - == :: -:: -:: =merge: combine two shoes -:: -++ merge-shoes - |= [one=shoe two=shoe] - ^- (unit shoe) - ?@ one `two - ?@ two `one - ?- -.one - %bark - ?- -.two - %bark - :+ ~ %bark - :: (both maps merged, combining collisions) - :: - =/ list ~(tap by map.one) - |- ^- (map atom type) - ?~ list map.two - %= $ - list t.list - map.two - %+ ~(put by map.two) - p.i.list - =+ (~(get by map.two) p.i.list) - ?~ - q.i.list - (fork u.- q.i.list ~) - == - :: - %bush - `[%root one two] - :: - %leaf - :- ~ - :- %leaf - %+ fork - type.two - (turn ~(tap by map.one) |=([* =type] type)) - :: - %root - %+ bind $(two flat.two) - |= new=shoe - [%root new deep.two] - :: - %tree - `[%root one two] - :: - %wood - `[%root one two] - == - :: - %bush - ?+ -.two $(one two, two one) - :: - %bush - %^ clef - $(one wide.one, two wide.two) - $(one long.one, two long.two) - |=([wide=shoe long=shoe] `[%root wide long]) - :: - %leaf - `[%root two one] - :: - %root - %+ bind $(two deep.two) - |= new=shoe - [%root flat.two new] - :: - %tree - ~ - :: - %wood - %+ bind $(one long.one) - |= new=shoe - [%bush wide.one new] - == - :: - %leaf - ?+ -.two $(one two, two one) - :: - %leaf - `[%leaf (fork type.one type.two ~)] - :: - %root - %+ bind $(two flat.two) - |= new=shoe - [%root new deep.two] - :: - %tree - `[%root one two] - :: - %wood - `[%root one two] - == - :: - %root - ?+ -.two $(one two, two one) - :: - %root - %^ clef - $(one flat.one, two flat.two) - $(one deep.one, two deep.two) - |=([flat=shoe deep=shoe] `[%root flat deep]) - :: - %tree - %+ bind $(one deep.one) - |= new=shoe - [%root one new] - :: - %wood - %+ bind $(one deep.one) - |= new=shoe - [%root one new] - == - :: - %tree - ?+ -.two $(one two, two one) - :: - %tree - `[%tree (fork type.one type.two ~)] - :: - %wood - ~ - == - :: - %wood - ?+ -.two $(one two, two one) - :: - %wood - :: (both maps merged, combining collisions) - :: - :- ~ - :- %wood - =/ list ~(tap by map.one) - |- ^- (map atom (pair type type)) - ?~ list map.two - %= $ - list t.list - map.two - %+ ~(put by map.two) - p.i.list - =+ (~(get by map.two) p.i.list) - ?~ - q.i.list - [(fork p.u.- p.q.i.list ~) (fork q.u.- q.q.i.list ~)] - == - == - == -:: -:: =shew: deconstruct type -:: -++ shew - |= =type - :: (analysis of .type, if well-formed) - :: - ^- (unit shoe) - =- :: (analysis without trivial cases) - :: - %+ biff - - |= =shoe - ?- shoe - %void ~ - [%bark *] ?:(?=([* ~ ~] map.shoe) ~ `shoe) - [%bush *] `shoe - [%leaf *] ~ - [%root *] `shoe - [%tree *] ~ - [%wood *] ?:(?=([* ~ ~] map.shoe) ~ `shoe) - == - |^ =| gil/(set ^type) - |- ^- (unit shoe) - ?- type - %void `%void - %noun ~ - :: - [%atom *] as-done - [%cell *] :: if the head of .type is always a cell - :: - ?: is-cell(type p.type) - :: (a trivial bush) - :: - `[%bush [%tree type] %void] - :: unless the head of .type is an atom - :: - ?. is-atom(type p.type) - :: (an opaque cell) - :: - `[%tree type] - %+ biff to-atom(type p.type) - |= =atom - :: (a trivial wood) - :: - `[%wood [%atom p.type q.type] ~ ~] - [%core *] ~ - [%face *] as-done - [%fork *] =/ list ~(tap in p.type) - |- ^- (unit shoe) - ?~ list `%void - %+ biff ^$(type i.list) - |= =shoe - %+ biff ^$(list t.list) - |= =^shoe - (merge-shoes shoe ^shoe) - :: - [%hint *] $(type q.type) - [%hold *] ?: (~(has in gil) type) `%void - $(gil (~(put in gil) type), type ~(repo ut type)) - == - :: - ++ is-atom (~(nest ut [%atom %$ ~]) %| type) - ++ is-cell (~(nest ut [%cell %noun %noun]) %| type) - ++ as-done ?: is-atom - =+ to-atom - ?~ - - `[%leaf type] - `[%bark [u.- type] ~ ~] - ?: is-cell - `[%tree type] - ~ - ++ to-atom |- ^- (unit atom) - ?- type - %void ~ - %noun !! - [%atom *] q.type - [%cell *] !! - [%core *] !! - [%fork *] =/ list ~(tap in p.type) - ?~ list !! - |- ^- (unit atom) - =+ ^$(type i.list) - ?~ t.list - - %+ biff - - |= =atom - %+ biff ^$(i.list i.t.list, t.list t.t.list) - |= =^atom - ?.(=(atom ^atom) ~ `atom) - [%face *] $(type q.type) - [%hint *] $(type q.type) - [%hold *] $(type ~(repo ut type)) - == - -- -:: -++ cosmetic - %- (kismet spec) - |% - ++ atom - |= $: :: aura: flavor of atom - :: constant: one value, or all values - :: - aura=term - constant=(unit @) - == - ^- spec - :: if atom is not constant - :: - ?~ constant - :: %base: flavored atom with arbitrary value - :: - [%base atom/aura] - :: %leaf: flavored constant - :: - [%leaf aura u.constant] - :: - ++ cell - |= $: :: head: head of cell - :: tail: tail of cell - :: - head=spec - tail=spec - == - ^- spec - :: %bscl: raw tuple - :: - ?: ?=(%bscl -.tail) - [%bscl head +.tail] - [%bscl head tail ~] - :: - ++ core - |= $: :: variance: co/contra/in/bi - :: payload: data - :: battery: code - :: - variance=vair - payload=spec - battery=(map term spec) - == - ?- variance - %lead [%bszp payload battery] - %gold [%bsdt payload battery] - %zinc [%bstc payload battery] - %iron [%bsnt payload battery] - == - :: - ++ face - |= $: :: decor: decoration - :: content: decorated content - :: - decor=$@(term tune) - body=spec - == - ^- spec - ?@ decor [%bsts decor body] - :: discard aliases, etc - :: - body - :: - ++ fork - |= specs=(list spec) - ^- spec - ?< ?=(~ specs) - [%bswt specs] - -- -:: -:: type-to-spec -:: -++ kismet - |* form=mold - |= producer=(analyst form) - =| :: coat: contextual metadata - :: - $= coat - $: :: trace: type analysis stack - :: - trace=(set type) - == - =| :: load: accumulating metadata (state) - :: - load=(cosmetic-state form) - :: - :: sut: type we're analyzing - :: - |_ sut/type - :: - :: +structure: make cosmetic spec from :sut - :: - ++ structure - ^- spec - :: clear superficial structure and hints - :: - =. sut |- ^- type - ?. ?=([?(%hint %hold) *] sut) sut - $(sut ~(repo ut sut)) - :: - :: spec: raw analysis product - :: - =^ spec load specify - :: if we didn't block, just use it - :: - ?: =(~ pairs.load) spec - :: otherwise, insert hygienic recursion - :: - :+ %bsbs spec - %- ~(gas by *(map term ^spec)) - %+ turn - ~(tap by pairs.load) - |= [=type index=@ud spec=^spec] - [(synthetic index) spec] - :: - :: +pattern: pattern and context for data inspection - :: - ++ pattern - ^- $: :: main: rendering pattern - :: context: recursion points by counter - :: - main=plot - loop=(map @ud plot) - == - !! - :: - :: +synthetic: convert :number to a synthetic name - :: - ++ synthetic - |= number=@ud - ^- @tas - =/ alf/(list term) - ^~ :~ %alf %bet %gim %dal %hej %vav %zay %het - %tet %yod %kaf %lam %mem %nun %sam %ayn - %pej %sad %qof %res %sin %tav - == - ?: (lth number 22) - (snag number alf) - (cat 3 (snag (mod number 22) alf) $(number (div number 22))) - :: - :: +specify: make spec that matches :sut - :: - ++ specify - ^- [spec _load] - =< entry - |% - :: +entry: make spec at potential entry point - :: - ++ entry - ^- [spec _load] - :: old: old recursion binding for :sut - :: - =/ old (~(get by pairs.load) sut) - :: if, already bound, reuse binding - :: - ?^ old [[%loop (synthetic p.u.old)] load] - :: if, we are already inside :sut - :: - ?: (~(has in trace.coat) sut) - :: then, produce and record a block reference - :: - =+ [%loop (synthetic count.load)] - :- - - %_ load - count +(count.load) - pairs (~(put by pairs.load) sut [count.load -]) - == - :: else, filter main loop for block promotion - :: - =^ spec load main(trace.coat (~(put in trace.coat) sut)) - :: check if we re-entered :sut while traversing - :: - =/ new (~(get by pairs.load) sut) - :: if, we did not find :sut inside itself - :: - ?~ new - :: then, :sut is not a true entry point - :: - [spec load] - :: else, produce a reference and record the analysis - :: - :- [%loop (synthetic p.u.new)] - load(pairs (~(put by pairs.load) sut [p.u.new spec])) - :: - :: +meta: try to make spec from type of filter - :: - ::++ meta ^- [(unit spec) _load] - :: - :: +main: make spec from any type - :: - ++ main - ^- [spec _load] - ?- sut - %void :_(load [%base %void]) - %noun :_(load [%base %noun]) - :: - [%atom *] (atom p.sut q.sut) - [%cell *] (cell p.sut q.sut) - [%core *] (core p.sut q.sut) - [%face *] (face p.sut q.sut) - [%hint *] =+((rely p.p.sut q.p.sut) ?^(- u.- main(sut q.sut))) - [%fork *] (fork p.sut) - [%hold *] entry(sut ~(repo ut sut)) - == - :: - :: +rely: rationalize structure from type (stub) - :: - ++ rely - |= [=type =note] - ^- (unit [spec _load]) - ?. ?=(%made -.note) ~ - ?~ q.note - `[`spec`[%like [[p.note ~] ~]] load] - =- `[[%make [%limb p.note] -<] ->] - |- ^- [(list spec) _load] - ?~ u.q.note [~ load] - =^ more load $(u.q.note t.u.q.note) - =/ part (~(play ut type) [%tsld [%limb %$] [%wing i.u.q.note]]) - =^ spec load entry(sut part) - [[spec more] load] - :: - :: +atom: convert atomic type to spec - :: - ++ atom - |= $: :: aura: flavor of atom - :: constant: one value, or all values - :: - aura=term - constant=(unit @) - == - :: pure function - :: - [(atom:producer aura constant) load] - :: - :: +cell: convert a %cell to a spec - :: - ++ cell - |= $: :: left: head of cell - :: rite: tail of cell - :: - left=type - rite=type - == - ^- [spec _load] - :: head: cosmetic structure of head - :: tail: cosmetic structure of tail - :: - =^ head load main(sut left) - =^ tail load main(sut rite) - [(cell:producer head tail) load] - :: - :: +core: convert a %core to a spec - :: - ++ core - |= $: :: payload: data - :: battery: code - :: - payload=type - battery=coil - == - ^- [spec _load] - :: payload-spec: converted payload - :: - =^ payload-spec load main(sut payload) - :: arms: all arms in the core, as hoons - :: - =/ arms - ^- (list (pair term hoon)) - %- zing - ^- (list (list (pair term hoon))) - %+ turn ~(tap by q.r.battery) - |= [term =tome] - ~(tap by q.tome) - :: arm-specs: all arms in the core, as specs - :: - =^ arm-specs load - |- ^- [(list (pair term spec)) _load] - ?~ arms [~ load] - =^ mor load $(arms t.arms) - =^ les load - main(sut [%hold [%core payload battery] q.i.arms]) - [[[p.i.arms les] mor] load] - :: arm-map: all arms in the core, as a a spec map - :: - =* arm-map (~(gas by *(map term spec)) arm-specs) - [(core:producer r.p.battery payload-spec arm-map) load] - :: - :: +face: convert a %face to a +spec - :: - ++ face - |= $: :: decor: decoration - :: content: decorated content - :: - decor=$@(term tune) - content=type - == - ^- [spec _load] - =^ body load main(sut content) - [(face:producer decor body) load] - :: - :: +fork: convert a %fork to a +spec - :: - ++ fork - |= types=(set type) - ^- [spec _load] - :: type-list: type set as a list - :: - =/ type-list ~(tap by types) - :: specs: type set as a list of specs - :: - =^ specs load - |- ^- [(list spec) _load] - ?~ type-list [~ load] - =^ mor load $(type-list t.type-list) - =^ les load main(sut i.type-list) - [[les mor] load] - [(fork:producer specs) load] - -- - -- -:: -++ plume - |_ =plum - :: - :: +flat: print as a single line - :: - ++ flat - text:linear - :: - :: +tall: print as multiple lines - :: - ++ tall - ^- wain - %+ turn window - |= [indent=@ud text=tape] - (crip (runt [indent ' '] text)) - :: - :: +adjust: adjust lines to right - :: - ++ adjust - |= [tab=@ud =(list [length=@ud text=tape])] - (turn list |=([@ud tape] [(add tab +<-) +<+])) - :: - :: +window: print as list of tabbed lines - :: - ++ window - ^- (list [indent=@ud text=tape]) - :: memoize for random access - :: - ~+ - :: trivial text - :: - ?@ plum [0 (trip plum)]~ - ?- -.plum - :: %|: text wrap - :: - %| :: wrapping stub, should wrap text to 40 characters - :: - [0 +:linear]~ - :: - :: %&: text tree - :: - %& :: trial: attempt at wide hint - :: - =/ trial ?~(wide.plum ~ [~ u=linear]) - :: if wide hint is available or optimal - :: - ?: ?& ?=(^ trial) - ?| ?=(~ tall.plum) - (lte length.u.trial 40) - == == - :: then produce wide hint - :: - [0 text.u.trial]~ - :: else assert tall style (you gotta set either wide or tall) - :: - ?> ?=(^ tall.plum) - :: blocks: subwindows - :: prelude: intro as tape - :: - =/ blocks (turn list.plum |=(=^plum window(plum plum))) - =/ prelude (trip intro.u.tall.plum) - :: if, :indef is empty - :: - ?~ indef.u.tall.plum - :: then, print in sloping mode - :: - :: if, no children - :: - ?: =(~ blocks) - :: then, the prelude if any - :: - ?~(prelude ~ [0 prelude]~) - :: else, format children and inject any prelude - :: - ^- (list [indent=@ud text=tape]) - :: concatenate child blocks into a single output - :: - %- zing - :: count: number of children - :: index: current child from 1 to n - :: - =/ count (lent blocks) - =/ index 1 - |- ^+ blocks - ?~ blocks ~ - :_ $(blocks t.blocks, index +(index)) - ^- (list [indent=@ud text=tape]) - :: indent: backstep indentation level - :: - =/ indent (mul 2 (sub count index)) - :: unless, we're on the first block - :: - ?. =(1 index) - :: else, apply normal backstep indentation - :: - (adjust indent i.blocks) - :: then, apply and/or inject prelude - :: - :: this fixes the naive representations - :: - :: :+ - :: foo - :: bar - :: baz - :: - :: and - :: - :: :- - :: foo - :: bar - :: - =. indent (max indent (add 2 (lent prelude))) - =. i.blocks (adjust indent i.blocks) - ?~ i.blocks ?~(prelude ~ [0 prelude]~) - ?~ prelude i.blocks - :_ t.i.blocks - :- 0 - ~| [%indent indent] - ~| [%prelude prelude] - ~| [%kids list.plum] - ~| [%blocks blocks] - %+ weld prelude - (runt [(sub indent.i.i.blocks (lent prelude)) ' '] text.i.i.blocks) - :: - :: else, print in vertical mode - :: - :: prefix: before each entry - :: finale: after all entries - :: - =/ prefix (trip sigil.u.indef.u.tall.plum) - =/ finale (trip final.u.indef.u.tall.plum) - :: if, no children, then, just prelude and finale - :: - ?: =(~ blocks) - %+ weld - ?~(prelude ~ [0 prelude]~) - ?~(finale ~ [0 finale]~) - :: if, no :prefix - :: - ?: =(~ prefix) - :: kids: flat list of child lines - :: tab: amount to indent kids - :: - =/ kids `(list [indent=@ud text=tape])`(zing blocks) - =* tab =+((lent prelude) ?+(- 2 %0 0, %1 2, %2 4)) - :: indent kids by tab - :: - =. kids (turn kids |=([@ud tape] [(add tab +<-) +<+])) - :: prepend or inject prelude - :: - =. kids - ?: =(~ prelude) kids - :: if, no kids, or prelude doesn't fit - :: - ?: |(?=(~ kids) (gte +((lent prelude)) indent.i.kids)) - :: don't inject, just add to head if needed - :: - [[0 prelude] kids] - :: inject: prelude - :: - =* inject %+ weld - prelude - %+ runt - [(sub indent.i.kids (lent prelude)) ' '] - text.i.kids - [[0 inject] t.kids] - :: append finale - :: - ?~ finale kids - (weld kids ^+(kids [0 finale]~)) - :: else, with :prefix - :: - :: append :finale - :: - =- ?~ finale - - (weld - ^+(- [0 finale]~)) - ^- (list [indent=@ud text=tape]) - :: clear: clearance needed to miss prefix - :: - =/ clear (add 2 (lent prefix)) - %- zing - :: combine each subtree with the prefix - :: - %+ turn blocks - |= =(list [indent=@ud text=tape]) - ^+ +< - :: tab: depth to indent - :: - =* tab ?~(list 0 (sub clear (min clear indent.i.list))) - =. list (turn list |=([@ud tape] [(add tab +<-) +<+])) - ?~ list ~ - :_ t.list - :- 0 - %+ weld - prefix - (runt [(sub indent.i.list (lent prefix)) ' '] text.i.list) - == - :: - :: +linear: make length and tape - :: - ++ linear - ^- $: length=@ud - text=tape - == - :: memoize for random access - :: - ~+ - :: atomic plums are just text - :: - ?@ plum [(met 3 plum) (trip plum)] - ?- -.plum - :: %|: text wrap - :: - %| :: lay the text out flat, regardless of length - :: - |- ^- [length=@ud text=tape] - ?~ list.plum [0 ~] - =/ next $(list.plum t.list.plum) - =/ this [length=(met 3 i.list.plum) text=(trip i.list.plum)] - :- (add +(length.this) length.next) - (weld text.this `tape`[' ' text.next]) - :: - :: %&: text tree - :: - %& :: if there is no wide representation - :: - ?~ wide.plum - :: then lay out a window, then separate with double-spaces - :: - =/ window window - |- ^- [length=@ud text=tape] - ?~ window [0 ~] - =/ next $(window t.window) - :- :(add (lent text.i.window) 2 length.next) - ?~(text.next text.i.window :(weld text.i.window " " text.next)) - :: - :: else use wide layout - :: - =- :: add enclosure if any - :: - ?~ enclose.u.wide.plum body - =* clamps u.enclose.u.wide.plum - =/ close [(trip -.clamps) (trip +.clamps)] - :- :(add length.body (lent -.close) (lent +.close)) - :(weld -.close text.body +.close) - :: - :: body: body of wide rendering - :: - ^= body - =/ stop (trip delimit.u.wide.plum) - |- ^- [length=@ud text=tape] - ?~ list.plum [0 ~] - =/ next $(list.plum t.list.plum) - =/ this linear(plum i.list.plum) - ?~ text.next this - :- :(add length.this (lent stop) length.next) - :(weld text.this stop text.next) - == - -- -:: highly unsatisfactory temporary tank printer -:: -++ plum-to-tank - |= =plum - ^- tank - ?@ plum [%leaf (trip plum)] - ?- -.plum - %| :+ %rose - ["" " " ""] - (turn list.plum |=(@ta [%leaf (trip +<)])) - %& =/ list (turn list.plum ..$) - ?~ tall.plum - ?> ?=(^ wide.plum) - =? enclose.u.wide.plum ?=(~ enclose.u.wide.plum) `['{' '}'] - :+ %rose - :* (trip delimit.u.wide.plum) - (trip +<:enclose.u.wide.plum) - (trip +>:enclose.u.wide.plum) - == - list - ?: ?=(^ indef.u.tall.plum) - :+ %rose - :* (trip sigil.u.indef.u.tall.plum) - (weld (trip intro.u.tall.plum) "[") - (weld "]" (trip final.u.indef.u.tall.plum)) - == - list - :+ %palm - :* (weld (trip intro.u.tall.plum) "(") - "" - "" - ")" - == - list - == -++ limb-to-plum - |= =limb - ?@ limb limb - ?- -.limb - %& (scot %ui p.limb) - %| (crip (runt [0 p.limb] ?~(q.limb "," (trip u.q.limb)))) - == -:: -++ wing-to-plum - |= =wing - ^- plum - :+ %& - [`['.' ~] ~] - (turn wing limb-to-plum) -:: -++ battery-to-plum - |= =(map term spec) - %+ turn ~(tap by map) - |= [=term =spec] - :+ %& - [`[' ' ~] `['' ~]] - [term (spec-to-plum spec) ~] -:: -++ core-to-plum - |= [=knot =spec =(map term spec)] - ^- plum - :+ %& - [~ `[knot ~]] - :~ (spec-to-plum spec) - :+ %& - [~ `['' `['++' '--']]] - (battery-to-plum map) - == -:: -++ varying - |= [intro=knot final=knot] - [`[' ' `[(cat 3 intro '(') ')']] `[intro `['' final]]] -:: -++ fixed - |= @ta - [`[' ' `[(cat 3 +< '(') ')']] `[+< ~]] -:: -++ standard - |= =stud - ^- plum - ?@ stud stud - :+ %& - [`['/' ~] ~] - `(list plum)`[auth.stud type.stud] -:: -++ hoon-to-plum - |= =hoon - ^- plum - :: XX fill this in please - :: - ?: ?=([%limb *] hoon) - p.hoon - %hooon -:: -++ skin-to-plum - |= =skin - ^- plum - %skinny -:: -++ spec-to-plum - |= =spec - ^- plum - ?- -.spec - %base ?- p.spec - %noun '*' - %cell '^' - %flag '?' - %null '~' - %void '!!' - [%atom *] (cat 3 '@' p.p.spec) - == - %dbug $(spec q.spec) - %leaf =+((scot p.spec q.spec) ?:(=('~' -) - (cat 3 '%' -))) - %like &/[[`[':' ~] ~] (turn `(list wing)`+.spec wing-to-plum)] - %loop (cat 3 '$' p.spec) - %name $(spec q.spec) - %made $(spec q.spec) - %over $(spec q.spec) - %make =+ (lent q.spec) - :+ %& - :- `[' ' `['(' ')']] - :- ~ - ?: |((gth - 3) =(- 0)) - ['%:' `['' '==']] - :_ ~ - ?: =(- 3) '%^' - ?: =(- 2) '%+' '%-' - [(hoon-to-plum p.spec) (turn q.spec ..$)] - %bsbs (core-to-plum '$$' p.spec q.spec) - %bsbr &/[(fixed '$|') $(spec p.spec) (hoon-to-plum q.spec) ~] - %bscb (hoon-to-plum p.spec) - %bscl :+ %& - [`[' ' `['[' ']']] `['$:' `['' '==']]] - (turn `(list ^spec)`+.spec ..$) - %bscn &/[(varying '$%' '==') (turn `(list ^spec)`+.spec ..$)] - %bsdt (core-to-plum '$.' p.spec q.spec) - %bsld &/[(fixed '$<') $(spec p.spec) $(spec q.spec) ~] - %bsbn &/[(fixed '$>') $(spec p.spec) $(spec q.spec) ~] - %bshp &/[(fixed '$-') $(spec p.spec) $(spec q.spec) ~] - %bskt &/[(fixed '$-') $(spec p.spec) $(spec q.spec) ~] - %bsls &/[(fixed '$+') (standard p.spec) $(spec q.spec) ~] - %bsnt (core-to-plum '$/' p.spec q.spec) - %bsmc &/[(fixed '$;') (hoon-to-plum p.spec) ~] - %bspd &/[(fixed '$&') $(spec p.spec) (hoon-to-plum q.spec) ~] - %bssg &/[(fixed '$~') (hoon-to-plum p.spec) $(spec q.spec) ~] - %bstc (core-to-plum '$`' p.spec q.spec) - %bsts :+ %& - [`['=' ~] `['$=' ~]] - :~ (skin-to-plum p.spec) - $(spec q.spec) - == - %bsvt &/[(fixed '$@') $(spec p.spec) $(spec q.spec) ~] - %bswt :+ %& - [`[' ' `['?(' ')']] `['$?' `['' '==']]] - (turn `(list ^spec)`+.spec ..$) - %bszp (core-to-plum '$.' p.spec q.spec) - == --- diff --git a/gen/lust.hoon b/gen/lust.hoon deleted file mode 100644 index 8a6c8ea55d..0000000000 --- a/gen/lust.hoon +++ /dev/null @@ -1,486 +0,0 @@ - - - - - -=> |% - :: - ++ system - $: rec/(map @ud theory) - say/theory - == - ++ library - - :: - ++ theory - $@ $? $void - $path - $noun - $hoon - $wall - $text - $tape - $cord - $null - $term - $type - $tank - == - $% {$list item/theory} - {$pole item/theory} - {$set item/theory} - {$map key/theory value/theory} - {$soft type/type data/theory} - {$tuple items/(list theory)} - {$label name/term data/theory} - {$tree item/theory} - {$help writ/writ theory/theory} - {$gate from/theory to/theory} - :: {$core library/} - {$unit item/theory} - {$atom aura/aura} - {$choice cases/(list theory)} - {$branch atom/theory cell/theory} - {$bridge double/theory single/theory} - {$switch cases/(list {stem/theory bulb/theory})} - {$constant aura/aura value/@} - {$pair p/theory q/theory} - {$trel p/theory q/theory r/theory} - {$qual p/theory q/theory r/theory s/theory} - {$quil p/theory q/theory r/theory s/theory t/theory} - -- -|% -++ py - - - -++ us :: prettyprinter - => |% - ++ cape {p/(map @ud wine) q/wine} :: - ++ wine :: - $@ $? $noun :: - $path :: - $type :: - $void :: - $wall :: - $wool :: - $yarn :: - == :: - $% {$mato p/term} :: - {$core p/(list @ta) q/wine} :: - {$face p/term q/wine} :: - {$list p/term q/wine} :: - {$pear p/term q/@} :: - {$bcwt p/(list wine)} :: - {$plot p/(list wine)} :: - {$stop p/@ud} :: - {$tree p/term q/wine} :: - {$unit p/term q/wine} :: - == :: - -- - |_ sut/type - ++ dash - |= {mil/tape lim/char} ^- tape - :- lim - |- ^- tape - ?~ mil [lim ~] - ?: =(lim i.mil) ['\\' i.mil $(mil t.mil)] - ?: =('\\' i.mil) ['\\' i.mil $(mil t.mil)] - ?: (lte ' ' i.mil) [i.mil $(mil t.mil)] - ['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 i.mil)) $(mil t.mil)] - :: - ++ deal |=(lum/* (dish dole lum)) - ++ dial - |= ham/cape - =+ gid=*(set @ud) - =< `tank`-:$ - |% - ++ many - |= haz/(list wine) - ^- {(list tank) (set @ud)} - ?~ haz [~ gid] - =^ mor gid $(haz t.haz) - =^ dis gid ^$(q.ham i.haz) - [[dis mor] gid] - :: - ++ $ - ^- {tank (set @ud)} - ?- q.ham - $noun :_(gid [%leaf '*' ~]) - $path :_(gid [%leaf '/' ~]) - $type :_(gid [%leaf '#' 't' ~]) - $void :_(gid [%leaf '#' '!' ~]) - $wool :_(gid [%leaf '*' '"' '"' ~]) - $wall :_(gid [%leaf '*' '\'' '\'' ~]) - $yarn :_(gid [%leaf '"' '"' ~]) - {$mato *} :_(gid [%leaf '@' (trip p.q.ham)]) - {$core *} - =^ cox gid $(q.ham q.q.ham) - :_ gid - :+ %rose - [[' ' ~] ['<' ~] ['>' ~]] - |- ^- (list tank) - ?~ p.q.ham [cox ~] - [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)] - :: - {$face *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%palm [['/' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~]) - :: - {$list *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~]) - :: - {$bcwt *} - =^ coz gid (many p.q.ham) - :_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz]) - :: - {$plot *} - =^ coz gid (many p.q.ham) - :_(gid [%rose [[' ' ~] ['{' ~] ['}' ~]] coz]) - :: - {$pear *} - :_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])]) - :: - {$stop *} - =+ num=~(rend co [%$ %ud p.q.ham]) - ?: (~(has in gid) p.q.ham) - :_(gid [%leaf '#' num]) - =^ cox gid - %= $ - gid (~(put in gid) p.q.ham) - q.ham (~(got by p.ham) p.q.ham) - == - :_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~]) - :: - {$tree *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~]) - :: - {$unit *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~]) - == - -- - :: - ++ dish - |= {ham/cape lum/*} ^- tank - ~| [%dish-h ?@(q.ham q.ham -.q.ham)] - ~| [%lump lum] - ~| [%ham ham] - %- need - =| gil/(set {@ud *}) - |- ^- (unit tank) - ?- q.ham - $noun - %= $ - q.ham - ?: ?=(@ lum) - [%mato %$] - :- %plot - |- ^- (list wine) - [%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))] - == - :: - $path - :- ~ - :+ %rose - [['/' ~] ['/' ~] ~] - |- ^- (list tank) - ?~ lum ~ - ?@ lum !! - ?> ?=(@ -.lum) - [[%leaf (rip 3 -.lum)] $(lum +.lum)] - :: - $type - =+ tyr=|.((dial dole)) - =+ vol=tyr(sut lum) - =+ cis=((hard tank) .*(vol -:vol)) - :^ ~ %palm - [~ ~ ~ ~] - [[%leaf '#' 't' '/' ~] cis ~] - :: - $wall - :- ~ - :+ %rose - [[' ' ~] ['<' '|' ~] ['|' '>' ~]] - |- ^- (list tank) - ?~ lum ~ - ?@ lum !! - [[%leaf (trip ((hard @) -.lum))] $(lum +.lum)] - :: - $wool - :- ~ - :+ %rose - [[' ' ~] ['<' '<' ~] ['>' '>' ~]] - |- ^- (list tank) - ?~ lum ~ - ?@ lum !! - [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)] - :: - $yarn - [~ %leaf (dash (tape lum) '"')] - :: - $void - ~ - :: - {$mato *} - ?. ?=(@ lum) - ~ - :+ ~ - %leaf - ?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig))) - ~(rend co [%$ p.q.ham lum]) - $$ ~(rend co [%$ %ud lum]) - $t (dash (rip 3 lum) '\'') - $tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])] - == - :: - {$core *} - :: XX needs rethinking for core metal - :: ?. ?=(^ lum) ~ - :: => .(lum `*`lum) - :: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok]) - :: ^= tok - :: |- ^- (unit (list tank)) - :: ?~ p.q.ham - :: =+ den=^$(q.ham q.q.ham) - :: ?~(den ~ [~ u.den ~]) - :: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum) - :: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]]) - [~ (dial ham)] - :: - {$face *} - =+ wal=$(q.ham q.q.ham) - ?~ wal - ~ - [~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~] - :: - {$list *} - ?: =(~ lum) - [~ %leaf '~' ~] - =- ?~ tok - ~ - [~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok] - ^= tok - |- ^- (unit (list tank)) - ?: ?=(@ lum) - ?.(=(~ lum) ~ [~ ~]) - =+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)] - ?. &(?=(^ for) ?=(^ aft)) - ~ - [~ u.for u.aft] - :: - {$bcwt *} - |- ^- (unit tank) - ?~ p.q.ham - ~ - =+ wal=^$(q.ham i.p.q.ham) - ?~ wal - $(p.q.ham t.p.q.ham) - wal - :: - {$plot *} - =- ?~ tok - ~ - [~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok] - ^= tok - |- ^- (unit (list tank)) - ?~ p.q.ham - ~ - ?: ?=({* ~} p.q.ham) - =+ wal=^$(q.ham i.p.q.ham) - ?~(wal ~ [~ [u.wal ~]]) - ?@ lum - ~ - =+ gim=^$(q.ham i.p.q.ham, lum -.lum) - ?~ gim - ~ - =+ myd=$(p.q.ham t.p.q.ham, lum +.lum) - ?~ myd - ~ - [~ u.gim u.myd] - :: - {$pear *} - ?. =(lum q.q.ham) - ~ - =. p.q.ham - (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig))) - =+ fox=$(q.ham [%mato p.q.ham]) - ?> ?=({~ $leaf ^} fox) - ?: ?=(?($n $tas) p.q.ham) - fox - [~ %leaf '%' p.u.fox] - :: - {$stop *} - ?: (~(has in gil) [p.q.ham lum]) ~ - =+ kep=(~(get by p.ham) p.q.ham) - ?~ kep - ~|([%stop-loss p.q.ham] !!) - $(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep) - :: - {$tree *} - =- ?~ tok - ~ - [~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok] - ^= tok - =+ tuk=*(list tank) - |- ^- (unit (list tank)) - ?: =(~ lum) - [~ tuk] - ?. ?=({n/* l/* r/*} lum) - ~ - =+ rol=$(lum r.lum) - ?~ rol - ~ - =+ tim=^$(q.ham q.q.ham, lum n.lum) - ?~ tim - ~ - $(lum l.lum, tuk [u.tim u.rol]) - :: - {$unit *} - ?@ lum - ?.(=(~ lum) ~ [~ %leaf '~' ~]) - ?. =(~ -.lum) - ~ - =+ wal=$(q.ham q.q.ham, lum +.lum) - ?~ wal - ~ - [~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~] - == - :: - ++ doge - |= ham/cape - =- ?+ woz woz - {$list * {$mato $'ta'}} %path - {$list * {$mato $'t'}} %wall - {$list * {$mato $'tD'}} %yarn - {$list * $yarn} %wool - == - ^= woz - ^- wine - ?. ?=({$stop *} q.ham) - ?: ?& ?= {$bcwt {$pear $n $0} {$plot {$pear $n $0} {$face *} ~} ~} - q.ham - =(1 (met 3 p.i.t.p.i.t.p.q.ham)) - == - [%unit =<([p q] i.t.p.i.t.p.q.ham)] - q.ham - =+ may=(~(get by p.ham) p.q.ham) - ?~ may - q.ham - =+ nul=[%pear %n 0] - ?. ?& ?=({$bcwt *} u.may) - ?=({* * ~} p.u.may) - |(=(nul i.p.u.may) =(nul i.t.p.u.may)) - == - q.ham - =+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may) - ?: ?& ?=({$plot {$face *} {$face * $stop *} ~} din) - =(p.q.ham p.q.i.t.p.din) - =(1 (met 3 p.i.p.din)) - =(1 (met 3 p.i.t.p.din)) - == - :+ %list - (cat 3 p.i.p.din p.i.t.p.din) - q.i.p.din - ?: ?& ?= $: $plot - {$face *} - {$face * $stop *} - {{$face * $stop *} ~} - == - din - =(p.q.ham p.q.i.t.p.din) - =(p.q.ham p.q.i.t.t.p.din) - =(1 (met 3 p.i.p.din)) - =(1 (met 3 p.i.t.p.din)) - =(1 (met 3 p.i.t.t.p.din)) - == - :+ %tree - %^ cat - 3 - p.i.p.din - (cat 3 p.i.t.p.din p.i.t.t.p.din) - q.i.p.din - q.ham - :: - ++ dole - ^- cape - =+ gil=*(set type) - =+ dex=[p=*(map type @) q=*(map @ wine)] - =< [q.p q] - |- ^- {p/{p/(map type @) q/(map @ wine)} q/wine} - =- [p.tez (doge q.p.tez q.tez)] - ^= tez - ^- {p/{p/(map type @) q/(map @ wine)} q/wine} - ?: (~(meet ut sut) -:!>(*type)) - [dex %type] - ?- sut - $noun [dex sut] - $void [dex sut] - {$atom *} [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])] - {$cell *} - =+ hin=$(sut p.sut) - =+ yon=$(dex p.hin, sut q.sut) - :- p.yon - :- %plot - ?:(?=({$plot *} q.yon) [q.hin p.q.yon] [q.hin q.yon ~]) - :: - {$core *} - =+ yad=$(sut p.sut) - :- p.yad - =+ ^= doy ^- {p/(list @ta) q/wine} - ?: ?=({$core *} q.yad) - [p.q.yad q.q.yad] - [~ q.yad] - :- %core - :_ q.doy - :_ p.doy - %^ cat 3 - %~ rent co - :+ %$ %ud - %- ~(rep by (~(run by q.s.q.sut) |=(tomb ~(wyt by q)))) - |=([[@ a=@u] b=@u] (add a b)) - == - %^ cat 3 - ?-(p.q.sut $gold '.', $iron '|', $lead '?', $zinc '&') - =+ gum=(mug q.s.q.sut) - %+ can 3 - :~ [1 (add 'a' (mod gum 26))] - [1 (add 'a' (mod (div gum 26) 26))] - [1 (add 'a' (mod (div gum 676) 26))] - == - :: - {$help *} - $(sut q.sut) - :: - {$face *} - =+ yad=$(sut q.sut) - ?^(q.p.sut yad [p.yad [%face q.p.sut q.yad]]) - :: - {$fork *} - =+ yed=~(tap in p.sut) - =- [p [%bcwt q]] - |- ^- {p/{p/(map type @) q/(map @ wine)} q/(list wine)} - ?~ yed - [dex ~] - =+ mor=$(yed t.yed) - =+ dis=^$(dex p.mor, sut i.yed) - [p.dis q.dis q.mor] - :: - {$hold *} - =+ hey=(~(get by p.dex) sut) - ?^ hey - [dex [%stop u.hey]] - ?: (~(has in gil) sut) - =+ dyr=+(~(wyt by p.dex)) - [[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]] - =+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut)) - =+ rey=(~(get by p.p.rom) sut) - ?~ rey - rom - [[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]] - == - :: - ++ duck (dial dole) - -- diff --git a/gen/musk.hoon b/gen/musk.hoon deleted file mode 100644 index 32603403ff..0000000000 --- a/gen/musk.hoon +++ /dev/null @@ -1,366 +0,0 @@ -:: -:::: - :: -:- %say -|= {^ {{typ/type gen/hoon ~} ~}} -=< :- %noun - =+ pro=(~(mint ut typ) %noun gen) - ~_ (~(dunk ut typ) 'blow-subject') - =+ bus=(bran:musk typ) - ~& [%subject-mask mask.bus] - =+ jon=(apex:musk bus q.pro) - ?~ jon - ~& %constant-stopped - !! - ?. ?=(%& -.u.jon) - ~& %constant-blocked - !! - :: [p.pro [%1 p.u.jon]] - p.u.jon -|% -++ musk :: nock with block set - => |% - ++ block - :: identity of resource awaited - :: XX parameterize - noun - :: - ++ result - :: internal interpreter result - :: - $@(~ seminoun) - :: - ++ seminoun - :: partial noun; blocked subtrees are ~ - :: - {mask/stencil data/noun} - :: - ++ stencil - :: noun knowledge map - :: - $% :: no; noun has partial block substructure - :: - {%| left/stencil rite/stencil} - :: yes; noun is either fully complete, or fully blocked - :: - {%& blocks/(set block)} - == - :: - ++ output - :: nil; interpreter stopped - :: - %- unit - :: yes, complete noun; no, list of blocks - :: - (each noun (list block)) - -- - |% - ++ bran - |= sut/type - =+ gil=*(set type) - |- ^- seminoun - ?- sut - $noun [&+[~ ~ ~] ~] - $void [&+[~ ~ ~] ~] - {$atom *} ?~(q.sut [&+[~ ~ ~] ~] [&+~ u.q.sut]) - {$cell *} (combine $(sut p.sut) $(sut q.sut)) - {$core *} %+ combine:musk - ?~ p.s.q.sut [&+[~ ~ ~] ~] - [&+~ p.s.q.sut] - $(sut p.sut) - {$face *} $(sut ~(repo ut sut)) - {$fork *} [&+[~ ~ ~] ~] - {$help *} $(sut ~(repo ut sut)) - {$hold *} ?: (~(has in gil) sut) - [&+[~ ~ ~] ~] - $(sut ~(repo ut sut), gil (~(put in gil) sut)) - == - ++ abet - :: simplify raw result - :: - |= $: :: noy: raw result - :: - noy/result - == - ^- output - :: propagate stop - :: - ?~ noy ~ - :- ~ - :: merge all blocking sets - :: - =/ blocks (squash mask.noy) - ?: =(~ blocks) - :: no blocks, data is complete - :: - &+data.noy - :: reduce block set to block list - :: - |+~(tap in blocks) - :: - ++ apex - :: execute nock on partial subject - :: - |= $: :: bus: subject, a partial noun - :: fol: formula, a complete noun - :: - bus/seminoun - fol/noun - == - ^- output - :: simplify result - :: - %- abet - :: interpreter loop - :: - |- ^- result - :: ~& [%apex-fol fol] - :: ~& [%apex-mac mask.bus] - :: =- ~& [%apex-pro-mac ?@(foo ~ ~!(foo mask.foo))] - :: foo - :: ^= foo - :: ^- result - ?@ fol - :: bad formula, stop - :: - ~ - ?: ?=(^ -.fol) - :: hed: interpret head - :: - =+ hed=$(fol -.fol) - :: propagate stop - :: - ?~ hed ~ - :: tal: interpret tail - :: - =+ tal=$(fol +.fol) - :: propagate stop - :: - ?~ tal ~ - :: combine - :: - (combine hed tal) - ?+ fol - :: bad formula; stop - :: - ~ - :: 0; fragment - :: - {$0 b/@} - :: if bad axis, stop - :: - ?: =(0 b.fol) ~ - :: reduce to fragment - :: - (fragment b.fol bus) - :: - :: 1; constant - :: - {$1 b/*} - :: constant is complete - :: - [&+~ b.fol] - :: - :: 2; recursion - :: - {$2 b/* c/*} - :: require complete formula - :: - %+ require - :: compute formula with current subject - :: - $(fol c.fol) - |= :: ryf: next formula - :: - ryf/noun - :: lub: next subject - :: - =+ lub=^$(fol b.fol) - :: propagate stop - :: - ?~ lub ~ - :: recurse - :: - ^$(fol ryf, bus lub) - :: - :: 3; probe - :: - {$3 b/*} - %+ require - $(fol b.fol) - |= :: fig: probe input - :: - fig/noun - :: yes if cell, no if atom - :: - [&+~ .?(fig)] - :: - :: 4; increment - :: - {$4 b/*} - %+ require - $(fol b.fol) - |= :: fig: increment input - :: - fig/noun - :: stop for cells, increment for atoms - :: - ?^(fig ~ [&+~ +(fig)]) - :: - :: 5; compare - :: - {$5 b/*} - %+ require - $(fol b.fol) - |= :: fig: operator input - :: - fig/noun - :: stop for atoms, compare cells - :: - ?@(fig ~ [&+~ =(-.fig +.fig)]) - :: - :: 6; if-then-else - :: - {$6 b/* c/* d/*} - :: use standard macro expansion (slow) - :: - $(fol =>(fol [2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b])) - :: - :: 7; composition - :: - {$7 b/* c/*} - :: use standard macro expansion (slow) - :: - $(fol =>(fol [2 b 1 c])) - :: - :: 8; declaration - :: - {$8 b/* c/*} - :: use standard macro expansion (slow) - :: - $(fol =>(fol [7 [[7 [0 1] b] 0 1] c])) - :: - :: 9; invocation - :: - {$9 b/* c/*} - :: use standard macro expansion (slow) - :: - $(fol =>(fol [7 c 2 [0 1] 0 b])) - :: - :: 10; static hint - :: - {$10 @ c/*} - :: ignore hint - :: - $(fol c.fol) - :: - :: 10; dynamic hint - :: - {$10 {b/* c/*} d/*} - :: noy: dynamic hint - :: - =+ noy=$(fol c.fol) - :: propagate stop - :: - ?~ noy ~ - :: otherwise, ignore hint - :: - $(fol d.fol) - == - :: - ++ combine - :: combine a pair of seminouns - :: - |= $: :: hed: head of pair - :: tal: tail of pair - :: - hed/seminoun - tal/seminoun - == - ^- seminoun - ?. ?& &(?=(%& -.mask.hed) ?=(%& -.mask.tal)) - =(=(~ blocks.mask.hed) =(~ blocks.mask.tal)) - == - :: default merge - :: - [|+[mask.hed mask.tal] [data.hed data.tal]] - :: both sides total - :: - ?: =(~ blocks.mask.hed) - :: both sides are complete - :: - [&+~ data.hed data.tal] - :: both sides are blocked - :: - [&+(~(uni in blocks.mask.hed) blocks.mask.tal) ~] - :: - ++ fragment - :: seek to an axis in a seminoun - :: - |= $: :: axe: tree address of subtree - :: bus: partial noun - :: - axe/axis - bus/seminoun - == - |- ^- result - :: 1 is the root - :: - ?: =(1 axe) bus - :: now: 2 or 3, top of axis - :: lat: rest of axis - :: - =+ [now=(cap axe) lat=(mas axe)] - ?- -.mask.bus - :: subject is fully blocked or complete - :: - %& :: if fully blocked, produce self - :: - ?^ blocks.mask.bus bus - :: descending into atom, stop - :: - ?@ data.bus ~ - :: descend into complete cell - :: - $(axe lat, bus [&+~ ?:(=(2 now) -.data.bus +.data.bus)]) - :: subject is partly blocked - :: - %| :: descend into partial cell - :: - %= $ - axe lat - bus ?: =(2 now) - [left.mask.bus -.data.bus] - [rite.mask.bus +.data.bus] - == == - :: require complete intermediate step - :: - ++ require - |= $: noy/result - yen/$-(noun result) - == - ^- result - :: propagate stop - :: - ?~ noy ~ - :: if partial block, squash blocks and stop - :: - ?: ?=(%| -.mask.noy) [&+(squash mask.noy) ~] - :: if full block, propagate block - :: - ?: ?=(^ blocks.mask.noy) [mask.noy ~] - :: otherwise use complete noun - :: - (yen data.noy) - :: - ++ squash - :: convert stencil to block set - :: - |= tyn/stencil - ^- (set block) - ?- -.tyn - %& blocks.tyn - %| (~(uni in $(tyn left.tyn)) $(tyn rite.tyn)) - == - -- --- diff --git a/gen/p2.hoon b/gen/p2.hoon deleted file mode 100644 index 4736fb7f03..0000000000 --- a/gen/p2.hoon +++ /dev/null @@ -1,194 +0,0 @@ -/? 310 -:: -/+ pprint -:: -!: -:: -:- %say -:: -=< |= {^ {{=arg ~} ~}} - ^- [%txt wain] - :: - =/ v=vase - ?- target.arg - ^ target.arg - %all !>(all-examples) - %demo !>(demo-example) - %test !>(test-example) - %type !>(type-example) - %xml !>(xml-example) - %kernel !>(xray-the-kernel-example) - %parser !>(xray-the-parser-example) - == - :: - :- %txt - ?- print.arg - %type (render-type:pprint p.v) - %val (render-vase:pprint v) - %both (render-vase-with-type:pprint v) - == -:: -|% -:: -+$ arg - $: print=?(%type %val %both) - target=$@(?(%all %demo %test %type %xml %kernel %parser) vase) - == -:: -+$ option $?(%a %b %c) -:: -+$ junct $@(@ {@ cord}) -:: -+$ union $%([%list (list ~)] [%unit (unit ~)]) -:: -+$ conjunct $^ [[@ @] cord] - [@ cord] -:: -+$ misjunct $^([~ @] [cord @]) -:: -++ forks-example - :* :- %junct ^- (list junct) ~[3 [4 '5']] - :- %conjunct ^- (list conjunct) ~[[3 '4'] [[5 6] '7']] - :- %union ^- (list union) ~[[%list [~ ~]] [%unit [~ ~]]] - :- %option ^- (list option) ~[%a %a %b %c] - :- %misjunct ^- (list misjunct) ~[[~ 3] [~ 4]] - %nice - == -:: -++ all-examples - :* - :- %type type-example - :- %cores core-example - :- %add ..add - :- zuse-example - :- %demo demo-example - :- %forks forks-example - %eof - == -:: -++ type-example - ^- type - -:!>(`(map ? (unit (list cord)))`~) -:: -++ xray-the-parser-example - => ..musk - |% ++ x ~ -- -:: -++ xray-the-kernel-example - |% ++ x ~ -- -:: -++ zuse-example - [%zuse ..zuse] -:: -++ cores-example - |^ :* - [%trivial trivial-core-example] - [%gate gate-example] - [%core core-example] - == - :: - -- -:: -++ trivial-core-example - => ~ - |% ++ x 3 -- -:: -++ core-example - => [=gate-example] - |% - ++ dup gate-example - ++ const - |= x=* ^- $-(* *) - |= * ^- * - x - -- -:: -++ gate-example - => ~ - |= x=@ud - ^- [@ud @ud] - [x x] -:: -++ test-example - :* - `(list ?)`~[%.y %.n] - `(list ~)`~[~ ~] - `(unit ~)``~ - /a/path - == -:: -++ hoon-example - ^- hoon - :+ %brcn ~ - %- ~(gas by *(map term tome)) - ^- (list (pair term tome)) - :_ ~ - ^- (pair term tome) - :- 'chapter' - ^- tome - :- `what`~ - %- ~(gas by *(map term hoon)) - ^- (list (pair term hoon)) - :_ ~ - :- 'arm' - :+ %brts `spec`[%bsts 'x' [%base [%atom ~.ud]]] - :- %clsg - ~[[%wing ~['x']] [%$ 0]] -:: -++ demo-example - :* [~ %.y %.n 1 0x2 ~ ~.knot 'cord' %const] - :* [%tape "a tape"] - [%path /path/literal `path`/typed/path] - [%unit `(unit @)`[~ 9]] - [%list [`?`%.y `(list ?)`~[%.y %.n %.y]]] - %nice - == - [%hoon hoon-example] - [%type -:!>(`(unit (list tape))`~)] - [%json-and-xml json-example xml-example] - %cool - == - :: -++ xml-example - |^ ^- manx - :- ['json' ~] - :~ (json-to-xml json-example) - == - ++ json-to-xml - |= j=json - ^- manx - ?- j - ~ [['nil' ~] ~] - [%a *] [['array' ~] (turn p.j json-to-xml)] - [%b *] [['bool' ~[['' ?:(p.j "true" "false")]]] ~] - [%o *] [['obj' ~] (turn ~(tap by p.j) pair)] - [%n *] [['num' ~[[['n' 'val'] (trip p.j)]]] ~] - [%s *] [['str' ~[['' (trip p.j)]]] ~] - == - ++ pair - |= [t=@t j=json] - ^- manx - [['slot' ~[['key' (trip t)]]] ~[(json-to-xml j)]] - -- -:: -++ json-example - ^- json - |^ ob2 - ++ nil ~ - ++ yes [%b %.y] - ++ nah [%b %.n] - ++ str [%s 'Very long test string. Test test test test test test test.'] - ++ foo 'foo' - ++ bar 'bar' - ++ baz 'baz' - ++ one [%n '1'] - ++ ten [%n '10'] - ++ mil [%n '100000'] - ++ arr [%a ~[one ten mil]] - ++ ar2 [%a ~[arr yes nah nil str]] - ++ obj [%o (~(gas by *(map @t json)) ~[[foo mil] [baz arr]])] - ++ ob2 [%o (~(gas by *(map @t json)) ~[[foo ar2] [bar obj] [baz yes]])] - ++ ar3 [%a ~[arr obj ob2 one ten mil yes nah nil]] - -- -:: ---