diff --git a/hoon/codegen/lib/cg.hoon b/hoon/codegen/lib/cg.hoon new file mode 100644 index 00000000..28ecbceb --- /dev/null +++ b/hoon/codegen/lib/cg.hoon @@ -0,0 +1,4 @@ +/+ line +=/ cg-kick + => line != $ +[%cg cg-kick line] diff --git a/hoon/codegen/lib/degen.hoon b/hoon/codegen/lib/degen.hoon deleted file mode 100644 index 2ec4bc64..00000000 --- a/hoon/codegen/lib/degen.hoon +++ /dev/null @@ -1,1369 +0,0 @@ -:: XX this whole thing is a mess and needs one more rewrite -/- *sock -/- *gene -/+ ska -=| burg=town -|% -++ vent - |= barn - [sub for 1 %vent] -++ dole - |= barn - [sub for 1 %dole] -++ mill :: XX todo observe crashes - =* this . - |= [ject=* gist=barn] - ^- [* _this] - =| quay=(list [curb=berm sign=(map @ *) vale=@]) - =^ [goes=lake uses=pool rump=@] this (belt gist) - =/ sign (~(put by *(map @ *)) rump ject) - =/ reed (~(got by goes) (vent gist)) - |^ ^- [* _this] - ?~ body.reed - ?- -.bend.reed - %clq - ?@ (loan +<.bend.reed) - (lump +>+.bend.reed) - (lump +>-.bend.reed) - :: - %eqq - ~! +<.bend.reed - ~! +>-.bend.reed - ?: =((loan +<.bend.reed) (loan +>-.bend.reed)) - (lump +>+<.bend.reed) - (lump +>+>.bend.reed) - :: - %brn - ?: =(0 (loan +<.bend.reed)) - (lump +>-.bend.reed) - ?: =(1 (loan +<.bend.reed)) - (lump +>+.bend.reed) - ~| %bad-bean !! - :: - %hop (lump +.bend.reed) - %lnk - =/ gunk `barn`[[%toss ~] (loan +<.bend.reed)] - =^ [goop=lake ruse=pool rump=@] this - (belt [%toss ~] (loan +<.bend.reed)) - %= $ - quay [[+>+>.bend.reed sign +>+<.bend.reed] quay] - goes goop - sign (lend +>-.bend.reed rump) - == - :: - %cal - =/ [goop=lake ruse=pool rump=@] does:(~(got by land.burg) +<.bend.reed) - %= $ - quay [[+>+>.bend.reed sign +>+<.bend.reed] quay] - goes goop - sign (yoke +>-.bend.reed ruse) - reed (~(got by goop) (vent +<.bend.reed)) - == - :: - %bec ~| %bec-slip !! - %lnt - =^ [goop=lake ruse=pool rump=@] this - (belt [%toss ~] (loan +<.bend.reed)) - ~! +>.bend.reed - %= $ - goes goop - sign (lend +>.bend.reed rump) - == - :: - %jmp - =/ [goop=lake ruse=pool rump=@] does:(~(got by land.burg) +<.bend.reed) - %= $ - goes goop - sign (yoke +>.bend.reed ruse) - == - :: - %eye ~| %eye-slip !! - %spy ~| %fbi !! - %hnt ?>((~(has by sign) +<.bend.reed) (lump +>.bend.reed)) - %don - ?~ quay [(loan +.bend.reed) this] - =/ rail [sub for]:curb.i.quay - =/ [goop=lake ruse=pool bump=@] does:(~(got by land.burg) rail) - %= $ - sign (~(put by sign.i.quay) vale.i.quay (loan +.bend.reed)) - goes goop - reed ~|(%miss-entry (~(got by goes) curb.i.quay)) - quay t.quay - == - :: - %bom - ~| %boom !! - == - %= $ - body.reed t.body.reed - sign - %- ~(put by sign) - ?- -.i.body.reed - %imm [+> +<]:i.body.reed - %mov - :- +>.i.body.reed - (loan +<.i.body.reed) - :: - %inc - :- +>.i.body.reed - =/ bink (loan +<.i.body.reed) - ?> ?=(@ bink) - .+(bink) - :: - %unc - :- +>.i.body.reed - =/ bink (loan +<.i.body.reed) - ?> ?=(@ bink) - .+(bink) - :: - %con - :- +>+.i.body.reed - :- (loan +<.i.body.reed) - (loan +>-.i.body.reed) - :: - %hed - =/ cash (loan +<.i.body.reed) - ?> ?=(^ cash) - [+>.i.body.reed -.cash] - :: - %hud - =/ cash (loan +<.i.body.reed) - ?> ?=(^ cash) - [+>.i.body.reed -.cash] - :: - %tal - =/ cash (loan +<.i.body.reed) - ?> ?=(^ cash) - [+>.i.body.reed +.cash] - :: - %tul - =/ cash (loan +<.i.body.reed) - ?> ?=(^ cash) - [+>.i.body.reed +.cash] - == - == - ++ loan - |= @ - ~| %loan-miss (~(got by sign) +<) - ++ lend - |= [src=@ dst=@] - ^- _sign - (~(put by `_sign`~) dst (loan src)) - ++ lump - |= berm - ^$(reed ~|(%miss-entry (~(got by goes) +<))) - ++ yoke - |= [ox=(list @) lo=pool] - =| link=(map @ *) - |- ^- (map @ *) - ?~ ox - ?~ lo link - ~| %yoke-match !! - ?~ lo - ~| %yoke-match !! - $(link (~(put by link) ssa.i.lo (loan i.ox)), ox t.ox, lo t.lo) - -- -++ belt - =* this . - |= gist=barn - ^- [rice _this] - =. this +:(reap gist) - :_ this - does:(~(got by land.burg) gist) -++ reap - =* this . - |= =barn - ^- [boot _this] - =/ [=boot =farm] (plot barn) - =^ work this (till farm) - :- boot - (weed:(rake:this work) work) -++ plot :: subject knowledge analysis, emitting nock-- or "nomm" - =* this . - =| ski=farm - |= ent=barn - ^- [boot farm] - =/ bot (~(get by land.burg) ent) - ?. ?=(~ bot) [says.u.bot ski] :: no need to re-plot a barn we already know - =/ ext (~(get by yard.ski) ent) - ?. ?=(~ ext) [says.u.ext ski] - =; [res=[does=nomm says=boot:ska] sku=farm] - [says.res sku(yard (~(put by yard.sku) ent res), wood [ent wood.sku])] - :: blackhole, guard recursion - =. ski ski(yard (~(put by yard.ski) ent [[%zer 0 %.n] [%risk %toss ~]])) - |- ^- [[does=nomm says=boot:ska] farm] - =< - ?+ for.ent bomb - [[* *] *] - =^ [doth=nomm sath=boot:ska] ski $(for.ent -.for.ent) - ?: ?=([%boom ~] sath) bomb - =^ [toes=nomm tays=boot:ska] ski $(for.ent +.for.ent) - ?: ?=([%boom ~] tays) bomb - :_ ski - :_ (cobb:ska sath tays) - [%par doth toes] - :: - [%0 @] - :: we can decompose the axis into two axes, a safe axis which can - :: be implemented unchecked, and an unsafe axis which must be - :: checked. We then compose these two axes into safe %zer and - :: unsafe %zer composed by %sev - =+ [saf rik ken]=(punt:ska +.for.ent sub.ent) - ?: =(0 saf) bomb - :_ ski - ?: =(1 rik) [[%zer saf %.y] [%safe ken]] - ?: =(1 saf) [[%zer rik %.n] [%risk ken]] - :_ [%risk ken] - [%sev [%zer saf %.y] [%zer rik %.n]] - :: - [%1 *] - :_ ski - :_ [%safe %know +.for.ent] - [%one +.for.ent] - :: - [%2 * *] - =^ [dost=nomm sass=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] sass) bomb - =^ [doff=nomm faff=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] faff) bomb - =/ skun - ?- sass - [%safe *] sure.sass - [%risk *] hope.sass - == - ?: ?=([%safe %know *] faff) - =^ ret ski ^$(ent [skun know.sure.faff]) - :_ ski - :_ ?: ?=([%safe *] sass) ret (dare:ska ret) - [%two dost doff skun (some know.sure.faff) %.y] - ?: ?=([%risk %know *] faff) - =^ ret ski ^$(ent [skun know.hope.faff]) - :_ ski - :_ (dare:ska ret) - [%two dost doff skun (some know.hope.faff) %.n] - :_ ski - :_ [%risk %toss ~] - [%two dost doff skun ~ %.n] - :: - [%3 *] - =^ [deft=nomm koob=boot:ska] ski $(for.ent +.for.ent) - ?: ?=([%boom ~] koob) bomb - :_ ski - :_ (ques:ska koob) - [%thr deft] - :: - [%4 *] - =^ [dink=nomm sink=boot:ska] ski $(for.ent +.for.ent) - ?: ?=([%boom ~] sink) bomb - =/ rink - ?- sink - [%safe *] sure.sink - [%risk *] hope.sink - == - :_ ski - :_ (pile:ska sink) - [%fou dink ?|(?=([%dice ~] rink) ?=([%flip ~] rink) ?=([%know @] rink))] - :: - [%5 * *] - =^ [dome=nomm foam=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] foam) bomb - =^ [doot=nomm foot=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] foot) bomb - :_ ski - :_ (bopp:ska foam foot) - [%fiv dome doot] - :: - [%6 * * *] - =^ [dawn=nomm sond=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%safe %know %0] sond) $(for.ent +>-.for.ent) - ?: ?=([%safe %know %1] sond) $(for.ent +>+.for.ent) - ?: ?=([%safe %know *] sond) bomb - ?: ?=([%safe %bets *] sond) bomb - ?: ?=([%safe %flip ~] sond) - =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent) - =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent) - :_ ski - :_ (gnaw:ska slew song) - [%six dawn drew darn] - ?: ?=([%risk %know %0] sond) - =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent) - :_ ski - :_ (dare:ska slew) - :: run dawn in case it crashes, but throw it away - [%sev [%par dawn drew] [%zer 3 %.y]] - ?: ?=([%risk %know %1] sond) - =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent) - :_ ski - :_ (dare:ska song) - :: run dawn in case it crashes, but throw it away - [%sev [%par dawn darn] [%zer 3 %.y]] - ?: ?=([%risk %know *] sond) bomb - ?: ?=([%risk %bets *] sond) bomb - =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent) - =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent) - :_ ski - :_ (dare:ska (gnaw:ska slew song)) - [%six dawn drew darn] - :: - [%7 * *] - =^ [deck=nomm keck=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] keck) bomb - =/ news - ?- keck - [%safe *] sure.keck - [%risk *] hope.keck - == - =^ [dest=nomm zest=boot:ska] ski $(sub.ent news, for.ent +>.for.ent) - ?: ?=([%boom ~] zest) bomb - :_ ski - :_ ?: ?=([%safe *] keck) zest (dare:ska zest) - [%sev deck dest] - :: - [%8 * *] - =^ [pink=nomm pest=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] pest) bomb - =/ nest - ?- pest - [%safe *] sure.pest - [%risk *] hope.pest - == - =^ [dest=nomm zest=boot:ska] ski - $(sub.ent (knit:ska nest sub.ent), for.ent +>.for.ent) - ?: ?=([%boom ~] zest) bomb - :_ ski - :_ ?: ?=([%safe *] pest) - zest - (dare:ska zest) - [%sev [%par pink %zer 1 %.y] dest] - :: - [%9 @ *] - =^ [lore=nomm sore=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] sore) bomb - =/ news - ?- sore - [%safe *] sure.sore - [%risk *] hope.sore - == - =/ fork (pull:ska +<.for.ent news) - ?: ?=([%safe %know *] fork) - =^ ret ski ^$(ent [news know.sure.fork]) - :_ ski - :_ ?: ?=([%safe *] sore) - ret - (dare:ska ret) - [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent %.y] news (some know.sure.fork) %.y]] - ?: ?=([%risk %know *] fork) - =^ ret ski ^$(ent [news know.hope.fork]) - :_ ski - :_ (dare:ska ret) - [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent %.n] news (some know.hope.fork) %.n]] - :_ ski - :_ [%risk %toss ~] - [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent ?=(%safe -.fork)] news ~ ?=(%safe -.fork)]] - :: - [%10 [@ *] *] - =^ [neat=nomm seat=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] seat) bomb - =^ [pace=nomm spat=boot:ska] ski $(for.ent +<+.for.ent) - ?: ?=([%boom ~] spat) bomb - =/ teak - ?- seat - [%safe *] sure.seat - [%risk *] hope.seat - == - =+ [saf rik ken]=(punt:ska +<-.for.ent teak) - ?: =(0 saf) bomb - :_ ski - :_ (welt:ska +<-.for.ent spat seat) - ?: =(1 rik) - [%ten [+<-.for.ent pace] neat %.y] - ^- nomm - :+ %sev [%par neat pace] - :+ %ten - [saf %ten [rik %zer 3 %.n] [%zer (peg saf 2) %.y] %.y] - [[%zer 2 %.y] %.y] - :: - [%11 @ *] - =^ [real=nomm seal=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] seal) bomb - ^- [[does=nomm says=boot:ska] farm] - [[[%els +<.for.ent real] seal] ski] - :: - [%11 [@ *] *] - =^ [fake=nomm sake=boot:ska] ski $(for.ent +<+.for.ent) - ?: ?=([%boom ~] sake) bomb - =^ [real=nomm seal=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] seal) bomb - :_ ski - ?: ?=([%safe *] sake) - [[%eld [+<-.for.ent fake] real %.y] seal] - [[%eld [+<-.for.ent fake] real %.n] seal] - :: - [%12 * *] - =^ [fear=nomm sear=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] sear) bomb - =^ [pack=nomm sack=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] sack) bomb - :_ ski - :_ [%risk %toss ~] - [%twe fear pack] - == - |% - ++ bomb - ^- [[nomm boot:ska] farm] - [[[%zer 0 %.n] [%boom ~]] ski] - -- -++ till - =* this . - |= =farm - ^- [(list barn) _this] - =/ work (flop (skip wood.farm ~(has by land.burg))) - :- work - |- ^- _this - ?~ work this - =/ next i.work - =+ ~| %next-miss (~(got by yard.farm) next) - :: now we have the nock-- in does - =/ dock [lamb=lamb.burg lake=*lake] - =| flow=line - =/ axle=@ 1 - =/ fawn does - |^ - =- =. lamb.burg lamb.dock - =. land.burg - %+ ~(put by land.burg) next - =/ flue (~(got by lake.dock) her) - :_ says - ~| ~(key by lake.dock) - =. lake.dock (~(put by (~(del by lake.dock) her)) (vent next) flue) - ~| ~(key by lake.dock) - =. ^dock dock - =^ [hose=@ bole=berm] dock (peel hat (vent next)) - ~| ~(key by lake.dock) - ~| bole - =/ alms (~(got by lake.dock) bole) - =. lake.dock (~(put by (~(del by lake.dock) bole)) (dole next) alms) - :- lake.dock - :_ hose - =| safe=? :: XX state maximal safe axes, as this will overly pessimize - =/ bolt=@ 1 - |- ^- (list [@ @ ?]) - ?- -.hat - %tine [[bolt +.hat safe]]~ - %disc ~ - %fork - %+ weld - $(hat left.hat, bolt (peg bolt 2), safe ?&(safe safe.hat)) - $(hat rite.hat, bolt (peg bolt 3), safe ?&(safe safe.hat)) - == - ^$(work t.work) - |- ^- [[hat=plow her=berm] dock=_dock] - ?- fawn - [%par * *] - =^ [one=plow two=plow her=berm] dock twin - =^ [bat=plow bit=berm] dock - $(fawn +>.fawn, axle (peg axle 3), flow [%moat her two]) - =^ [hat=plow hit=berm] dock - $(fawn +<.fawn, axle (peg axle 2), flow [%moat bit one]) - (copy hat bat hit) - :: - [%zer *] - ?- -.flow - %moat - =/ slow (take +<.fawn what.flow +>.fawn) - ?~ slow - fail - :_ dock - [u.slow wher.flow] - :: - %rift - =^ miff dock wean - =/ slow (take +<.fawn [%tine miff] +>.fawn) - ?~ slow - fail - =^ her dock (mend %miff ~ [%brn miff [troo fals]:flow]) - :_ dock - [u.slow her] - :: - %pond - =^ tend dock wean - =/ slow (take +<.fawn [%tine tend] +>.fawn) - ?~ slow - fail - =^ her dock (mend %tend ~ [%don tend]) - :_ dock - [u.slow her] - == - :: - [%one *] - (bang +.fawn) - :: - [%two *] - ?- -.flow - %moat - =^ flaw dock (peel what.flow wher.flow) - (tool `flaw +.fawn) - :: - %rift - =^ muse dock wean - =^ skit dock (mend %skit ~ [%brn muse [troo fals]:flow]) - (tool `[muse skit] +.fawn) - :: - %pond - (tool ~ +.fawn) - == - :: - [%thr *] - ?- -.flow - %moat - ?- -.what.flow - %fork fail - %disc $(fawn +.fawn, axle (peg axle 3)) - %tine - =^ pear dock (mend %pear [%imm 0 +.what.flow]~ [%hop wher.flow]) - =^ bock dock (mend %bock [%imm 1 +.what.flow]~ [%hop wher.flow]) - =^ noon dock wean - =^ keck dock (mend %keck ~ [%clq noon pear bock]) - $(fawn +.fawn, axle (peg axle 3), flow [%moat keck [%tine noon]]) - == - :: - %rift - =^ noon dock wean - =^ keck dock (mend %keck ~ [%clq noon [troo fals]:flow]) - $(fawn +.fawn, axle (peg axle 3), flow [%moat keck [%tine noon]]) - :: - %pond - =^ tend dock wean - =^ pear dock (mend %pear [%imm 0 tend]~ [%don tend]) - =^ bock dock (mend %bock [%imm 1 tend]~ [%don tend]) - =^ noon dock wean - =^ keck dock (mend %keck ~ [%clq noon pear bock]) - $(fawn +.fawn, axle (peg axle 3), flow [%moat keck [%tine noon]]) - == - :: - [%fou *] - ?- -.flow - %moat - ?- -.what.flow - %fork fail - %disc - =^ left dock wean - ?: +>.fawn :: safe? - $(fawn +<.fawn, axle (peg axle 6), flow [%moat wher.flow [%tine left]]) - =^ meal dock wean - =^ dink dock (mend %dink ~[[%inc meal left]] [%hop wher.flow]) - $(fawn +<.fawn, axle (peg axle 6), flow [%moat dink [%tine meal]]) - :: - %tine - =^ meal dock wean - =^ rink dock - ?: +>.fawn - (mend %rink ~[[%unc meal +.what.flow]] [%hop wher.flow]) - (mend %rink ~[[%inc meal +.what.flow]] [%hop wher.flow]) - $(fawn +<.fawn, axle (peg axle 6), flow [%moat rink [%tine meal]]) - == - :: - %rift - =^ iffy dock wean - =^ miff dock wean - =^ kink dock - ?: +>.fawn :: safe? - (mend %kink ~[[%unc miff iffy]] [%brn iffy [troo fals]:flow]) - (mend %kink ~[[%inc miff iffy]] [%brn iffy [troo fals]:flow]) - $(fawn +<.fawn, axle (peg axle 6), flow [%moat kink [%tine miff]]) - :: - %pond - =^ pend dock wean - =^ spin dock wean - =^ pink dock - ?: +>.fawn :: safe? - (mend %pink ~[[%unc spin pend]] [%don pend]) - (mend %pink ~[[%inc spin pend]] [%don pend]) - $(fawn +<.fawn, axle (peg axle 6), flow [%moat pink [%tine spin]]) - == - :: - [%fiv *] - ?- -.flow - %moat - ?- -.what.flow - %fork fail - %disc - =^ [hit=plow his=berm] dock $(fawn +<.fawn, axle (peg axle 6)) - =^ [hot=plow hog=berm] dock - $(fawn +<.fawn, axle (peg axle 7), flow [%moat his [%disc ~]]) - (copy hit hot hog) - :: - %tine - =^ root dock (mend %root ~[[%imm 0 +.what.flow]] [%hop wher.flow]) - =^ salt dock (mend %salt ~[[%imm 1 +.what.flow]] [%hop wher.flow]) - =^ load dock wean - =^ toad dock wean - =^ qual dock (mend %qual ~ [%eqq load toad root salt]) - =^ [hit=plow his=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%moat qual [%tine load]]) - =^ [hot=plow hog=berm] dock - $(fawn +>.fawn, axle (peg axle 7), flow [%moat his [%tine toad]]) - (copy hit hot hog) - == - :: - %rift - =^ load dock wean - =^ toad dock wean - =^ rail dock (mend %rail ~ [%eqq load toad [troo fals]:flow]) - =^ [hit=plow his=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%moat rail [%tine load]]) - =^ [hot=plow hog=berm] dock - $(fawn +>.fawn, axle (peg axle 7), flow [%moat his [%tine toad]]) - (copy hit hot hog) - :: - %pond - =^ bean dock wean - =^ root dock (mend %root ~[[%imm 0 bean]] [%don bean]) - =^ salt dock (mend %salt ~[[%imm 1 bean]] [%don bean]) - =^ load dock wean - =^ toad dock wean - =^ fall dock (mend %fall ~ [%eqq load toad root salt]) - =^ [hit=plow his=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%moat fall [%tine load]]) - =^ [hot=plow hog=berm] dock - $(fawn +>.fawn, axle (peg axle 7), flow [%moat his [%tine toad]]) - (copy hit hot hog) - == - :: - [%six *] - =^ [hut=plow hum=berm] dock $(fawn +>-.fawn, axle (peg axle 14)) - =^ [hat=plow ham=berm] dock $(fawn +>+.fawn, axle (peg axle 15)) - =^ [hot=plow hog=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%rift hum ham]) - =^ [hit=plow him=berm] dock (copy hut hat hog) - (copy hit hot him) - :: - [%sev *] - =^ [hit=plow his=berm] dock $(fawn +>.fawn, axle (peg axle 7)) - $(fawn +<.fawn, axle (peg axle 6), flow [%moat his hit]) - :: - [%ten *] - ?- -.flow - %moat - =^ [out=plow inn=plow tub=berm] dock (tear +<-.fawn what.flow +>+.fawn wher.flow) - =^ [hat=plow him=berm] dock $(fawn +<+.fawn, axle (peg axle 13), flow [%moat tub inn]) - =^ [hut=plow mud=berm] dock $(fawn +>-.fawn, axle (peg axle 14), flow [%moat him out]) - (copy hat hut mud) - :: - %rift - :: this is a weird case. It only works if the axis is one, - :: otherwise it crashes, and there's no point in an axis edit of - :: one except to discard the first result - ?. =(1 +<-.fawn) fail - =^ hide dock wean - =^ mood dock (mend %mood ~ [%brn hide [troo fals]:flow]) - =^ [hat=plow him=berm] dock - $(fawn +<+.fawn, axle (peg axle 13), flow [%moat mood [%tine hide]]) - =^ [hut=plow mud=berm] dock - $(fawn +>-.fawn, axle (peg axle 14), flow [%moat him [%disc ~]]) - (copy hat hut mud) - :: - %pond - =^ dire dock wean - =^ eden dock (mend %eden ~ [%don dire]) - =^ [out=plow inn=plow tub=berm] dock (tear +<-.fawn [%tine dire] +>+.fawn eden) - =^ [hat=plow him=berm] dock $(fawn +<+.fawn, axle (peg axle 13), flow [%moat tub inn]) - =^ [hut=plow mud=berm] dock $(fawn +>-.fawn, axle (peg axle 14), flow [%moat him out]) - (copy hat hut mud) - == - :: - [%els *] - =^ [hat=plow him=berm] dock $(fawn +>.fawn, axle (peg axle 7)) - =^ pint dock wean - =^ tint dock (mend %tint ~[[%imm +<.fawn pint]] [%hnt pint him]) - :_ dock - [hat tint] - :: - [%eld *] - =^ [hat=plow him=berm] dock $(fawn +>-.fawn, axle (peg axle 7)) - =^ pint dock wean - =^ dint dock wean - =^ aint dock wean - =^ tint dock (mend %tint ~[[%imm +<-.fawn pint] [%con pint dint aint]] [%hnt aint him]) - =^ [hit=plow his=berm] dock $(fawn +<+.fawn, axle (peg axle 13), flow [%moat tint [%tine dint]]) - (copy hat hit his) - :: - [%twe *] - ?- -.flow - %moat - =^ [use=@ her=berm] dock (peel what.flow wher.flow) - =^ fens dock wean - =^ phat dock wean - =^ cope dock (mend %cope ~ [%spy fens phat use her]) - =^ [ham=plow pan=berm] dock - $(fawn +>.fawn, axle (peg axle 7), flow [%moat cope [%tine phat]]) - =^ [hen=plow pen=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%moat pan [%tine fens]]) - (copy ham hen pen) - :: - %rift - =^ sift dock wean - =^ bars dock (mend %bars ~ [%brn sift [troo fals]:flow]) - =^ fens dock wean - =^ phat dock wean - =^ cope dock (mend %cope ~ [%spy fens phat sift bars]) - =^ [ham=plow pan=berm] dock - $(fawn +>.fawn, axle (peg axle 7), flow [%moat cope [%tine phat]]) - =^ [hen=plow pen=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%moat pan [%tine fens]]) - (copy ham hen pen) - :: - %pond - =^ sped dock wean - =^ sear dock (mend %sear ~ [%don sped]) - =^ fens dock wean - =^ phat dock wean - =^ cope dock (mend %cope ~ [%spy fens phat sped sear]) - =^ [ham=plow pan=berm] dock - $(fawn +>.fawn, axle (peg axle 7), flow [%moat cope [%tine phat]]) - =^ [hen=plow pen=berm] dock - $(fawn +<.fawn, axle (peg axle 6), flow [%moat pan [%tine fens]]) - (copy ham hen pen) - == - == - ++ fail - ^- [[hat=plow her=berm] dock=_dock] - =^ hole dock bomb - :_ dock - [[%disc ~] hole] - ++ tear :: take apart an ssa map for an edit - |= [axe=@ bit=plow safe=? her=berm] - ^- [[out=plow inn=plow his=berm] _dock] - ?: =(0 axe) - =^ hole dock bomb - [[[%disc ~] [%disc ~] hole] dock] - =+ - |- ^- [[out=plow inn=plow rind=(list bran)] deck=_dock] - ?: =(1 axe) - :_ dock - [[%disc ~] bit ~] - ?- -.bit - %disc - ?: safe [[[%disc ~] [%disc ~] ~] dock] - ?- (cap axe) - %2 - =^ ruck dock $(axe (mas axe)) - :_ dock - [[%fork out.ruck [%disc ~] %.n] inn.ruck rind.ruck] - %3 - =^ ruck dock $(axe (mas axe)) - :_ dock - [[%fork [%disc ~] out.ruck %.n] inn.ruck rind.ruck] - == - :: - %tine - =^ tour dock wean - =^ plat dock wean - ?- (cap axe) - %2 - =^ ruck dock $(axe (mas axe), bit [%tine plat]) - :_ dock - [[%fork out.ruck [%tine tour] safe] inn.ruck [[%con plat tour +.bit] rind.ruck]] - %3 - =^ ruck dock $(axe (mas axe), bit [%tine plat]) - :_ dock - [[%fork [%tine tour] out.ruck safe] inn.ruck [[%con tour plat +.bit] rind.ruck]] - == - :: - %fork - ?- (cap axe) - %2 - =^ ruck dock $(axe (mas axe), bit left.bit) - :_ dock - [[%fork out.ruck rite.bit ?&(safe safe.bit)] inn.ruck rind.ruck] - %3 - =^ ruck dock $(axe (mas axe), bit rite.bit) - :_ dock - [[%fork left.bit out.ruck ?&(safe safe.bit)] inn.ruck rind.ruck] - == - == - =. dock deck - ?~ rind - :_ dock - [out inn her] - =^ him dock (mend %diet rind [%hop her]) - :_ dock - [out inn him] - ++ tool :: generate calls - |= [flaw=(unit [rut=@ rot=berm]) sums=nomm form=nomm sunk=sock fork=(unit *) safe=?] - ^- [[plow berm] _dock] - ?~ fork - =^ lash dock wean - =^ frog dock wean - =^ coil dock - ?~ flaw - (mend %coil ~ [%lnt frog lash]) - (mend %coil ~ [%lnk frog lash rut.u.flaw rot.u.flaw]) - =^ [bow=plow urn=berm] dock - $(fawn sums, axle (peg axle 6), flow [%moat coil [%tine lash]]) - =^ [fog=plow sog=berm] dock - $(fawn form, axle (peg axle 14), flow [%moat urn [%tine frog]]) - (copy fog bow sog) - =/ bale=barn [sunk u.fork] - =/ bore (~(get by land.burg) bale) - ?~ bore :: we don't know the registerization of the subject for the call, yet - =^ lash dock wean - =^ dote dock - ?~ flaw - (mend %dote ~ [%eye bale lash]) - (mend %dote ~ [%bec bale lash rut.u.flaw rot.u.flaw]) - =^ [bow=plow urn=berm] dock - $(fawn sums, axle (peg axle 6), flow [%moat dote [%tine lash]]) - ?: safe [[bow urn] dock] - =^ [fog=plow sog=berm] dock - $(fawn form, axle (peg axle 14), flow [%moat urn [%disc ~]]) - (copy fog bow sog) - =^ uses dock (cool uses.does.u.bore) - =^ dote dock - ?~ flaw - (mend %dote ~ [%jmp bale (boil uses)]) - (mend %dote ~ [%cal bale (boil uses) rut.u.flaw rot.u.flaw]) - =^ [ash=plow dot=berm] dock (whop uses dote) - =^ [bow=plow urn=berm] dock - $(fawn sums, axle (peg axle 6), flow [%moat dot ash]) - ?: safe [[bow urn] dock] - =^ [fog=plow sog=berm] dock - $(fawn form, axle (peg axle 14), flow [%moat urn [%disc ~]]) - (copy fog bow sog) - ++ cool :: generate SSAs for the call side of a use list - |= use=(list [@ @ ?]) - ^- [(list [@ @ ?]) _dock] - ?~ use [~ dock] - =^ pan dock wean - =^ lid dock $(use t.use) - :_ dock - [[-.i.use pan +>.i.use] lid] - ++ boil :: ssas from a use list - |= use=(list [@ @ ?]) - ^- (list @) - (turn use |=([@ ssa=@ ?] ssa)) - ++ whop :: turn a use list into a plow - |= [use=(list [@ @ ?]) her=berm] - ^- [[plow berm] _dock] - ?~ use [[*plow her] dock] - =^ [low=plow him=berm] dock $(use t.use) - =/ ace (take -.i.use [%tine +<.i.use] +>.i.use) - ?~ ace fail - (copy low u.ace him) - ++ bang - |= non=* - ^- [[hat=plow her=berm] _dock] - ?- flow - [%pond ~] - =^ ret dock wean - =^ her dock (mend %rime ~[[%imm +.fawn ret]] [%don ret]) - :_ dock - [[%disc ~] her] - :: - [%rift *] - ?: =(0 +.fawn) [[[%disc ~] troo.flow] dock] - ?: =(1 +.fawn) [[[%disc ~] fals.flow] dock] - :: XX maybe we should assert that SKA should have caught this? - =^ hole dock bomb - :_ dock - [[%disc ~] hole] - :: - [%moat *] - =/ what what.flow - =/ mitt - |- ^- (unit (list bran)) - ?- what - [%disc ~] - (some ~) - :: - [%tine @] - (some ~[[%imm non +.what]]) - :: - [%fork *] - ?@ non - ?: safe.what - ~| %safe-axis-atom !! - ~ - (clap $(what left.what, non -.non) $(what rite.what, non +.non) weld) - == - ?~ mitt - =^ hole dock bomb - :_ dock - [[%disc ~] hole] - =^ rock dock (mend %toil u.mitt [%hop wher.flow]) - :_ dock - [[%disc ~] rock] - == - ++ take :: axis - |= [sax=@ tow=plow row=?] :: axis, destination, safety - ^- (unit plow) :: nullary case = crash - ?: =(0 sax) ~ - %- some - |- ^- plow - ?: =(1 sax) tow - ?- (cap sax) - %2 [%fork $(sax (mas sax)) [%disc ~] row] - %3 [%fork [%disc ~] $(sax (mas sax)) row] - == - ++ copy :: replicate values to two destinations - |= [hat=plow bat=plow her=berm] - ^- [[hat=plow her=berm] _dock] - =^ [tog=plow moot=(list bran)] dock - |- - ^- [[tog=plow moot=(list bran)] _dock] - ?: ?=([%disc ~] hat) [[bat ~] dock] - ?: ?=([%disc ~] bat) [[hat ~] dock] - ?- hat - [%tine @] - ?- bat - [%tine @] - ?: =(+.hat +.bat) - [[hat ~] dock] - [[hat ~[[%mov +.hat +.bat]]] dock] - :: - [%fork *] - =^ one dock wean - =^ two dock wean - =^ [hog=plow hoot=(list bran)] dock - $(hat [%tine one], bat left.bat) - =^ [log=plow loot=(list bran)] dock - $(hat [%tine two], bat rite.bat) - :_ dock - :- ^- plow - [%fork hog log safe.bat] - [[%con one two +.hat] (weld hoot loot)] - == - :: - [%fork *] - ?- bat - [%tine @] - =^ one dock wean - =^ two dock wean - =^ [hog=plow hoot=(list bran)] dock - $(hat left.hat, bat [%tine one]) - =^ [log=plow loot=(list bran)] dock - $(hat rite.hat, bat [%tine two]) - :_ dock - [[%fork hog log safe.hat] [%con one two +.bat] (weld hoot loot)] - :: - [%fork *] - =^ [hog=plow hoot=(list bran)] dock $(hat left.hat, bat left.bat) - =^ [log=plow loot=(list bran)] dock $(hat rite.hat, bat rite.bat) - :_ dock - [[%fork hog log ?&(safe.hat safe.bat)] (weld hoot loot)] - == - == - =/ blab (milk %copy) - :_ dock(lake (~(put by lake.dock) blab [moot %hop her])) - [tog blab] - ++ twin :: split sans from flow - ^- [[plow plow berm] _dock] - ?- flow - [%rift *] - =^ hole dock bomb - :_ dock - [[%disc ~] [%disc ~] hole] - :: - [%pond ~] - =^ one dock wean - =^ two dock wean - =^ ret dock wean - =^ her dock (mend %taco ~[[%con one two ret]] [%don ret]) - :_ dock - [[%tine one] [%tine two] her] - :: - [%moat *] - ?- what.flow - [%fork *] - :_ dock - [left.what.flow rite.what.flow wher.flow] - :: - [%disc ~] - :_ dock - [[%disc ~] [%disc ~] wher.flow] - :: - [%tine @] - =^ one dock wean - =^ two dock wean - =^ her dock - (mend %cons ~[[%con one two +.what.flow]] [%hop wher.flow]) - :_ dock - [[%tine one] [%tine two] her] - == - == - ++ bomb - ^- [berm _dock] - (mend %boom ~ [%bom ~]) - ++ milk :: local label - |= gen=@ - ^- berm - ~! next - [sub.next for.next axle gen] - ++ mend - |= [gen=@ =lock] - ^- [berm _dock] - =/ curb (milk gen) - :- curb - dock(lake (~(put by lake.dock) curb lock)) - ++ wean :: fresh ssa - ^- [@ _dock] - [lamb.dock dock(lamb .+(lamb.dock))] - ++ peel :: split a define among a plow's worth of uses - |= [mole=plow hill=berm] - ^- [[use=@ her=berm] _dock] - ~& ~(key by lake.dock) - =+ - |- ^- [[fine=(unit @) load=(list bran)] dock=_dock] - ?- -.mole - %tine [[`+.mole ~] dock] - %disc [[~ ~] dock] - %fork - =^ [file=(unit @) loaf=(list bran)] dock $(mole left.mole) - =^ [fire=(unit @) road=(list bran)] dock $(mole rite.mole) - ?~ file - ?~ fire - [[~ ~] dock] - [[fire road] dock] - ?~ fire - [[file loaf] dock] - =^ fell dock wean - ?: safe.mole - :_ dock - :- `fell - [[%hud fell u.file] [%tul fell u.fire] (weld loaf road)] - :_ dock - :- `fell - [[%hed fell u.file] [%tal fell u.fire] (weld loaf road)] - == - ?~ fine - =^ crap dock wean :: no uses in the plow, so just make a trash register for the result and return - =^ her dock (mend %peel ~ [%hop hill]) - [[crap her] dock] - =^ her dock (mend %peel load [%hop hill]) :: loads necessary, add those to the dock and return - [[u.fine her] dock] - - -- -++ rake :: clean up unused basic blocks, and rewrite bec/eye into cal/jmp - =* this . - |= work=(list barn) - ^- _this - ?~ work this - %= $ - burg - =+ ~| %barn-miss (~(got by land.burg) i.work) - ^- town - =| loch=lake - =| sigh=(map @ $%([%mov @] [%con @ @] [%rug ~])) - =/ tack=[(list berm) (list berm)] [[(vent i.work) ~] ~] :: label queue - |- ^- town :: loop over basic blocks using a queue - ?~ -.tack - ?~ +.tack - %= burg - land - (~(put by land.burg) i.work [[loch uses.does lump.does] says]) - == - $(tack [(flop +.tack) ~]) - =/ hock ~| %miss-berm ~| i.-.tack (~(got by goes.does) i.-.tack) - =/ bock body.hock - |^ ^- town :: loop over instructions in a basic block - ?~ body.hock - ?: ?=(%bec -.bend.hock) - (rend [+< +>- `+>+]:bend.hock) - ?: ?=(%eye -.bend.hock) - (rend [+< +> ~]:bend.hock) - =. loch (~(put by loch) i.-.tack [bock bend.hock]) - ?- bend.hock - [%clq *] - ^$(-.tack t.-.tack, +.tack [+>-.bend.hock +>+.bend.hock +.tack]) - :: - [%eqq *] - ^$(-.tack t.-.tack, +.tack [+>+<.bend.hock +>+>.bend.hock +.tack]) - :: - [%brn *] - ^$(-.tack t.-.tack, +.tack [+>-.bend.hock +>+.bend.hock +.tack]) - :: - [%hop *] - ^$(-.tack t.-.tack, +.tack [+.bend.hock +.tack]) - :: - [%lnk *] - %= ^$ - sigh (~(put by sigh) +>+<.bend.hock [%rug ~]) - -.tack t.-.tack - +.tack [+>+>.bend.hock +.tack] - == - :: - [%cal *] - %= ^$ - sigh (~(put by sigh) +>+<.bend.hock [%rug ~]) - -.tack t.-.tack - +.tack [+>+>.bend.hock +.tack] - == - :: - [%lnt *] ^$(-.tack t.-.tack) - [%jmp *] ^$(-.tack t.-.tack) - [%spy *] - %= ^$ - sigh (~(put by sigh) +>+<.bend.hock [%rug ~]) - -.tack t.-.tack - +.tack [+>+>.bend.hock +.tack] - == - :: - [%hnt *] - ^$(-.tack t.-.tack, +.tack [+>.bend.hock +.tack]) - :: - [%don *] ^$(-.tack t.-.tack) - [%bom *] ^$(-.tack t.-.tack) - == - ?- i.body.hock - [%imm *] :: XX we should split immediates too - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - :: - [%mov *] - %= $ - body.hock t.body.hock - sigh (~(put by sigh) +>.i.body.hock [%mov +<.i.body.hock]) - == - :: - [%inc *] - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - :: - [%unc *] - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - :: - [%con *] - %= $ - body.hock t.body.hock - sigh - %+ ~(put by sigh) - +>+.i.body.hock - [%con +<.i.body.hock +>-.i.body.hock] - == - :: - [%hed @ @] - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - :: - [%hud @ @] - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - :: - [%tal @ @] - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - :: - [%tul @ @] - $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~])) - == - ++ rend :: make register assignments to translate a bec/eye into a cal/jmp. - |= [=barn tart=@ poem=(unit [@ berm])] - =/ uses ~| %uses-miss uses:does:(~(got by land.burg) barn) - ^- town - =- - =. burg fort - =? sigh ?=([~ *] poem) (~(put by sigh) -.u.poem [%rug ~]) - =/ term - ?~ poem - [%jmp barn bits] - [%cal barn bits u.poem] - %= ^^$ - loch - (~(put by loch) i.-.tack [(weld bock bins) term]) - :: - -.tack t.-.tack - == - =/ gasp :: turn the sigh register-relating map into a register-for-axis map - =/ axe 1 - |- ^- (map @ @) - =/ waft (~(put by *(map @ @)) axe tart) - =/ puff (~(gut by sigh) tart [%rug ~]) - ?- puff - [%rug ~] waft - [%mov *] (~(uni by waft) $(tart +.puff)) - [%con *] - =/ left $(tart +<.puff, axe (peg axe 2)) - %- ~(uni by waft) - %- ~(uni by left) - $(tart +>.puff, axe (peg axe 3)) - == - =| bits=(list @) - =| bins=(list bran) - |- ^- [bits=(list @) bins=(list bran) fort=town] - ?~ uses [(flop bits) bins burg] - =/ sour -.i.uses - =/ axle 1 - =/ vale ~| %vale-miss (~(got by gasp) 1) - |- ^- [bits=(list @) bins=(list bran) fort=town] - ?: =(1 sour) - ^$(bits [vale bits], uses t.uses) - ?- (cap sour) - %2 - =. axle (peg axle 2) - =. sour (mas sour) - =/ pale (~(get by gasp) axle) - ?~ pale - %= $ - bins [[%hed vale lamb.burg] bins] - vale lamb.burg - gasp (~(put by gasp) axle lamb.burg) - lamb.burg .+(lamb.burg) - == - $(vale u.pale) - :: - %3 - =. axle (peg axle 3) - =. sour (mas sour) - =/ pale (~(get by gasp) axle) - ?~ pale - %= $ - bins [[%tal vale lamb.burg] bins] - vale lamb.burg - gasp (~(put by gasp) axle lamb.burg) - lamb.burg .+(lamb.burg) - == - $(vale u.pale) - == - -- - :: - work t.work - == -++ weed :: remove unused safe operations (imm,mov,unc,con,hud,tul) - =* this . - |= work=(list barn) - ^- _this - ?~ work this - =/ herd (~(got by land.burg) i.work) :: sack for this arm - =| dead=(jug berm @) :: values used by a label and its successor code - =/ furs=(list berm) [[sub for 1 %vent]:i.work ~] - |- ^- _this - ?~ furs - ^$(work t.work, land.burg (~(put by land.burg) i.work herd)) - ?: (~(has by dead) i.furs) :: did we already analyze this arm - $(furs t.furs) - =/ meat (~(got by goes.does.herd) i.furs) - |^ - ?- -.bend.meat - %clq - =/ troo (~(get by dead) +>-.bend.meat) - ?~ troo $(furs [+>-.bend.meat furs]) - =/ fals (~(get by dead) +>+.bend.meat) - ?~ fals $(furs [+>+.bend.meat furs]) - ~! u.troo - ~! u.fals - ~! +<.bend.meat - (vein (~(uni in u.troo) (~(put in u.fals) +<.bend.meat))) - :: - %eqq - =/ troo (~(get by dead) +>+<.bend.meat) - ?~ troo $(furs [+>+<.bend.meat furs]) - =/ fals (~(get by dead) +>+>.bend.meat) - ?~ fals $(furs [+>+>.bend.meat furs]) - (vein (~(uni in u.troo) (~(gas in u.fals) [+<.bend.meat +>-.bend.meat ~]))) - :: - %brn - =/ troo (~(get by dead) +>-.bend.meat) - ?~ troo $(furs [+>-.bend.meat furs]) - =/ fals (~(get by dead) +>+.bend.meat) - ?~ fals $(furs [+>+.bend.meat furs]) - (vein (~(uni in u.troo) (~(put in u.fals) +<.bend.meat))) - :: - %hop - =/ want (~(get by dead) +.bend.meat) - ?~ want $(furs [+.bend.meat furs]) - (vein u.want) - :: - %lnk - =/ want (~(get by dead) +>+>.bend.meat) - ?~ want $(furs [+>+>.bend.meat furs]) - (vein (~(gas in u.want) [+<.bend.meat +>-.bend.meat ~])) - :: - %cal - =/ want (~(get by dead) +>+>.bend.meat) - ?~ want $(furs [+>+>.bend.meat furs]) - (vein (~(gas in u.want) +>-.bend.meat)) - :: - %bec - ~| %bec-trip !! - :: - %lnt - (vein (silt [+<.bend.meat]~)) - :: - %jmp - (vein (silt +>.bend.meat)) - :: - %eye - ~| %eye-trip !! - :: - %spy - =/ want (~(get by dead) +>+>.bend.meat) - ?~ want $(furs [+>+>.bend.meat furs]) - (vein (~(gas in u.want) [+<.bend.meat +>-.bend.meat ~])) - :: - %hnt - =/ want (~(get by dead) +>.bend.meat) - ?~ want $(furs [+>.bend.meat furs]) - (vein (~(put in u.want) +<.bend.meat)) - :: - %don - (vein (silt [+.bend.meat]~)) - :: - %bom - (vein ~) - == - ++ vein - |= uses=(set @) - =/ boyd (flop body.meat) - =| bond=(list bran) - |- ^- _this - ~! goes.does.herd - ~! i.furs - ?~ boyd - %= ^^^$ - furs t.furs - goes.does.herd - (~(put by goes.does.herd) i.furs [bond bend.meat]) - dead - (~(put by dead) i.furs uses) - == - ?- -.i.boyd - %imm - ?: (~(has in uses) +>.i.boyd) - $(bond [i.boyd bond], boyd t.boyd) - $(boyd t.boyd) - :: - %mov - ?: (~(has in uses) +>.i.boyd) - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - $(boyd t.boyd) - :: - %inc - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - :: - %unc - ?: (~(has in uses) +>.i.boyd) - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - $(boyd t.boyd) - :: - %con - ?: (~(has in uses) +>+.i.boyd) - %= $ - bond [i.boyd bond] - boyd t.boyd - uses (~(gas in uses) [+<.i.boyd +>-.i.boyd ~]) - == - $(boyd t.boyd) - :: - %hed - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - :: - %hud - ?: (~(has in uses) +>.i.boyd) - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - $(boyd t.boyd) - :: - %tal - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - :: - %tul - ?: (~(has in uses) +>.i.boyd) - $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd)) - $(boyd t.boyd) - == - -- --- diff --git a/hoon/codegen/lib/eval.hoon b/hoon/codegen/lib/eval.hoon new file mode 100644 index 00000000..af190b5e --- /dev/null +++ b/hoon/codegen/lib/eval.hoon @@ -0,0 +1,304 @@ +/+ line +=> $:line +=* line . +=/ ip=? | +|% +++ this . +++ hour + =* thus . + |= [s=* f=*] + ^- [(unit) _this] + =< + =^ cone thus (cope s f) + =* n nomm.norm.cone + |- ^- [(unit) _this] + ?- -.n + %par + =^ l thus $(n left.n) + ?~ l [~ thus] + =^ r thus $(n rite.n) + ?~ r [~ thus] + [`[u.l u.r] thus] + :: + %not + ?: =(0 here.n) ~& %axe-none-crash [~ this] + |- ^- [(unit) _this] + ?: =(1 here.n) [`s this] + ?@ s ~& %axe-miss-crash [~ this] + ?- (cap here.n) + %2 $(s -.s, here.n (mas here.n)) + %3 $(s +.s, here.n (mas here.n)) + == + :: + %one + [`moan.n this] + :: + %two + =^ t thus $(n cost.n) + ?~ t [~ this] + =^ g thus $(n corn.n) + ?~ g [~ this] + =/ bull (~(get by ices.norm.cone) rail.n) + =^ cane thus + ?~ bull + ~& [%indirect t g] (cope u.t u.g) + ?> (~(huge so sock.u.bull) [& u.t]) + =/ kine (mose u.bull) + ?> ?=(^ kine) + [u.kine this] + $(s u.t, cone cane) + :: + %the + =^ p thus $(n pell.n) + ?~ p [~ this] + [`?^(u.p 0 1) this] + :: + %for + =^ m thus $(n mall.n) + ?~ m [~ this] + ?^ u.m ~& %inc-cell-crash [~ this] + [`.+(u.m) this] + :: + %ivy + =^ i thus $(n this.n) + ?~ i [~ this] + =^ o thus $(n that.n) + ?~ o [~ this] + [`.=(u.i u.o) this] + :: + %six + =^ c thus $(n what.n) + ?~ c [~ this] + ?. ?=(? u.c) ~& %cond-not-loobean [~ this] + ?: u.c $(n then.n) + $(n else.n) + :: + %eve + =^ t thus $(n once.n) + ?~ t [~ this] + $(s u.t, n then.n) + :: + %ten + ?: =(0 here.n) ~& %edit-none-crash [~ this] + =^ w thus $(n twig.n) + ?~ w [~ this] + =^ r thus $(n tree.n) + ?~ r [~ this] + =| tack=(list [?(%2 %3) *]) + |- ^- [(unit) _this] + ?. =(1 here.n) + ?@ u.r ~& %edit-miss-crash [~ this] + ?- (cap here.n) + %2 $(u.r -.u.r, tack [[%2 +.u.r] tack], here.n (mas here.n)) + %3 $(u.r +.u.r, tack [[%3 -.u.r] tack], here.n (mas here.n)) + == + |- ^- [(unit) _this] + ?~ tack [w this] + ?- -.i.tack + %2 $(tack t.tack, u.w [u.w +.i.tack]) + %3 $(tack t.tack, u.w [+.i.tack u.w]) + == + :: + %sip + $(n then.n) + :: + %tip + =^ h thus $(n vice.n) + ?~ h [~ this] + $(n then.n) + :: + %elf + ~| %no-scry !! + == + |% + ++ mose + |= [s=sock f=*] + ^- (unit hone) + =/ huns (~(get ja moan) f) + |- ^- (unit hone) + ?~ huns ~ + ?: =(s soot.i.huns) `i.huns + $(huns t.huns) + ++ mope + |= [s=* f=*] + ^- (unit hone) + ~! moan + =/ huns (~(get ja moan) f) + |- ^- (unit hone) + ?~ huns ~ + :: ~& [%mope-i soot.i.huns] + ~! so + ?: (~(huge so soot.i.huns) [& s]) + `i.huns + $(huns t.huns) + ++ cope + |= [s=* f=*] + ^- [hone _this] + =/ roan (mope s f) + ?: ?=(^ roan) [u.roan this] + =. sack (rout:sack s f) + ~& %rout-done + :: ~& [%cope-moan moan] + =/ sewn (mope s f) + ?. ?=(^ sewn) ~| [%mope-miss s f] !! + [u.sewn this] + -- +++ tine + |= [s=* f=*] + =< + =^ [=bell hall=_hill] line (peep s f) + =/ pill (~(got by hall) bell) + =/ blob (~(got by will.pill) wish.pill) + =/ rasp (star sire.pill s) + =| vile=(set @uvre) + |^ ^- (unit *) + ?^ body.blob + =* i i.body.blob + ~? ip i + ?- -.i + %imm $(rasp (p d.i n.i), body.blob t.body.blob) + %mov + ?: (~(has in vile) s.i) + $(vile (~(put in vile) d.i), body.blob t.body.blob) + $(rasp (mov s.i d.i), body.blob t.body.blob) + %inc + =/ v (g s.i) + ?^ v ~& [%inc-cell-crash v] ~ + $(rasp (p d.i .+(v)), body.blob t.body.blob) + :: + %con $(rasp (p d.i [(g h.i) (g t.i)]), body.blob t.body.blob) + %hed + =/ c (g s.i) + ?@ c + ~? ip [%poison d.i c] + $(vile (~(put in vile) d.i), body.blob t.body.blob) + $(rasp (p d.i -.c), body.blob t.body.blob) + :: + %tal + =/ c (g s.i) + ?@ c + ~? ip [%poison d.i c] + $(vile (~(put in vile) d.i), body.blob t.body.blob) + $(rasp (p d.i +.c), body.blob t.body.blob) + :: + %men ~& %mean-todo $(body.blob t.body.blob) + %man ~& %mean-todo $(body.blob t.body.blob) + %slo ~& %slow-todo $(body.blob t.body.blob) + %sld ~& %slow-todo $(body.blob t.body.blob) + %hit ~& %skip-hit $(body.blob t.body.blob) + %slg ~& (g s.i) $(body.blob t.body.blob) + %mew ~& %memo-todo $(body.blob t.body.blob) + %tim ~& %skip-tim $(body.blob t.body.blob) + %tom ~& %skip-tom $(body.blob t.body.blob) + %mem ~& %skip-mem $(body.blob t.body.blob) + %poi $(vile (~(put in vile) p.i), body.blob t.body.blob) + %ipb + |- ^- (unit *) + ?~ p.i ^$(body.blob t.body.blob) + ?: (~(has in vile) i.p.i) ~ + $(p.i t.p.i) + == + =* i bend.blob + ~? ip i + ?- -.i + %clq ?^((g s.i) (goto z.i) (goto o.i)) + %eqq ?:(=((g l.i) (g r.i)) (goto z.i) (goto o.i)) + %brn + =/ c (g s.i) + ?- c + %0 (goto z.i) + %1 (goto o.i) + * ~ + == + :: + %hop (goto t.i) + %hip ~& %no-hip !! + %lnk + =/ s (g u.i) + =/ f (g f.i) + =/ r (tine s f) + ?~ r ~ + =. rasp (p d.i u.r) + (goto t.i) + :: + %cal + =/ pins (~(got by hill) a.i) + =/ blub (~(got by will.pins) long.pins) + =/ r + %= $ + pill pins + blob blub + rasp (afar v.i walt.pins) + vile (soil v.i walt.pins) + == + ?~ r ~ + =. rasp (p d.i u.r) + (goto t.i) + :: + %caf ~| %caf-todo !! + %lnt (tine (g u.i) (g f.i)) + %jmp + =/ pins (~(got by hill) a.i) + =/ blub (~(got by will.pins) long.pins) + %= $ + pill pins + blob blub + rasp (afar v.i walt.pins) + vile (soil v.i walt.pins) + == + :: + %jmf ~| %jmf-todo !! + %spy ~& %no-scry !! + %mer ~& %skip-mem (goto m.i) + %don `(g s.i) + %bom ~ + == + ++ g + |= r=@uvre + (~(got by rasp) r) + ++ p + |= [r=@uvre v=*] + ~? ip [%p r v] + (~(put by rasp) r v) + ++ mov + |= [s=@uvre d=@uvre] + ^- _rasp + =/ mv (~(get by rasp) s) + ?~ mv ~& [%rasp-miss s (~(has in vile) s)] rasp + ~? ip [%p d u.mv] (~(put by rasp) d u.mv) + ++ goto |=(b=bile ^$(blob (~(got by will.pill) b))) + ++ afar + |= [v=(list @uvre) walt=(list @uvre)] + =| m=(map @uvre *) + |- ^- (map @uvre *) + ?~ v ?> =(~ walt) ~& [%c m] m + ?> ?=(^ walt) + =/ mv (~(get by rasp) i.v) + ?~ mv + ~? ip [%rasp-miss-afar i.v (~(has in vile) i.v)] + $(v t.v, walt t.walt) + $(m (~(put by m) i.walt u.mv), v t.v, walt t.walt) + ++ soil + |= [b=(list @uvre) bait=(list @uvre)] + =| p=(set @uvre) + |- ^- (set @uvre) + ?~ b ?> =(~ bait) p + ?> ?=(^ bait) + =? p (~(has in vile) i.b) (~(put in p) i.bait) + $(b t.b, bait t.bait) + -- + |% + ++ peep + |= [s=* f=*] + ^- [[=bell hall=_hill] _line] + =/ bull (peek:line s f) + ?: ?=(^ bull) [u.bull line] + =. line this:(poke:line [%comp ~ s f]) + =/ ball (peek:line s f) + ?> ?=(^ ball) + [u.ball line] + ++ star + |= [r=@uvre s=*] + (~(put by *(map @uvre *)) r s) + -- +-- diff --git a/hoon/codegen/lib/hoot.hoon b/hoon/codegen/lib/hoot.hoon new file mode 100644 index 00000000..59a0fc63 --- /dev/null +++ b/hoon/codegen/lib/hoot.hoon @@ -0,0 +1,14059 @@ +:: +:::: /sys/hoon but as a trap :: + :: :: +!. +|. +=< ride +=> %139 => +:: :: +:::: 0: version stub :: + :: :: +~% %k.139 ~ ~ :: +|% +++ hoon-version + +-- => +~% %one + ~ +:: layer-1 +:: +:: basic mathematical operations +|% +:: unsigned arithmetic ++| %math +++ add + ~/ %add + :: unsigned addition + :: + :: a: augend + :: b: addend + |= [a=@ b=@] + :: sum + ^- @ + ?: =(0 a) b + $(a (dec a), b +(b)) +:: +++ dec + ~/ %dec + :: unsigned decrement by one. + |= a=@ + ~_ leaf+"decrement-underflow" + ?< =(0 a) + =+ b=0 + :: decremented integer + |- ^- @ + ?: =(a +(b)) b + $(b +(b)) +:: +++ div + ~/ %div + :: unsigned divide + :: + :: a: dividend + :: b: divisor + |: [a=`@`1 b=`@`1] + :: quotient + ^- @ + -:(dvr a b) +:: +++ dvr + ~/ %dvr + :: unsigned divide with remainder + :: + :: a: dividend + :: b: divisor + |: [a=`@`1 b=`@`1] + :: p: quotient + :: q: remainder + ^- [p=@ q=@] + ~_ leaf+"divide-by-zero" + ?< =(0 b) + =+ c=0 + |- + ?: (lth a b) [c a] + $(a (sub a b), c +(c)) +:: +++ gte + ~/ %gte + :: unsigned greater than or equals + :: + :: returns whether {a >= b}. + :: + :: a: left hand operand (todo: name) + :: b: right hand operand + |= [a=@ b=@] + :: greater than or equal to? + ^- ? + !(lth a b) +:: +++ gth + ~/ %gth + :: unsigned greater than + :: + :: returns whether {a > b} + :: + :: a: left hand operand (todo: name) + :: b: right hand operand + |= [a=@ b=@] + :: greater than? + ^- ? + !(lte a b) +:: +++ lte + ~/ %lte + :: unsigned less than or equals + :: + :: returns whether {a >= b}. + :: + :: a: left hand operand (todo: name) + :: b: right hand operand + |= [a=@ b=@] + :: less than or equal to? + |(=(a b) (lth a b)) +:: +++ lth + ~/ %lth + :: unsigned less than + :: + :: a: left hand operand (todo: name) + :: b: right hand operand + |= [a=@ b=@] + :: less than? + ^- ? + ?& !=(a b) + |- + ?| =(0 a) + ?& !=(0 b) + $(a (dec a), b (dec b)) + == == == +:: +++ max + ~/ %max + :: unsigned maximum + |= [a=@ b=@] + :: the maximum + ^- @ + ?: (gth a b) a + b +:: +++ min + ~/ %min + :: unsigned minimum + |= [a=@ b=@] + :: the minimum + ^- @ + ?: (lth a b) a + b +:: +++ mod + ~/ %mod + :: unsigned modulus + :: + :: a: dividend + :: b: divisor + |: [a=`@`1 b=`@`1] + :: the remainder + ^- @ + +:(dvr a b) +:: +++ mul + ~/ %mul + :: unsigned multiplication + :: + :: a: multiplicand + :: b: multiplier + |: [a=`@`1 b=`@`1] + :: product + ^- @ + =+ c=0 + |- + ?: =(0 a) c + $(a (dec a), c (add b c)) +:: +++ sub + ~/ %sub + :: unsigned subtraction + :: + :: a: minuend + :: b: subtrahend + |= [a=@ b=@] + ~_ leaf+"subtract-underflow" + :: difference + ^- @ + ?: =(0 b) a + $(a (dec a), b (dec b)) +:: +:: tree addressing ++| %tree +++ cap + ~/ %cap + :: tree head + :: + :: tests whether an `a` is in the head or tail of a noun. produces %2 if it + :: is within the head, or %3 if it is within the tail. + |= a=@ + ^- ?(%2 %3) + ?- a + %2 %2 + %3 %3 + ?(%0 %1) !! + * $(a (div a 2)) + == +:: +++ mas + ~/ %mas + :: axis within head/tail + :: + :: computes the axis of `a` within either the head or tail of a noun + :: (depends whether `a` lies within the the head or tail). + |= a=@ + ^- @ + ?- a + ?(%2 %3) 1 + ?(%0 %1) !! + * (add (mod a 2) (mul $(a (div a 2)) 2)) + == +:: +++ peg + ~/ %peg + :: axis within axis + :: + :: computes the axis of {b} within axis {a}. + |= [a=@ b=@] + ?< =(0 a) + :: a composed axis + ^- @ + ?- b + %1 a + %2 (mul a 2) + %3 +((mul a 2)) + * (add (mod b 2) (mul $(b (div b 2)) 2)) + == +:: +:: # %containers +:: +:: the most basic of data types ++| %containers +:: ++$ bite + :: atom slice specifier + :: + $@(bloq [=bloq =step]) +:: ++$ bloq + :: blocksize + :: + :: a blocksize is the power of 2 size of an atom. ie, 3 is a byte as 2^3 is + :: 8 bits. + @ +:: +++ each + |$ [this that] + :: either {a} or {b}, defaulting to {a}. + :: + :: mold generator: produces a discriminated fork between two types, + :: defaulting to {a}. + :: + $% [%| p=that] + [%& p=this] + == +:: ++$ gate + :: function + :: + :: a core with one arm, `$`--the empty name--which transforms a sample noun + :: into a product noun. If used dryly as a type, the subject must have a + :: sample type of `*`. + $-(* *) +:: +++ list + |$ [item] + :: null-terminated list + :: + :: mold generator: produces a mold of a null-terminated list of the + :: homogeneous type {a}. + :: + $@(~ [i=item t=(list item)]) +:: +++ lone + |$ [item] + :: single item tuple + :: + :: mold generator: puts the face of `p` on the passed in mold. + :: + p=item +:: +++ lest + |$ [item] + :: null-terminated non-empty list + :: + :: mold generator: produces a mold of a null-terminated list of the + :: homogeneous type {a} with at least one element. + [i=item t=(list item)] +:: ++$ mold + :: normalizing gate + :: + :: a gate that accepts any noun, and validates its shape, producing the + :: input if it fits or a default value if it doesn't. + :: + :: examples: * @ud ,[p=time q=?(%a %b)] + $~(* $-(* *)) +:: +++ pair + |$ [head tail] + :: dual tuple + :: + :: mold generator: produces a tuple of the two types passed in. + :: + :: a: first type, labeled {p} + :: b: second type, labeled {q} + :: + [p=head q=tail] +:: +++ pole + |$ [item] + :: faceless list + :: + :: like ++list, but without the faces {i} and {t}. + :: + $@(~ [item (pole item)]) +:: +++ qual + |$ [first second third fourth] + :: quadruple tuple + :: + :: mold generator: produces a tuple of the four types passed in. + :: + [p=first q=second r=third s=fourth] +:: +++ quip + |$ [item state] + :: pair of list of first and second + :: + :: a common pattern in hoon code is to return a ++list of changes, along with + :: a new state. + :: + :: a: type of list item + :: b: type of returned state + :: + [(list item) state] +:: +++ step + :: atom size or offset, in bloqs + :: + _`@u`1 +:: +++ trap + |$ [product] + :: a core with one arm `$` + :: + _|?($:product) +:: +++ tree + |$ [node] + :: tree mold generator + :: + :: a `++tree` can be empty, or contain a node of a type and + :: left/right sub `++tree` of the same type. pretty-printed with `{}`. + :: + $@(~ [n=node l=(tree node) r=(tree node)]) +:: +++ trel + |$ [first second third] + :: triple tuple + :: + :: mold generator: produces a tuple of the three types passed in. + :: + [p=first q=second r=third] +:: +++ unit + |$ [item] + :: maybe + :: + :: mold generator: either `~` or `[~ u=a]` where `a` is the + :: type that was passed in. + :: + $@(~ [~ u=item]) +-- => +:: +~% %two + ~ +:: layer-2 +:: +|% +:: 2a: unit logic ++| %unit-logc +:: +++ biff :: apply + |* [a=(unit) b=$-(* (unit))] + ?~ a ~ + (b u.a) +:: +++ bind :: argue + |* [a=(unit) b=gate] + ?~ a ~ + [~ u=(b u.a)] +:: +++ bond :: replace + |* a=(trap) + |* b=(unit) + ?~ b $:a + u.b +:: +++ both :: all the above + |* [a=(unit) b=(unit)] + ?~ a ~ + ?~ b ~ + [~ u=[u.a u.b]] +:: +++ clap :: combine + |* [a=(unit) b=(unit) c=_=>(~ |=(^ +<-))] + ?~ a b + ?~ b a + [~ u=(c u.a u.b)] +:: +++ clef :: compose + |* [a=(unit) b=(unit) c=_=>(~ |=(^ `+<-))] + ?~ a ~ + ?~ b ~ + (c u.a u.b) +:: +++ drop :: enlist + |* a=(unit) + ?~ a ~ + [i=u.a t=~] +:: +++ fall :: default + |* [a=(unit) b=*] + ?~(a b u.a) +:: +++ flit :: make filter + |* a=$-(* ?) + |* b=* + ?.((a b) ~ [~ u=b]) +:: +++ hunt :: first of units + |* [ord=$-(^ ?) a=(unit) b=(unit)] + ^- %- unit + $? _?>(?=(^ a) u.a) + _?>(?=(^ b) u.b) + == + ?~ a b + ?~ b a + ?:((ord u.a u.b) a b) +:: +++ lift :: lift mold (fmap) + |* a=mold :: flipped + |* b=(unit) :: curried + (bind b a) :: bind +:: +++ mate :: choose + |* [a=(unit) b=(unit)] + ?~ b a + ?~ a b + ?.(=(u.a u.b) ~>(%mean.'mate' !!) a) +:: +++ need :: demand + ~/ %need + |* a=(unit) + ?~ a ~>(%mean.'need' !!) + u.a +:: +++ some :: lift (pure) + |* a=* + [~ u=a] +:: +:: 2b: list logic ++| %list-logic +:: +snoc: append an element to the end of a list +:: +++ snoc + |* [a=(list) b=*] + (weld a ^+(a [b]~)) +:: +:: +lure: List pURE +++ lure + |* a=* + [i=a t=~] +:: +++ fand :: all indices + ~/ %fand + |= [nedl=(list) hstk=(list)] + =| i=@ud + =| fnd=(list @ud) + |- ^+ fnd + =+ [n=nedl h=hstk] + |- + ?: |(?=(~ n) ?=(~ h)) + (flop fnd) + ?: =(i.n i.h) + ?~ t.n + ^$(i +(i), hstk +.hstk, fnd [i fnd]) + $(n t.n, h t.h) + ^$(i +(i), hstk +.hstk) +:: +++ find :: first index + ~/ %find + |= [nedl=(list) hstk=(list)] + =| i=@ud + |- ^- (unit @ud) + =+ [n=nedl h=hstk] + |- + ?: |(?=(~ n) ?=(~ h)) + ~ + ?: =(i.n i.h) + ?~ t.n + `i + $(n t.n, h t.h) + ^$(i +(i), hstk +.hstk) +:: +++ flop :: reverse + ~/ %flop + |* a=(list) + => .(a (homo a)) + ^+ a + =+ b=`_a`~ + |- + ?~ a b + $(a t.a, b [i.a b]) +:: +++ gulf :: range inclusive + |= [a=@ b=@] + ?> (lte a b) + |- ^- (list @) + ?:(=(a +(b)) ~ [a $(a +(a))]) +:: +++ homo :: homogenize + |* a=(list) + ^+ =< $ + |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$]) + -- + a +:: +join: construct a new list, placing .sep between every pair in .lit +:: +++ join + |* [sep=* lit=(list)] + =. sep `_?>(?=(^ lit) i.lit)`sep + ?~ lit ~ + =| out=(list _?>(?=(^ lit) i.lit)) + |- ^+ out + ?~ t.lit + (flop [i.lit out]) + $(out [sep i.lit out], lit t.lit) +:: +:: +bake: convert wet gate to dry gate by specifying argument mold +:: +++ bake + |* [f=gate a=mold] + |= arg=a + (f arg) +:: +++ lent :: length + ~/ %lent + |= a=(list) + ^- @ + =+ b=0 + |- + ?~ a b + $(a t.a, b +(b)) +:: +++ levy + ~/ %levy :: all of + |* [a=(list) b=$-(* ?)] + |- ^- ? + ?~ a & + ?. (b i.a) | + $(a t.a) +:: +++ lien :: some of + ~/ %lien + |* [a=(list) b=$-(* ?)] + |- ^- ? + ?~ a | + ?: (b i.a) & + $(a t.a) +:: +++ limo :: listify + |* a=* + ^+ =< $ + |@ ++ $ ?~(a ~ ?:(*? [i=-.a t=$] $(a +.a))) + -- + a +:: +++ murn :: maybe transform + ~/ %murn + |* [a=(list) b=$-(* (unit))] + => .(a (homo a)) + |- ^- (list _?>(?=(^ a) (need (b i.a)))) + ?~ a ~ + =/ c (b i.a) + ?~ c $(a t.a) + [+.c $(a t.a)] +:: +++ oust :: remove + ~/ %oust + |* [[a=@ b=@] c=(list)] + (weld (scag +<-< c) (slag (add +<-< +<->) c)) +:: +++ reap :: replicate + ~/ %reap + |* [a=@ b=*] + |- ^- (list _b) + ?~ a ~ + [b $(a (dec a))] +:: +++ rear :: last item of list + ~/ %rear + |* a=(list) + ^- _?>(?=(^ a) i.a) + ?> ?=(^ a) + ?: =(~ t.a) i.a ::NOTE avoiding tmi + $(a t.a) +:: +++ reel :: right fold + ~/ %reel + |* [a=(list) b=_=>(~ |=([* *] +<+))] + |- ^+ ,.+<+.b + ?~ a + +<+.b + (b i.a $(a t.a)) +:: +++ roll :: left fold + ~/ %roll + |* [a=(list) b=_=>(~ |=([* *] +<+))] + |- ^+ ,.+<+.b + ?~ a + +<+.b + $(a t.a, b b(+<+ (b i.a +<+.b))) +:: +++ scag :: prefix + ~/ %scag + |* [a=@ b=(list)] + |- ^+ b + ?: |(?=(~ b) =(0 a)) ~ + [i.b $(b t.b, a (dec a))] +:: +++ skid :: separate + ~/ %skid + |* [a=(list) b=$-(* ?)] + |- ^+ [p=a q=a] + ?~ a [~ ~] + =+ c=$(a t.a) + ?:((b i.a) [[i.a p.c] q.c] [p.c [i.a q.c]]) +:: +++ skim :: only + ~/ %skim + |* [a=(list) b=$-(* ?)] + |- + ^+ a + ?~ a ~ + ?:((b i.a) [i.a $(a t.a)] $(a t.a)) +:: +++ skip :: except + ~/ %skip + |* [a=(list) b=$-(* ?)] + |- + ^+ a + ?~ a ~ + ?:((b i.a) $(a t.a) [i.a $(a t.a)]) +:: +++ slag :: suffix + ~/ %slag + |* [a=@ b=(list)] + |- ^+ b + ?: =(0 a) b + ?~ b ~ + $(b t.b, a (dec a)) +:: +++ snag :: index + ~/ %snag + |* [a=@ b=(list)] + |- ^+ ?>(?=(^ b) i.b) + ?~ b + ~_ leaf+"snag-fail" + !! + ?: =(0 a) i.b + $(b t.b, a (dec a)) +:: +++ snip :: drop tail off list + ~/ %snip + |* a=(list) + ^+ a + ?~ a ~ + ?: =(~ t.a) ~ + [i.a $(a t.a)] +:: +++ sort !. :: quicksort + ~/ %sort + |* [a=(list) b=$-([* *] ?)] + => .(a ^.(homo a)) + |- ^+ a + ?~ a ~ + =+ s=(skid t.a |:(c=i.a (b c i.a))) + %+ weld + $(a p.s) + ^+ t.a + [i.a $(a q.s)] +:: +++ spin :: stateful turn + :: + :: a: list + :: b: state + :: c: gate from list-item and state to product and new state + ~/ %spin + |* [a=(list) b=* c=_|=(^ [** +<+])] + => .(c `$-([_?>(?=(^ a) i.a) _b] [_-:(c) _b])`c) + =/ acc=(list _-:(c)) ~ + :: transformed list and updated state + |- ^- (pair _acc _b) + ?~ a + [(flop acc) b] + =^ res b (c i.a b) + $(acc [res acc], a t.a) +:: +++ spun :: internal spin + :: + :: a: list + :: b: gate from list-item and state to product and new state + ~/ %spun + |* [a=(list) b=_|=(^ [** +<+])] + :: transformed list + p:(spin a +<+.b b) +:: +++ swag :: slice + |* [[a=@ b=@] c=(list)] + (scag +<-> (slag +<-< c)) +:: +turn: transform each value of list :a using the function :b +:: +++ turn + ~/ %turn + |* [a=(list) b=gate] + => .(a (homo a)) + ^- (list _?>(?=(^ a) (b i.a))) + |- + ?~ a ~ + [i=(b i.a) t=$(a t.a)] +:: +++ weld :: concatenate + ~/ %weld + |* [a=(list) b=(list)] + => .(a ^.(homo a), b ^.(homo b)) + |- ^+ b + ?~ a b + [i.a $(a t.a)] +:: +++ snap :: replace item + ~/ %snap + |* [a=(list) b=@ c=*] + ^+ a + (weld (scag b a) [c (slag +(b) a)]) +:: +++ into :: insert item + ~/ %into + |* [a=(list) b=@ c=*] + ^+ a + (weld (scag b a) [c (slag b a)]) +:: +++ welp :: faceless weld + ~/ %welp + |* [* *] + ?~ +<- + +<-(. +<+) + +<-(+ $(+<- +<->)) +:: +++ zing :: promote + ~/ %zing + |* * + ?~ +< + +< + (welp +<- $(+< +<+)) +:: +:: 2c: bit arithmetic ++| %bit-arithmetic +:: +++ bex :: binary exponent + ~/ %bex + |= a=bloq + ^- @ + ?: =(0 a) 1 + (mul 2 $(a (dec a))) +:: +++ can :: assemble + ~/ %can + |= [a=bloq b=(list [p=step q=@])] + ^- @ + ?~ b 0 + (add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b))) +:: +++ cat :: concatenate + ~/ %cat + |= [a=bloq b=@ c=@] + (add (lsh [a (met a b)] c) b) +:: +++ cut :: slice + ~/ %cut + |= [a=bloq [b=step c=step] d=@] + (end [a c] (rsh [a b] d)) +:: +++ end :: tail + ~/ %end + |= [a=bite b=@] + =/ [=bloq =step] ?^(a a [a *step]) + (mod b (bex (mul (bex bloq) step))) +:: +++ fil :: fill bloqstream + ~/ %fil + |= [a=bloq b=step c=@] + =| n=@ud + =. c (end a c) + =/ d c + |- ^- @ + ?: =(n b) + (rsh a d) + $(d (add c (lsh a d)), n +(n)) +:: +++ lsh :: left-shift + ~/ %lsh + |= [a=bite b=@] + =/ [=bloq =step] ?^(a a [a *step]) + (mul b (bex (mul (bex bloq) step))) +:: +++ met :: measure + ~/ %met + |= [a=bloq b=@] + ^- @ + =+ c=0 + |- + ?: =(0 b) c + $(b (rsh a b), c +(c)) +:: +++ rap :: assemble variable + ~/ %rap + |= [a=bloq b=(list @)] + ^- @ + ?~ b 0 + (cat a i.b $(b t.b)) +:: +++ rep :: assemble fixed + ~/ %rep + |= [a=bite b=(list @)] + =/ [=bloq =step] ?^(a a [a *step]) + =| i=@ud + |- ^- @ + ?~ b 0 + %+ add $(i +(i), b t.b) + (lsh [bloq (mul step i)] (end [bloq step] i.b)) +:: +++ rev + :: reverses block order, accounting for leading zeroes + :: + :: boz: block size + :: len: size of dat, in boz + :: dat: data to flip + ~/ %rev + |= [boz=bloq len=@ud dat=@] + ^- @ + =. dat (end [boz len] dat) + %+ lsh + [boz (sub len (met boz dat))] + (swp boz dat) +:: +++ rip :: disassemble + ~/ %rip + |= [a=bite b=@] + ^- (list @) + ?: =(0 b) ~ + [(end a b) $(b (rsh a b))] +:: +++ rsh :: right-shift + ~/ %rsh + |= [a=bite b=@] + =/ [=bloq =step] ?^(a a [a *step]) + (div b (bex (mul (bex bloq) step))) +:: +++ run :: +turn into atom + ~/ %run + |= [a=bite b=@ c=$-(@ @)] + (rep a (turn (rip a b) c)) +:: +++ rut :: +turn into list + ~/ %rut + |* [a=bite b=@ c=$-(@ *)] + (turn (rip a b) c) +:: +++ sew :: stitch into + ~/ %sew + |= [a=bloq [b=step c=step d=@] e=@] + ^- @ + %+ add + (can a b^e c^d ~) + =/ f [a (add b c)] + (lsh f (rsh f e)) +:: +++ swp :: naive rev bloq order + ~/ %swp + |= [a=bloq b=@] + (rep a (flop (rip a b))) +:: +++ xeb :: binary logarithm + ~/ %xeb + |= a=@ + ^- @ + (met 0 a) +:: +++ fe :: modulo bloq + |_ a=bloq + ++ dif :: difference + |=([b=@ c=@] (sit (sub (add out (sit b)) (sit c)))) + ++ inv |=(b=@ (sub (dec out) (sit b))) :: inverse + ++ net |= b=@ ^- @ :: flip byte endianness + => .(b (sit b)) + ?: (lte a 3) + b + =+ c=(dec a) + %+ con + (lsh c $(a c, b (cut c [0 1] b))) + $(a c, b (cut c [1 1] b)) + ++ out (bex (bex a)) :: mod value + ++ rol |= [b=bloq c=@ d=@] ^- @ :: roll left + =+ e=(sit d) + =+ f=(bex (sub a b)) + =+ g=(mod c f) + (sit (con (lsh [b g] e) (rsh [b (sub f g)] e))) + ++ ror |= [b=bloq c=@ d=@] ^- @ :: roll right + =+ e=(sit d) + =+ f=(bex (sub a b)) + =+ g=(mod c f) + (sit (con (rsh [b g] e) (lsh [b (sub f g)] e))) + ++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add + ++ sit |=(b=@ (end a b)) :: enforce modulo + -- +:: +:: 2d: bit logic ++| %bit-logic +:: +++ con :: binary or + ~/ %con + |= [a=@ b=@] + =+ [c=0 d=0] + |- ^- @ + ?: ?&(=(0 a) =(0 b)) d + %= $ + a (rsh 0 a) + b (rsh 0 b) + c +(c) + d %+ add d + %+ lsh [0 c] + ?& =(0 (end 0 a)) + =(0 (end 0 b)) + == + == +:: +++ dis :: binary and + ~/ %dis + |= [a=@ b=@] + =| [c=@ d=@] + |- ^- @ + ?: ?|(=(0 a) =(0 b)) d + %= $ + a (rsh 0 a) + b (rsh 0 b) + c +(c) + d %+ add d + %+ lsh [0 c] + ?| =(0 (end 0 a)) + =(0 (end 0 b)) + == + == +:: +++ mix :: binary xor + ~/ %mix + |= [a=@ b=@] + ^- @ + =+ [c=0 d=0] + |- + ?: ?&(=(0 a) =(0 b)) d + %= $ + a (rsh 0 a) + b (rsh 0 b) + c +(c) + d (add d (lsh [0 c] =((end 0 a) (end 0 b)))) + == +:: +++ not |= [a=bloq b=@ c=@] :: binary not (sized) + (mix c (dec (bex (mul b (bex a))))) +:: +:: 2e: insecure hashing ++| %insecure-hashing +:: +++ muk :: standard murmur3 + ~% %muk ..muk ~ + =+ ~(. fe 5) + |= [syd=@ len=@ key=@] + =. syd (end 5 syd) + =/ pad (sub len (met 3 key)) + =/ data (weld (rip 3 key) (reap pad 0)) + =/ nblocks (div len 4) :: intentionally off-by-one + =/ h1 syd + =+ [c1=0xcc9e.2d51 c2=0x1b87.3593] + =/ blocks (rip 5 key) + =/ i nblocks + =. h1 =/ hi h1 |- + ?: =(0 i) hi + =/ k1 (snag (sub nblocks i) blocks) :: negative array index + =. k1 (sit (mul k1 c1)) + =. k1 (rol 0 15 k1) + =. k1 (sit (mul k1 c2)) + =. hi (mix hi k1) + =. hi (rol 0 13 hi) + =. hi (sum (sit (mul hi 5)) 0xe654.6b64) + $(i (dec i)) + =/ tail (slag (mul 4 nblocks) data) + =/ k1 0 + =/ tlen (dis len 3) + =. h1 + ?+ tlen h1 :: fallthrough switch + %3 =. k1 (mix k1 (lsh [0 16] (snag 2 tail))) + =. k1 (mix k1 (lsh [0 8] (snag 1 tail))) + =. k1 (mix k1 (snag 0 tail)) + =. k1 (sit (mul k1 c1)) + =. k1 (rol 0 15 k1) + =. k1 (sit (mul k1 c2)) + (mix h1 k1) + %2 =. k1 (mix k1 (lsh [0 8] (snag 1 tail))) + =. k1 (mix k1 (snag 0 tail)) + =. k1 (sit (mul k1 c1)) + =. k1 (rol 0 15 k1) + =. k1 (sit (mul k1 c2)) + (mix h1 k1) + %1 =. k1 (mix k1 (snag 0 tail)) + =. k1 (sit (mul k1 c1)) + =. k1 (rol 0 15 k1) + =. k1 (sit (mul k1 c2)) + (mix h1 k1) + == + =. h1 (mix h1 len) + |^ (fmix32 h1) + ++ fmix32 + |= h=@ + =. h (mix h (rsh [0 16] h)) + =. h (sit (mul h 0x85eb.ca6b)) + =. h (mix h (rsh [0 13] h)) + =. h (sit (mul h 0xc2b2.ae35)) + =. h (mix h (rsh [0 16] h)) + h + -- +:: +++ mug :: mug with murmur3 + ~/ %mug + |= a=* + |^ ?@ a (mum 0xcafe.babe 0x7fff a) + =/ b (cat 5 $(a -.a) $(a +.a)) + (mum 0xdead.beef 0xfffe b) + :: + ++ mum + |= [syd=@uxF fal=@F key=@] + =/ wyd (met 3 key) + =| i=@ud + |- ^- @F + ?: =(8 i) fal + =/ haz=@F (muk syd wyd key) + =/ ham=@F (mix (rsh [0 31] haz) (end [0 31] haz)) + ?.(=(0 ham) ham $(i +(i), syd +(syd))) + -- +:: :: +:: 2f: noun ordering ++| %noun-ordering +:: +:: +aor: alphabetical order +:: +:: Orders atoms before cells, and atoms in ascending LSB order. +:: +++ aor + ~/ %aor + |= [a=* b=*] + ^- ? + ?: =(a b) & + ?. ?=(@ a) + ?: ?=(@ b) | + ?: =(-.a -.b) + $(a +.a, b +.b) + $(a -.a, b -.b) + ?. ?=(@ b) & + |- + =+ [c=(end 3 a) d=(end 3 b)] + ?: =(c d) + $(a (rsh 3 a), b (rsh 3 b)) + (lth c d) +:: +dor: depth order +:: +:: Orders in ascending tree depth. +:: +++ dor + ~/ %dor + |= [a=* b=*] + ^- ? + ?: =(a b) & + ?. ?=(@ a) + ?: ?=(@ b) | + ?: =(-.a -.b) + $(a +.a, b +.b) + $(a -.a, b -.b) + ?. ?=(@ b) & + (lth a b) +:: +gor: mug order +:: +:: Orders in ascending +mug hash order, collisions fall back to +dor. +:: +++ gor + ~/ %gor + |= [a=* b=*] + ^- ? + =+ [c=(mug a) d=(mug b)] + ?: =(c d) + (dor a b) + (lth c d) +:: +mor: (more) mug order +:: +:: Orders in ascending double +mug hash order, collisions fall back to +dor. +:: +++ mor + ~/ %mor + |= [a=* b=*] + ^- ? + =+ [c=(mug (mug a)) d=(mug (mug b))] + ?: =(c d) + (dor a b) + (lth c d) +:: +:: 2g: unsigned powers ++| %unsigned-powers +:: +++ pow :: unsigned exponent + ~/ %pow + |= [a=@ b=@] + ?: =(b 0) 1 + |- ?: =(b 1) a + =+ c=$(b (div b 2)) + =+ d=(mul c c) + ?~ (dis b 1) d (mul d a) +:: +++ sqt :: unsigned sqrt/rem + ~/ %sqt + |= a=@ ^- [p=@ q=@] + ?~ a [0 0] + =+ [q=(div (dec (xeb a)) 2) r=0] + =- [-.b (sub a +.b)] + ^= b |- + =+ s=(add r (bex q)) + =+ t=(mul s s) + ?: =(q 0) + ?:((lte t a) [s t] [r (mul r r)]) + ?: (lte t a) + $(r s, q (dec q)) + $(q (dec q)) +:: +:: 2h: set logic ++| %set-logic +:: +++ in :: set engine + ~/ %in + =| a=(tree) :: (set) + |@ + ++ all :: logical AND + ~/ %all + |* b=$-(* ?) + |- ^- ? + ?~ a + & + ?&((b n.a) $(a l.a) $(a r.a)) + :: + ++ any :: logical OR + ~/ %any + |* b=$-(* ?) + |- ^- ? + ?~ a + | + ?|((b n.a) $(a l.a) $(a r.a)) + :: + ++ apt :: check correctness + =< $ + ~/ %apt + =| [l=(unit) r=(unit)] + |. ^- ? + ?~ a & + ?& ?~(l & &((gor n.a u.l) !=(n.a u.l))) + ?~(r & &((gor u.r n.a) !=(u.r n.a))) + ?~(l.a & ?&((mor n.a n.l.a) !=(n.a n.l.a) $(a l.a, l `n.a))) + ?~(r.a & ?&((mor n.a n.r.a) !=(n.a n.r.a) $(a r.a, r `n.a))) + == + :: + ++ bif :: splits a by b + ~/ %bif + |* b=* + ^+ [l=a r=a] + =< + + |- ^+ a + ?~ a + [b ~ ~] + ?: =(b n.a) + a + ?: (gor b n.a) + =+ c=$(a l.a) + ?> ?=(^ c) + c(r a(l r.c)) + =+ c=$(a r.a) + ?> ?=(^ c) + c(l a(r l.c)) + :: + ++ del :: b without any a + ~/ %del + |* b=* + |- ^+ a + ?~ a + ~ + ?. =(b n.a) + ?: (gor b n.a) + a(l $(a l.a)) + a(r $(a r.a)) + |- ^- [$?(~ _a)] + ?~ l.a r.a + ?~ r.a l.a + ?: (mor n.l.a n.r.a) + l.a(r $(l.a r.l.a)) + r.a(l $(r.a l.r.a)) + :: + ++ dif :: difference + ~/ %dif + |* b=_a + |- ^+ a + ?~ b + a + =+ c=(bif n.b) + ?> ?=(^ c) + =+ d=$(a l.c, b l.b) + =+ e=$(a r.c, b r.b) + |- ^- [$?(~ _a)] + ?~ d e + ?~ e d + ?: (mor n.d n.e) + d(r $(d r.d)) + e(l $(e l.e)) + :: + ++ dig :: axis of a in b + |= b=* + =+ c=1 + |- ^- (unit @) + ?~ a ~ + ?: =(b n.a) [~ u=(peg c 2)] + ?: (gor b n.a) + $(a l.a, c (peg c 6)) + $(a r.a, c (peg c 7)) + :: + ++ gas :: concatenate + ~/ %gas + |= b=(list _?>(?=(^ a) n.a)) + |- ^+ a + ?~ b + a + $(b t.b, a (put i.b)) + :: +has: does :b exist in :a? + :: + ++ has + ~/ %has + |* b=* + ^- ? + :: wrap extracted item type in a unit because bunting fails + :: + :: If we used the real item type of _?^(a n.a !!) as the sample type, + :: then hoon would bunt it to create the default sample for the gate. + :: + :: However, bunting that expression fails if :a is ~. If we wrap it + :: in a unit, the bunted unit doesn't include the bunted item type. + :: + :: This way we can ensure type safety of :b without needing to perform + :: this failing bunt. It's a hack. + :: + %. [~ b] + |= b=(unit _?>(?=(^ a) n.a)) + => .(b ?>(?=(^ b) u.b)) + |- ^- ? + ?~ a + | + ?: =(b n.a) + & + ?: (gor b n.a) + $(a l.a) + $(a r.a) + :: + ++ int :: intersection + ~/ %int + |* b=_a + |- ^+ a + ?~ b + ~ + ?~ a + ~ + ?. (mor n.a n.b) + $(a b, b a) + ?: =(n.b n.a) + a(l $(a l.a, b l.b), r $(a r.a, b r.b)) + ?: (gor n.b n.a) + %- uni(a $(a l.a, r.b ~)) $(b r.b) + %- uni(a $(a r.a, l.b ~)) $(b l.b) + :: + ++ put :: puts b in a, sorted + ~/ %put + |* b=* + |- ^+ a + ?~ a + [b ~ ~] + ?: =(b n.a) + a + ?: (gor b n.a) + =+ c=$(a l.a) + ?> ?=(^ c) + ?: (mor n.a n.c) + a(l c) + c(r a(l r.c)) + =+ c=$(a r.a) + ?> ?=(^ c) + ?: (mor n.a n.c) + a(r c) + c(l a(r l.c)) + :: + ++ rep :: reduce to product + ~/ %rep + |* b=_=>(~ |=([* *] +<+)) + |- + ?~ a +<+.b + $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b))) + :: + ++ run :: apply gate to values + ~/ %run + |* b=gate + =+ c=`(set _?>(?=(^ a) (b n.a)))`~ + |- ?~ a c + =. c (~(put in c) (b n.a)) + =. c $(a l.a, c c) + $(a r.a, c c) + :: + ++ tap :: convert to list + =< $ + ~/ %tap + =+ b=`(list _?>(?=(^ a) n.a))`~ + |. ^+ b + ?~ a + b + $(a r.a, b [n.a $(a l.a)]) + :: + ++ uni :: union + ~/ %uni + |* b=_a + ?: =(a b) a + |- ^+ a + ?~ b + a + ?~ a + b + ?: =(n.b n.a) + b(l $(a l.a, b l.b), r $(a r.a, b r.b)) + ?: (mor n.a n.b) + ?: (gor n.b n.a) + $(l.a $(a l.a, r.b ~), b r.b) + $(r.a $(a r.a, l.b ~), b l.b) + ?: (gor n.a n.b) + $(l.b $(b l.b, r.a ~), a r.a) + $(r.b $(b r.b, l.a ~), a l.a) + :: + ++ wyt :: size of set + =< $ + ~% %wyt + ~ + |. ^- @ + ?~(a 0 +((add $(a l.a) $(a r.a)))) + -- +:: +:: 2i: map logic ++| %map-logic +:: +++ by :: map engine + ~/ %by + =| a=(tree (pair)) :: (map) + |@ + ++ all :: logical AND + ~/ %all + |* b=$-(* ?) + |- ^- ? + ?~ a + & + ?&((b q.n.a) $(a l.a) $(a r.a)) + :: + ++ any :: logical OR + ~/ %any + |* b=$-(* ?) + |- ^- ? + ?~ a + | + ?|((b q.n.a) $(a l.a) $(a r.a)) + :: + ++ bif :: splits a by b + ~/ %bif + |* [b=* c=*] + ^+ [l=a r=a] + =< + + |- ^+ a + ?~ a + [[b c] ~ ~] + ?: =(b p.n.a) + ?: =(c q.n.a) + a + a(n [b c]) + ?: (gor b p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + d(r a(l r.d)) + =+ d=$(a r.a) + ?> ?=(^ d) + d(l a(r l.d)) + :: + ++ del :: delete at key b + ~/ %del + |* b=* + |- ^+ a + ?~ a + ~ + ?. =(b p.n.a) + ?: (gor b p.n.a) + a(l $(a l.a)) + a(r $(a r.a)) + |- ^- [$?(~ _a)] + ?~ l.a r.a + ?~ r.a l.a + ?: (mor p.n.l.a p.n.r.a) + l.a(r $(l.a r.l.a)) + r.a(l $(r.a l.r.a)) + :: + ++ dif :: difference + ~/ %dif + |* b=_a + |- ^+ a + ?~ b + a + =+ c=(bif p.n.b q.n.b) + ?> ?=(^ c) + =+ d=$(a l.c, b l.b) + =+ e=$(a r.c, b r.b) + |- ^- [$?(~ _a)] + ?~ d e + ?~ e d + ?: (mor p.n.d p.n.e) + d(r $(d r.d)) + e(l $(e l.e)) + :: + ++ dig :: axis of b key + |= b=* + =+ c=1 + |- ^- (unit @) + ?~ a ~ + ?: =(b p.n.a) [~ u=(peg c 2)] + ?: (gor b p.n.a) + $(a l.a, c (peg c 6)) + $(a r.a, c (peg c 7)) + :: + ++ apt :: check correctness + =< $ + ~/ %apt + =| [l=(unit) r=(unit)] + |. ^- ? + ?~ a & + ?& ?~(l & &((gor p.n.a u.l) !=(p.n.a u.l))) + ?~(r & &((gor u.r p.n.a) !=(u.r p.n.a))) + ?~ l.a & + &((mor p.n.a p.n.l.a) !=(p.n.a p.n.l.a) $(a l.a, l `p.n.a)) + ?~ r.a & + &((mor p.n.a p.n.r.a) !=(p.n.a p.n.r.a) $(a r.a, r `p.n.a)) + == + :: + ++ gas :: concatenate + ~/ %gas + |* b=(list [p=* q=*]) + => .(b `(list _?>(?=(^ a) n.a))`b) + |- ^+ a + ?~ b + a + $(b t.b, a (put p.i.b q.i.b)) + :: + ++ get :: grab value by key + ~/ %get + |* b=* + => .(b `_?>(?=(^ a) p.n.a)`b) + |- ^- (unit _?>(?=(^ a) q.n.a)) + ?~ a + ~ + ?: =(b p.n.a) + (some q.n.a) + ?: (gor b p.n.a) + $(a l.a) + $(a r.a) + :: + ++ got :: need value by key + |* b=* + (need (get b)) + :: + ++ gut :: fall value by key + |* [b=* c=*] + (fall (get b) c) + :: + ++ has :: key existence check + ~/ %has + |* b=* + !=(~ (get b)) + :: + ++ int :: intersection + ~/ %int + |* b=_a + |- ^+ a + ?~ b + ~ + ?~ a + ~ + ?: (mor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + b(l $(a l.a, b l.b), r $(a r.a, b r.b)) + ?: (gor p.n.b p.n.a) + %- uni(a $(a l.a, r.b ~)) $(b r.b) + %- uni(a $(a r.a, l.b ~)) $(b l.b) + ?: =(p.n.a p.n.b) + b(l $(b l.b, a l.a), r $(b r.b, a r.a)) + ?: (gor p.n.a p.n.b) + %- uni(a $(b l.b, r.a ~)) $(a r.a) + %- uni(a $(b r.b, l.a ~)) $(a l.a) + :: + ++ jab + ~/ %jab + |* [key=_?>(?=(^ a) p.n.a) fun=$-(_?>(?=(^ a) q.n.a) _?>(?=(^ a) q.n.a))] + ^+ a + :: + ?~ a !! + :: + ?: =(key p.n.a) + a(q.n (fun q.n.a)) + :: + ?: (gor key p.n.a) + a(l $(a l.a)) + :: + a(r $(a r.a)) + :: + ++ mar :: add with validation + |* [b=* c=(unit *)] + ?~ c + (del b) + (put b u.c) + :: + ++ put :: adds key-value pair + ~/ %put + |* [b=* c=*] + |- ^+ a + ?~ a + [[b c] ~ ~] + ?: =(b p.n.a) + ?: =(c q.n.a) + a + a(n [b c]) + ?: (gor b p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (mor p.n.a p.n.d) + a(l d) + d(r a(l r.d)) + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (mor p.n.a p.n.d) + a(r d) + d(l a(r l.d)) + :: + ++ rep :: reduce to product + ~/ %rep + |* b=_=>(~ |=([* *] +<+)) + |- + ?~ a +<+.b + $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b))) + :: + ++ rib :: transform + product + |* [b=* c=gate] + |- ^+ [b a] + ?~ a [b ~] + =+ d=(c n.a b) + =. n.a +.d + =+ e=$(a l.a, b -.d) + =+ f=$(a r.a, b -.e) + [-.f a(l +.e, r +.f)] + :: + ++ run :: apply gate to values + ~/ %run + |* b=gate + |- + ?~ a a + [n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)] + :: + ++ rut :: apply gate to nodes + |* b=gate + |- + ?~ a a + [n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)] + :: + ++ tap :: listify pairs + =< $ + ~/ %tap + =+ b=`(list _?>(?=(^ a) n.a))`~ + |. ^+ b + ?~ a + b + $(a r.a, b [n.a $(a l.a)]) + :: + ++ uni :: union, merge + ~/ %uni + |* b=_a + |- ^+ a + ?~ b + a + ?~ a + b + ?: =(p.n.b p.n.a) + b(l $(a l.a, b l.b), r $(a r.a, b r.b)) + ?: (mor p.n.a p.n.b) + ?: (gor p.n.b p.n.a) + $(l.a $(a l.a, r.b ~), b r.b) + $(r.a $(a r.a, l.b ~), b l.b) + ?: (gor p.n.a p.n.b) + $(l.b $(b l.b, r.a ~), a r.a) + $(r.b $(b r.b, l.a ~), a l.a) + :: + ++ uno :: general union + |* b=_a + |* meg=$-([* * *] *) + |- ^+ a + ?~ b + a + ?~ a + b + ?: =(p.n.b p.n.a) + :+ [p.n.a `_?>(?=(^ a) q.n.a)`(meg p.n.a q.n.a q.n.b)] + $(b l.b, a l.a) + $(b r.b, a r.a) + ?: (mor p.n.a p.n.b) + ?: (gor p.n.b p.n.a) + $(l.a $(a l.a, r.b ~), b r.b) + $(r.a $(a r.a, l.b ~), b l.b) + ?: (gor p.n.a p.n.b) + $(l.b $(b l.b, r.a ~), a r.a) + $(r.b $(b r.b, l.a ~), a l.a) + :: + ++ urn :: apply gate to nodes + ~/ %urn + |* b=$-([* *] *) + |- + ?~ a ~ + a(n n.a(q (b p.n.a q.n.a)), l $(a l.a), r $(a r.a)) + :: + ++ wyt :: depth of map + =< $ + ~% %wyt + ~ + |. ^- @ + ?~(a 0 +((add $(a l.a) $(a r.a)))) + :: + ++ key :: set of keys + =< $ + ~/ %key + =+ b=`(set _?>(?=(^ a) p.n.a))`~ + |. ^+ b + ?~ a b + $(a r.a, b $(a l.a, b (~(put in b) p.n.a))) + :: + ++ val :: list of vals + =+ b=`(list _?>(?=(^ a) q.n.a))`~ + |- ^+ b + ?~ a b + $(a r.a, b [q.n.a $(a l.a)]) + -- +:: +:: 2j: jar and jug logic ++| %jar-and-jug-logic +++ ja :: jar engine + =| a=(tree (pair * (list))) :: (jar) + |@ + ++ get :: gets list by key + |* b=* + =+ c=(~(get by a) b) + ?~(c ~ u.c) + :: + ++ add :: adds key-list pair + |* [b=* c=*] + =+ d=(get b) + (~(put by a) b [c d]) + -- +++ ju :: jug engine + =| a=(tree (pair * (tree))) :: (jug) + |@ + ++ del :: del key-set pair + |* [b=* c=*] + ^+ a + =+ d=(get b) + =+ e=(~(del in d) c) + ?~ e + (~(del by a) b) + (~(put by a) b e) + :: + ++ gas :: concatenate + |* b=(list [p=* q=*]) + => .(b `(list _?>(?=([[* ^] ^] a) [p=p q=n.q]:n.a))`b) + |- ^+ a + ?~ b + a + $(b t.b, a (put p.i.b q.i.b)) + :: + ++ get :: gets set by key + |* b=* + =+ c=(~(get by a) b) + ?~(c ~ u.c) + :: + ++ has :: existence check + |* [b=* c=*] + ^- ? + (~(has in (get b)) c) + :: + ++ put :: add key-set pair + |* [b=* c=*] + ^+ a + =+ d=(get b) + (~(put by a) b (~(put in d) c)) + -- +:: +:: 2k: queue logic ++| %queue-logic +:: +++ to :: queue engine + =| a=(tree) :: (qeu) + |@ + ++ apt :: check correctness + |- ^- ? + ?~ a & + ?& ?~(l.a & ?&((mor n.a n.l.a) $(a l.a))) + ?~(r.a & ?&((mor n.a n.r.a) $(a r.a))) + == + :: + ++ bal + |- ^+ a + ?~ a ~ + ?. |(?=(~ l.a) (mor n.a n.l.a)) + $(a l.a(r $(a a(l r.l.a)))) + ?. |(?=(~ r.a) (mor n.a n.r.a)) + $(a r.a(l $(a a(r l.r.a)))) + a + :: + ++ dep :: max depth of queue + |- ^- @ + ?~ a 0 + +((max $(a l.a) $(a r.a))) + :: + ++ gas :: insert list to que + |= b=(list _?>(?=(^ a) n.a)) + |- ^+ a + ?~(b a $(b t.b, a (put i.b))) + :: + ++ get :: head-rest pair + |- ^+ ?>(?=(^ a) [p=n.a q=*(tree _n.a)]) + ?~ a + !! + ?~ r.a + [n.a l.a] + =+ b=$(a r.a) + :- p.b + ?: |(?=(~ q.b) (mor n.a n.q.b)) + a(r q.b) + a(n n.q.b, l a(r l.q.b), r r.q.b) + :: + ++ nip :: removes root + |- ^+ a + ?~ a ~ + ?~ l.a r.a + ?~ r.a l.a + ?: (mor n.l.a n.r.a) + l.a(r $(l.a r.l.a)) + r.a(l $(r.a l.r.a)) + :: + ++ nap :: removes root + ?> ?=(^ a) + ?: =(~ l.a) r.a + =+ b=get(a l.a) + bal(n.a p.b, l.a q.b) + :: + ++ put :: insert new tail + |* b=* + |- ^+ a + ?~ a + [b ~ ~] + bal(l.a $(a l.a)) + :: + ++ tap :: adds list to end + =+ b=`(list _?>(?=(^ a) n.a))`~ + |- ^+ b + =+ 0 :: hack for jet match + ?~ a + b + $(a r.a, b [n.a $(a l.a)]) + :: + ++ top :: produces head + |- ^- (unit _?>(?=(^ a) n.a)) + ?~ a ~ + ?~(r.a [~ n.a] $(a r.a)) + -- +:: +:: 2l: container from container ++| %container-from-container +:: +++ malt :: map from list + |* a=(list) + (molt `(list [p=_-<.a q=_->.a])`a) +:: +++ molt :: map from pair list + |* a=(list (pair)) :: ^- =,(i.-.a (map _p _q)) + (~(gas by `(tree [p=_p.i.-.a q=_q.i.-.a])`~) a) +:: +++ silt :: set from list + |* a=(list) :: ^- (set _i.-.a) + =+ b=*(tree _?>(?=(^ a) i.a)) + (~(gas in b) a) +:: +:: 2m: container from noun ++| %container-from-noun +:: +++ ly :: list from raw noun + le:nl +:: +++ my :: map from raw noun + my:nl +:: +++ sy :: set from raw noun + si:nl +:: +++ nl + |% + :: :: + ++ le :: construct list + |* a=(list) + ^+ =< $ + |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$]) + -- + a + :: :: + ++ my :: construct map + |* a=(list (pair)) + => .(a ^+((le a) a)) + (~(gas by `(map _p.i.-.a _q.i.-.a)`~) a) + :: :: + ++ si :: construct set + |* a=(list) + => .(a ^+((le a) a)) + (~(gas in `(set _i.-.a)`~) a) + :: :: + ++ snag :: index + |* [a=@ b=(list)] + ?~ b + ~_ leaf+"snag-fail" + !! + ?: =(0 a) i.b + $(b t.b, a (dec a)) + :: :: + ++ weld :: concatenate + |* [a=(list) b=(list)] + => .(a ^+((le a) a), b ^+((le b) b)) + =+ 42 + |- + ?~ a b + [i=i.a t=$(a t.a)] + -- +:: 2n: functional hacks ++| %functional-hacks +:: +++ aftr |*(a=$-(* *) |*(b=$-(* *) (pair b a))) :: pair after +++ cork |*([a=$-(* *) b=$-(* *)] (corl b a)) :: compose forward +++ corl :: compose backwards + |* [a=$-(* *) b=$-(* *)] + =< +:|.((a (b))) :: type check + |* c=_+<.b + (a (b c)) +:: +++ cury :: curry left + |* [a=$-(^ *) b=*] + |* c=_+<+.a + (a b c) +:: +++ curr :: curry right + |* [a=$-(^ *) c=*] + |* b=_+<+.a + (a b c) +:: +++ fore |*(a=$-(* *) |*(b=$-(* *) (pair a b))) :: pair before +:: +++ head |*(^ ,:+<-) :: get head +++ same |*(* +<) :: identity +:: +++ succ |=(@ +(+<)) :: successor +:: +++ tail |*(^ ,:+<+) :: get tail +++ test |=(^ =(+<- +<+)) :: equality +:: +++ lead |*(* |*(* [+>+< +<])) :: put head +++ late |*(* |*(* [+< +>+<])) :: put tail +:: +:: 2o: containers ++| %containers +++ jar |$ [key value] (map key (list value)) :: map of lists +++ jug |$ [key value] (map key (set value)) :: map of sets +:: +++ map + |$ [key value] :: table + $| (tree (pair key value)) + |=(a=(tree (pair)) ?:(=(~ a) & ~(apt by a))) +:: +++ qeu + |$ [item] :: queue + $| (tree item) + |=(a=(tree) ?:(=(~ a) & ~(apt to a))) +:: +++ set + |$ [item] :: set + $| (tree item) + |=(a=(tree) ?:(=(~ a) & ~(apt in a))) +:: +:: 2p: serialization ++| %serialization +:: +++ cue :: unpack + ~/ %cue + |= a=@ + ^- * + =+ b=0 + =+ m=`(map @ *)`~ + =< q + |- ^- [p=@ q=* r=(map @ *)] + ?: =(0 (cut 0 [b 1] a)) + =+ c=(rub +(b) a) + [+(p.c) q.c (~(put by m) b q.c)] + =+ c=(add 2 b) + ?: =(0 (cut 0 [+(b) 1] a)) + =+ u=$(b c) + =+ v=$(b (add p.u c), m r.u) + =+ w=[q.u q.v] + [(add 2 (add p.u p.v)) w (~(put by r.v) b w)] + =+ d=(rub c a) + [(add 2 p.d) (need (~(get by m) q.d)) m] +:: +++ jam :: pack + ~/ %jam + |= a=* + ^- @ + =+ b=0 + =+ m=`(map * @)`~ + =< q + |- ^- [p=@ q=@ r=(map * @)] + =+ c=(~(get by m) a) + ?~ c + => .(m (~(put by m) a b)) + ?: ?=(@ a) + =+ d=(mat a) + [(add 1 p.d) (lsh 0 q.d) m] + => .(b (add 2 b)) + =+ d=$(a -.a) + =+ e=$(a +.a, b (add b p.d), m r.d) + [(add 2 (add p.d p.e)) (mix 1 (lsh [0 2] (cat 0 q.d q.e))) r.e] + ?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c))) + =+ d=(mat a) + [(add 1 p.d) (lsh 0 q.d) m] + =+ d=(mat u.c) + [(add 2 p.d) (mix 3 (lsh [0 2] q.d)) m] +:: +++ mat :: length-encode + ~/ %mat + |= a=@ + ^- [p=@ q=@] + ?: =(0 a) + [1 1] + =+ b=(met 0 a) + =+ c=(met 0 b) + :- (add (add c c) b) + (cat 0 (bex c) (mix (end [0 (dec c)] b) (lsh [0 (dec c)] a))) +:: +++ rub :: length-decode + ~/ %rub + |= [a=@ b=@] + ^- [p=@ q=@] + =+ ^= c + =+ [c=0 m=(met 0 b)] + |- ?< (gth c m) + ?. =(0 (cut 0 [(add a c) 1] b)) + c + $(c +(c)) + ?: =(0 c) + [1 0] + =+ d=(add a +(c)) + =+ e=(add (bex (dec c)) (cut 0 [d (dec c)] b)) + [(add (add c c) e) (cut 0 [(add d (dec c)) e] b)] +:: +++ fn :: float, infinity, or NaN + :: + :: s=sign, e=exponent, a=arithmetic form + :: (-1)^s * a * 2^e + $% [%f s=? e=@s a=@u] + [%i s=?] + [%n ~] + == +:: +++ dn :: decimal float, infinity, or NaN + :: + :: (-1)^s * a * 10^e + $% [%d s=? e=@s a=@u] + [%i s=?] + [%n ~] + == +:: +++ rn :: parsed decimal float + :: + $% [%d a=? b=[c=@ [d=@ e=@] f=? i=@]] + [%i a=?] + [%n ~] + == +:: +:: 2q: molds and mold builders ++| %molds-and-mold-builders +:: ++$ axis @ :: tree address ++$ bean ? :: 0=&=yes, 1=|=no ++$ flag ? ++$ char @t :: UTF8 byte ++$ cord @t :: UTF8, LSB first ++$ byts [wid=@ud dat=@] :: bytes, MSB first ++$ date [[a=? y=@ud] m=@ud t=tarp] :: parsed date ++$ knot @ta :: ASCII text ++$ noun * :: any noun ++$ path (list knot) :: like unix path ++$ pith (list iota) :: typed urbit path ++$ stud :: standard name + $@ mark=@tas :: auth=urbit + $: auth=@tas :: standards authority + type=path :: standard label + == :: ++$ tang (list tank) :: bottom-first error +:: :: ++$ iota :: typed path segment + $~ [%n ~] + $@ @tas + $% [%ub @ub] [%uc @uc] [%ud @ud] [%ui @ui] + [%ux @ux] [%uv @uv] [%uw @uw] + [%sb @sb] [%sc @sc] [%sd @sd] [%si @si] + [%sx @sx] [%sv @sv] [%sw @sw] + [%da @da] [%dr @dr] + [%f ?] [%n ~] + [%if @if] [%is @is] + [%t @t] [%ta @ta] :: @tas + [%p @p] [%q @q] + [%rs @rs] [%rd @rd] [%rh @rh] [%rq @rq] + == +:: +:: $tank: formatted print tree +:: +:: just a cord, or +:: %leaf: just a tape +:: %palm: backstep list +:: flat-mid, open, flat-open, flat-close +:: %rose: flat list +:: flat-mid, open, close +:: ++$ tank + $~ leaf/~ + $@ cord + $% [%leaf p=tape] + [%palm p=(qual tape tape tape tape) q=(list tank)] + [%rose p=(trel tape tape tape) q=(list tank)] + == +:: ++$ tape (list @tD) :: utf8 string as list ++$ tour (list @c) :: utf32 clusters ++$ tarp [d=@ud h=@ud m=@ud s=@ud f=(list @ux)] :: parsed time ++$ term @tas :: ascii symbol ++$ wain (list cord) :: text lines ++$ wall (list tape) :: text lines +:: +-- => +:: :: +~% %tri + + == + %year year + %yore yore + %ob ob + == +:: layer-3 +:: +|% +:: 3a: signed and modular ints ++| %signed-and-modular-ints +:: +++ egcd :: schneier's egcd + |= [a=@ b=@] + =+ si + =+ [c=(sun a) d=(sun b)] + =+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]] + |- ^- [d=@ u=@s v=@s] + ?: =(--0 c) + [(abs d) d.u d.v] + :: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v))) + :: =(d (sum (pro (sun a) d.u) (pro (sun b) d.v))) + :: == + =+ q=(fra d c) + %= $ + c (dif d (pro q c)) + d c + u [(dif d.u (pro q c.u)) c.u] + v [(dif d.v (pro q c.v)) c.v] + == +:: +++ fo :: modulo prime + ^| + |_ a=@ + ++ dif + |= [b=@ c=@] + (sit (sub (add a b) (sit c))) + :: + ++ exp + |= [b=@ c=@] + ?: =(0 b) + 1 + =+ d=$(b (rsh 0 b)) + =+ e=(pro d d) + ?:(=(0 (end 0 b)) e (pro c e)) + :: + ++ fra + |= [b=@ c=@] + (pro b (inv c)) + :: + ++ inv + |= b=@ + =+ c=(dul:si u:(egcd b a) a) + c + :: + ++ pro + |= [b=@ c=@] + (sit (mul b c)) + :: + ++ sit + |= b=@ + (mod b a) + :: + ++ sum + |= [b=@ c=@] + (sit (add b c)) + -- +:: +++ si :: signed integer + ^? + |% + ++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value + ++ dif |= [a=@s b=@s] :: subtraction + (sum a (new !(syn b) (abs b))) + ++ dul |= [a=@s b=@] :: modulus + =+(c=(old a) ?:(-.c (mod +.c b) (sub b +.c))) + ++ fra |= [a=@s b=@s] :: divide + (new =(0 (mix (syn a) (syn b))) (div (abs a) (abs b))) + ++ new |= [a=? b=@] :: [sign value] to @s + `@s`?:(a (mul 2 b) ?:(=(0 b) 0 +((mul 2 (dec b))))) + ++ old |=(a=@s [(syn a) (abs a)]) :: [sign value] + ++ pro |= [a=@s b=@s] :: multiplication + (new =(0 (mix (syn a) (syn b))) (mul (abs a) (abs b))) + ++ rem |=([a=@s b=@s] (dif a (pro b (fra a b)))) :: remainder + ++ sum |= [a=@s b=@s] :: addition + =+ [c=(old a) d=(old b)] + ?: -.c + ?: -.d + (new & (add +.c +.d)) + ?: (gte +.c +.d) + (new & (sub +.c +.d)) + (new | (sub +.d +.c)) + ?: -.d + ?: (gte +.c +.d) + (new | (sub +.c +.d)) + (new & (sub +.d +.c)) + (new | (add +.c +.d)) + ++ sun |=(a=@u (mul 2 a)) :: @u to @s + ++ syn |=(a=@s =(0 (end 0 a))) :: sign test + ++ cmp |= [a=@s b=@s] :: compare + ^- @s + ?: =(a b) + --0 + ?: (syn a) + ?: (syn b) + ?: (gth a b) + --1 + -1 + --1 + ?: (syn b) + -1 + ?: (gth a b) + -1 + --1 + -- +:: +:: 3b: floating point ++| %floating-point +:: +++ fl :: arb. precision fp + =/ [[p=@u v=@s w=@u] r=$?(%n %u %d %z %a) d=$?(%d %f %i)] + [[113 -16.494 32.765] %n %d] + :: p=precision: number of bits in arithmetic form; must be at least 2 + :: v=min exponent: minimum value of e + :: w=width: max - min value of e, 0 is fixed point + :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero + :: d=behavior: return denormals, flush denormals to zero, + :: infinite exponent range + => + ~% %cofl +> ~ + :: cofl + :: + :: internal functions; mostly operating on [e=@s a=@u], in other words + :: positive numbers. many of these error out if a=0. + |% + ++ rou + |= [a=[e=@s a=@u]] ^- fn (rau a &) + :: + ++ rau + |= [a=[e=@s a=@u] t=?] ^- fn + ?- r + %z (lug %fl a t) %d (lug %fl a t) + %a (lug %ce a t) %u (lug %ce a t) + %n (lug %ne a t) + == + :: + ++ add :: add; exact if e + |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn + =+ q=(dif:si e.a e.b) + |- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp + ?: e + [%f & e.b (^add (lsh [0 (abs:si q)] a.a) a.b)] + =+ [ma=(met 0 a.a) mb=(met 0 a.b)] + =+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a + ?: (gth prc ma) (^sub prc ma) 0 + =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b + ?: =((cmp:si w x) --1) :: don't need to add + ?- r + %z (lug %fl a &) %d (lug %fl a &) + %a (lug %lg a &) %u (lug %lg a &) + %n (lug %na a &) + == + (rou [e.b (^add (lsh [0 (abs:si q)] a.a) a.b)]) + :: + ++ sub :: subtract; exact if e + |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn + =+ q=(dif:si e.a e.b) + |- ?. (syn:si q) + (fli $(b a, a b, q +(q), r swr)) + =+ [ma=(met 0 a.a) mb=(met 0 a.b)] + =+ ^= w %+ dif:si e.a %- sun:si + ?: (gth prc ma) (^sub prc ma) 0 + =+ ^= x %+ sum:si e.b (sun:si +(mb)) + ?: &(!e =((cmp:si w x) --1)) + ?- r + %z (lug %sm a &) %d (lug %sm a &) + %a (lug %ce a &) %u (lug %ce a &) + %n (lug %nt a &) + == + =+ j=(lsh [0 (abs:si q)] a.a) + |- ?. (gte j a.b) + (fli $(a.b j, j a.b, r swr)) + =+ i=(^sub j a.b) + ?~ i [%f & zer] + ?: e [%f & e.b i] (rou [e.b i]) + :: + ++ mul :: multiply + |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn + (rou (sum:si e.a e.b) (^mul a.a a.b)) + :: + ++ div :: divide + |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn + =+ [ma=(met 0 a.a) mb=(met 0 a.b)] + =+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc)))) + =. a ?: (syn:si v) a + a(e (sum:si v e.a), a (lsh [0 (abs:si v)] a.a)) + =+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)] + (rau [j p.q] =(q.q 0)) + :: + ++ sqt :: square root + |= [a=[e=@s a=@u]] ^- fn + =. a + =+ [w=(met 0 a.a) x=(^mul +(prc) 2)] + =+ ?:((^lth w x) (^sub x w) 0) + =+ ?: =((dis - 1) (dis (abs:si e.a) 1)) - + (^add - 1) + a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a)) + =+ [y=(^sqt a.a) z=(fra:si e.a --2)] + (rau [z p.y] =(q.y 0)) + :: + ++ lth :: less-than + |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? + ?: =(e.a e.b) (^lth a.a a.b) + =+ c=(cmp:si (ibl a) (ibl b)) + ?: =(c -1) & ?: =(c --1) | + ?: =((cmp:si e.a e.b) -1) + (^lth (rsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b) + (^lth (lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b) + :: + ++ equ :: equals + |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? + ?. =((ibl a) (ibl b)) | + ?: =((cmp:si e.a e.b) -1) + =((lsh [0 (abs:si (dif:si e.a e.b))] a.b) a.a) + =((lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b) + :: + :: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1) + ++ ibl + |= [a=[e=@s a=@u]] ^- @s + (sum:si (sun:si (dec (met 0 a.a))) e.a) + :: + :: +uni + :: + :: change to a representation where a.a is odd + :: every fn has a unique representation of this kind + ++ uni + |= [a=[e=@s a=@u]] + |- ?: =((end 0 a.a) 1) a + $(a.a (rsh 0 a.a), e.a (sum:si e.a --1)) + :: + :: +xpd: expands to either full precision or to denormalized + ++ xpd + |= [a=[e=@s a=@u]] + =+ ma=(met 0 a.a) + ?: (gte ma prc) a + =+ ?: =(den %i) (^sub prc ma) + =+ ^= q + =+ w=(dif:si e.a emn) + ?: (syn:si w) (abs:si w) 0 + (min q (^sub prc ma)) + a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a)) + :: + :: +lug: central rounding mechanism + :: + :: can perform: floor, ceiling, smaller, larger, + :: nearest (round ties to: even, away from 0, toward 0) + :: s is sticky bit: represents a value less than ulp(a) = 2^(e.a) + :: + ++ lug + ~/ %lug + |= [t=$?(%fl %ce %sm %lg %ne %na %nt) a=[e=@s a=@u] s=?] ^- fn + ?< =(a.a 0) + =- + ?. =(den %f) - :: flush denormals + ?. ?=([%f *] -) - + ?: =((met 0 ->+>) prc) - [%f & zer] + :: + =+ m=(met 0 a.a) + ?> |(s (gth m prc)) :: require precision + =+ ^= q %+ max + ?: (gth m prc) (^sub m prc) 0 :: reduce precision + %- abs:si ?: =(den %i) --0 :: enforce min. exp + ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0 + =^ b a :- (end [0 q] a.a) + a(e (sum:si e.a (sun:si q)), a (rsh [0 q] a.a)) + :: + ?~ a.a + ?< =(den %i) + ?- t + %fl [%f & zer] + %sm [%f & zer] + %ce [%f & spd] + %lg [%f & spd] + %ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)] + [%f & ?:((^lth b (bex (dec q))) zer spd)] + %nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)] + [%f & ?:((^lth b (bex (dec q))) zer spd)] + %na [%f & ?:((^lth b (bex (dec q))) zer spd)] + == + :: + =. a (xpd a) + :: + =. a + ?- t + %fl a + %lg a(a +(a.a)) + %sm ?. &(=(b 0) s) a + ?: &(=(e.a emn) !=(den %i)) a(a (dec a.a)) + =+ y=(dec (^mul a.a 2)) + ?. (lte (met 0 y) prc) a(a (dec a.a)) + [(dif:si e.a --1) y] + %ce ?: &(=(b 0) s) a a(a +(a.a)) + %ne ?~ b a + =+ y=(bex (dec q)) + ?: &(=(b y) s) :: round halfs to even + ?~ (dis a.a 1) a a(a +(a.a)) + ?: (^lth b y) a a(a +(a.a)) + %na ?~ b a + =+ y=(bex (dec q)) + ?: (^lth b y) a a(a +(a.a)) + %nt ?~ b a + =+ y=(bex (dec q)) + ?: =(b y) ?: s a a(a +(a.a)) + ?: (^lth b y) a a(a +(a.a)) + == + :: + =. a ?. =((met 0 a.a) +(prc)) a + a(a (rsh 0 a.a), e (sum:si e.a --1)) + ?~ a.a [%f & zer] + :: + ?: =(den %i) [%f & a] + ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp + :: + ++ drg :: dragon4; get + ~/ %drg :: printable decimal; + |= [a=[e=@s a=@u]] ^- [@s @u] :: guaranteed accurate + ?< =(a.a 0) :: for rounded floats + =. a (xpd a) + =+ r=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] a.a) + =+ s=(lsh [0 ?.((syn:si e.a) (abs:si e.a) 0)] 1) + =+ mn=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] 1) + =+ mp=mn + => ?. + ?& =(a.a (bex (dec prc))) :: if next smallest + |(!=(e.a emn) =(den %i)) :: float is half ULP, + == :: tighten lower bound + . + %= . + mp (lsh 0 mp) + r (lsh 0 r) + s (lsh 0 s) + == + =+ [k=--0 q=(^div (^add s 9) 10)] + |- ?: (^lth r q) + %= $ + k (dif:si k --1) + r (^mul r 10) + mn (^mul mn 10) + mp (^mul mp 10) + == + |- ?: (gte (^add (^mul r 2) mp) (^mul s 2)) + $(s (^mul s 10), k (sum:si k --1)) + =+ [u=0 o=0] + |- :: r/s+o = a*10^-k + =+ v=(dvr (^mul r 10) s) + => %= . + k (dif:si k --1) + u p.v + r q.v + mn (^mul mn 10) + mp (^mul mp 10) + == + =+ l=(^lth (^mul r 2) mn) :: in lower bound + =+ ^= h :: in upper bound + ?| (^lth (^mul s 2) mp) + (gth (^mul r 2) (^sub (^mul s 2) mp)) + == + ?: &(!l !h) + $(o (^add (^mul o 10) u)) + =+ q=&(h |(!l (gth (^mul r 2) s))) + =. o (^add (^mul o 10) ?:(q +(u) u)) + [k o] + :: + ++ toj :: round to integer + |= [a=[e=@s a=@u]] ^- fn + ?. =((cmp:si e.a --0) -1) [%f & a] + =+ x=(abs:si e.a) + =+ y=(rsh [0 x] a.a) + ?: |(=(r %d) =(r %z)) [%f & --0 y] + =+ z=(end [0 x] a.a) + ?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))] + =+ i=(bex (dec x)) + ?: &(=(z i) =((dis y 1) 0)) [%f & --0 y] + ?: (^lth z i) [%f & --0 y] [%f & --0 +(y)] + :: + ++ ned :: require ?=([%f *] a) + |= [a=fn] ^- [%f s=? e=@s a=@u] + ?: ?=([%f *] a) a + ~_ leaf+"need-float" + !! + :: + ++ shf :: a * 2^b; no rounding + |= [a=fn b=@s] + ?: |(?=([%n *] a) ?=([%i *] a)) a + a(e (sum:si e.a b)) + :: + ++ fli :: flip sign + |= [a=fn] ^- fn + ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a) + :: + ++ swr ?+(r r %d %u, %u %d) :: flipped rounding + ++ prc ?>((gth p 1) p) :: force >= 2 precision + ++ den d :: denorm+flush+inf exp + ++ emn v :: minimum exponent + ++ emx (sum:si emn (sun:si w)) :: maximum exponent + ++ spd [e=emn a=1] :: smallest denormal + ++ spn [e=emn a=(bex (dec prc))] :: smallest normal + ++ lfn [e=emx a=(fil 0 prc 1)] :: largest + ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all + ++ zer [e=--0 a=0] + -- + |% + ++ rou :: round + |= [a=fn] ^- fn + ?. ?=([%f *] a) a + ?~ a.a [%f s.a zer] + ?: s.a (^rou +>.a) + =.(r swr (fli (^rou +>.a))) + :: + ++ syn :: get sign + |= [a=fn] ^- ? + ?-(-.a %f s.a, %i s.a, %n &) + :: + ++ abs :: absolute value + |= [a=fn] ^- fn + ?: ?=([%f *] a) [%f & e.a a.a] + ?: ?=([%i *] a) [%i &] [%n ~] + :: + ++ add :: add + |= [a=fn b=fn] ^- fn + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: |(?=([%i *] a) ?=([%i *] b)) + ?: &(?=([%i *] a) ?=([%i *] b)) + ?: =(a b) a [%n ~] + ?: ?=([%i *] a) a b + ?: |(=(a.a 0) =(a.b 0)) + ?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a) + [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer] + %- |= [a=fn] + ?. ?=([%f *] a) a + ?. =(a.a 0) a + [%f !=(r %d) zer] + ?: =(s.a s.b) + ?: s.a (^add +>.a +>.b |) + =.(r swr (fli (^add +>.a +>.b |))) + ?: s.a (^sub +>.a +>.b |) + (^sub +>.b +>.a |) + :: + ++ ead :: exact add + |= [a=fn b=fn] ^- fn + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: |(?=([%i *] a) ?=([%i *] b)) + ?: &(?=([%i *] a) ?=([%i *] b)) + ?: =(a b) a [%n ~] + ?: ?=([%i *] a) a b + ?: |(=(a.a 0) =(a.b 0)) + ?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a) + [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer] + %- |= [a=fn] + ?. ?=([%f *] a) a + ?. =(a.a 0) a + [%f !=(r %d) zer] + ?: =(s.a s.b) + ?: s.a (^add +>.a +>.b &) + (fli (^add +>.a +>.b &)) + ?: s.a (^sub +>.a +>.b &) + (^sub +>.b +>.a &) + :: + ++ sub :: subtract + |= [a=fn b=fn] ^- fn (add a (fli b)) + :: + ++ mul :: multiply + |= [a=fn b=fn] ^- fn + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: ?=([%i *] a) + ?: ?=([%i *] b) + [%i =(s.a s.b)] + ?: =(a.b 0) [%n ~] [%i =(s.a s.b)] + ?: ?=([%i *] b) + ?: =(a.a 0) [%n ~] [%i =(s.a s.b)] + ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer] + ?: =(s.a s.b) (^mul +>.a +>.b) + =.(r swr (fli (^mul +>.a +>.b))) + :: + ++ emu :: exact multiply + |= [a=fn b=fn] ^- fn + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: ?=([%i *] a) + ?: ?=([%i *] b) + [%i =(s.a s.b)] + ?: =(a.b 0) [%n ~] [%i =(s.a s.b)] + ?: ?=([%i *] b) + ?: =(a.a 0) [%n ~] [%i =(s.a s.b)] + ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer] + [%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)] + :: + ++ div :: divide + |= [a=fn b=fn] ^- fn + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: ?=([%i *] a) + ?: ?=([%i *] b) [%n ~] [%i =(s.a s.b)] + ?: ?=([%i *] b) [%f =(s.a s.b) zer] + ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer] + ?: =(a.b 0) [%i =(s.a s.b)] + ?: =(s.a s.b) (^div +>.a +>.b) + =.(r swr (fli (^div +>.a +>.b))) + :: + ++ fma :: fused multiply-add + |= [a=fn b=fn c=fn] ^- fn :: (a * b) + c + (add (emu a b) c) + :: + ++ sqt :: square root + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) ?:(s.a a [%n ~]) + ?~ a.a [%f s.a zer] + ?: s.a (^sqt +>.a) [%n ~] + :: + ++ inv :: inverse + |= [a=fn] ^- fn + (div [%f & --0 1] a) + :: + ++ sun :: uns integer to float + |= [a=@u] ^- fn + (rou [%f & --0 a]) + :: + ++ san :: sgn integer to float + |= [a=@s] ^- fn + =+ b=(old:si a) + (rou [%f -.b --0 +.b]) + :: + ++ lth :: less-than + :: comparisons return ~ in the event of a NaN + |= [a=fn b=fn] ^- (unit ?) + ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~ + ?: =(a b) | + ?: ?=([%i *] a) !s.a ?: ?=([%i *] b) s.b + ?: |(=(a.a 0) =(a.b 0)) + ?: &(=(a.a 0) =(a.b 0)) | + ?: =(a.a 0) s.b !s.a + ?: !=(s.a s.b) s.b + ?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a) + :: + ++ lte :: less-equal + |= [a=fn b=fn] ^- (unit ?) + %+ bind (lth b a) |= a=? !a + :: + ++ equ :: equal + |= [a=fn b=fn] ^- (unit ?) + ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~ + ?: =(a b) & + ?: |(?=([%i *] a) ?=([%i *] b)) | + ?: |(=(a.a 0) =(a.b 0)) + ?: &(=(a.a 0) =(a.b 0)) & | + ?: |(=(e.a e.b) !=(s.a s.b)) | + (^equ +>.a +>.b) + :: + ++ gte :: greater-equal + |= [a=fn b=fn] ^- (unit ?) (lte b a) + :: + ++ gth :: greater-than + |= [a=fn b=fn] ^- (unit ?) (lth b a) + :: + ++ drg :: float to decimal + |= [a=fn] ^- dn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%i s.a] + ?~ a.a [%d s.a --0 0] + [%d s.a (^drg +>.a)] + :: + ++ grd :: decimal to float + |= [a=dn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%i s.a] + => .(r %n) + =+ q=(abs:si e.a) + ?: (syn:si e.a) + (mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)]) + (div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)]) + :: + ++ toi :: round to integer @s + |= [a=fn] ^- (unit @s) + =+ b=(toj a) + ?. ?=([%f *] b) ~ :- ~ + =+ c=(^^mul (bex (abs:si e.b)) a.b) + (new:si s.b c) + :: + ++ toj :: round to integer fn + |= [a=fn] ^- fn + ?. ?=([%f *] a) a + ?~ a.a [%f s.a zer] + ?: s.a (^toj +>.a) + =.(r swr (fli (^toj +>.a))) + -- +:: +ff +:: +:: this core has no use outside of the functionality +:: provided to ++rd, ++rs, ++rq, and ++rh +:: +:: w=width: bits in exponent field +:: p=precision: bits in fraction field +:: b=bias: added to exponent when storing +:: r=rounding mode: same as in ++fl +++ ff :: ieee 754 format fp + |_ [[w=@u p=@u b=@s] r=$?(%n %u %d %z %a)] + :: + ++ sb (bex (^add w p)) :: sign bit + ++ me (dif:si (dif:si --1 b) (sun:si p)) :: minimum exponent + :: + ++ pa + %*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r) + :: + ++ sea :: @r to fn + |= [a=@r] ^- fn + =+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)] + =+ s=(sig a) + ?: =(e 0) + ?: =(f 0) [%f s --0 0] [%f s me f] + ?: =(e (fil 0 w 1)) + ?: =(f 0) [%i s] [%n ~] + =+ q=:(sum:si (sun:si e) me -1) + =+ r=(^add f (bex p)) + [%f s q r] + :: + ++ bit |= [a=fn] (bif (rou:pa a)) :: fn to @r w+ rounding + :: + ++ bif :: fn to @r no rounding + |= [a=fn] ^- @r + ?: ?=([%i *] a) + =+ q=(lsh [0 p] (fil 0 w 1)) + ?: s.a q (^add q sb) + ?: ?=([%n *] a) (lsh [0 (dec p)] (fil 0 +(w) 1)) + ?~ a.a ?: s.a `@r`0 sb + =+ ma=(met 0 a.a) + ?. =(ma +(p)) + ?> =(e.a me) + ?> (^lth ma +(p)) + ?: s.a `@r`a.a (^add a.a sb) + =+ q=(sum:si (dif:si e.a me) --1) + =+ r=(^add (lsh [0 p] (abs:si q)) (end [0 p] a.a)) + ?: s.a r (^add r sb) + :: + ++ sig :: get sign + |= [a=@r] ^- ? + =(0 (cut 0 [(^add p w) 1] a)) + :: + ++ exp :: get exponent + |= [a=@r] ^- @s + (dif:si (sun:si (cut 0 [p w] a)) b) + :: + ++ add :: add + |= [a=@r b=@r] + (bif (add:pa (sea a) (sea b))) + :: + ++ sub :: subtract + |= [a=@r b=@r] + (bif (sub:pa (sea a) (sea b))) + :: + ++ mul :: multiply + |= [a=@r b=@r] + (bif (mul:pa (sea a) (sea b))) + :: + ++ div :: divide + |= [a=@r b=@r] + (bif (div:pa (sea a) (sea b))) + :: + ++ fma :: fused multiply-add + |= [a=@r b=@r c=@r] + (bif (fma:pa (sea a) (sea b) (sea c))) + :: + ++ sqt :: square root + |= [a=@r] + (bif (sqt:pa (sea a))) + :: + ++ lth :: less-than + |= [a=@r b=@r] (fall (lth:pa (sea a) (sea b)) |) + ++ lte :: less-equals + |= [a=@r b=@r] (fall (lte:pa (sea a) (sea b)) |) + ++ equ :: equals + |= [a=@r b=@r] (fall (equ:pa (sea a) (sea b)) |) + ++ gte :: greater-equals + |= [a=@r b=@r] (fall (gte:pa (sea a) (sea b)) |) + ++ gth :: greater-than + |= [a=@r b=@r] (fall (gth:pa (sea a) (sea b)) |) + ++ sun :: uns integer to @r + |= [a=@u] (bit [%f & --0 a]) + ++ san :: signed integer to @r + |= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)]) + ++ toi :: round to integer + |= [a=@r] (toi:pa (sea a)) + ++ drg :: @r to decimal float + |= [a=@r] (drg:pa (sea a)) + ++ grd :: decimal float to @r + |= [a=dn] (bif (grd:pa a)) + -- +:: +++ rlyd |= a=@rd ^- dn (drg:rd a) :: prep @rd for print +++ rlys |= a=@rs ^- dn (drg:rs a) :: prep @rs for print +++ rlyh |= a=@rh ^- dn (drg:rh a) :: prep @rh for print +++ rlyq |= a=@rq ^- dn (drg:rq a) :: prep @rq for print +++ ryld |= a=dn ^- @rd (grd:rd a) :: finish parsing @rd +++ ryls |= a=dn ^- @rs (grd:rs a) :: finish parsing @rs +++ rylh |= a=dn ^- @rh (grd:rh a) :: finish parsing @rh +++ rylq |= a=dn ^- @rq (grd:rq a) :: finish parsing @rq +:: +++ rd :: double precision fp + ^| + ~% %rd +> ~ + |_ r=$?(%n %u %d %z) + :: round to nearest, round up, round down, round to zero + :: + ++ ma + %*(. ff w 11, p 52, b --1.023, r r) + :: + ++ sea :: @rd to fn + |= [a=@rd] (sea:ma a) + :: + ++ bit :: fn to @rd + |= [a=fn] ^- @rd (bit:ma a) + :: + ++ add ~/ %add :: add + |= [a=@rd b=@rd] ^- @rd + ~_ leaf+"rd-fail" + (add:ma a b) + :: + ++ sub ~/ %sub :: subtract + |= [a=@rd b=@rd] ^- @rd + ~_ leaf+"rd-fail" + (sub:ma a b) + :: + ++ mul ~/ %mul :: multiply + |= [a=@rd b=@rd] ^- @rd + ~_ leaf+"rd-fail" + (mul:ma a b) + :: + ++ div ~/ %div :: divide + |= [a=@rd b=@rd] ^- @rd + ~_ leaf+"rd-fail" + (div:ma a b) + :: + ++ fma ~/ %fma :: fused multiply-add + |= [a=@rd b=@rd c=@rd] ^- @rd + ~_ leaf+"rd-fail" + (fma:ma a b c) + :: + ++ sqt ~/ %sqt :: square root + |= [a=@rd] ^- @rd ~_ leaf+"rd-fail" + (sqt:ma a) + :: + ++ lth ~/ %lth :: less-than + |= [a=@rd b=@rd] + ~_ leaf+"rd-fail" + (lth:ma a b) + :: + ++ lte ~/ %lte :: less-equals + |= [a=@rd b=@rd] + ~_ leaf+"rd-fail" + (lte:ma a b) + :: + ++ equ ~/ %equ :: equals + |= [a=@rd b=@rd] + ~_ leaf+"rd-fail" + (equ:ma a b) + :: + ++ gte ~/ %gte :: greater-equals + |= [a=@rd b=@rd] + ~_ leaf+"rd-fail" + (gte:ma a b) + :: + ++ gth ~/ %gth :: greater-than + |= [a=@rd b=@rd] + ~_ leaf+"rd-fail" + (gth:ma a b) + :: + ++ sun |= [a=@u] ^- @rd (sun:ma a) :: uns integer to @rd + ++ san |= [a=@s] ^- @rd (san:ma a) :: sgn integer to @rd + ++ sig |= [a=@rd] ^- ? (sig:ma a) :: get sign + ++ exp |= [a=@rd] ^- @s (exp:ma a) :: get exponent + ++ toi |= [a=@rd] ^- (unit @s) (toi:ma a) :: round to integer + ++ drg |= [a=@rd] ^- dn (drg:ma a) :: @rd to decimal float + ++ grd |= [a=dn] ^- @rd (grd:ma a) :: decimal float to @rd + -- +:: +++ rs :: single precision fp + ~% %rs +> ~ + ^| + :: round to nearest, round up, round down, round to zero + |_ r=$?(%n %u %d %z) + :: + ++ ma + %*(. ff w 8, p 23, b --127, r r) + :: + ++ sea :: @rs to fn + |= [a=@rs] (sea:ma a) + :: + ++ bit :: fn to @rs + |= [a=fn] ^- @rs (bit:ma a) + :: + ++ add ~/ %add :: add + |= [a=@rs b=@rs] ^- @rs + ~_ leaf+"rs-fail" + (add:ma a b) + :: + ++ sub ~/ %sub :: subtract + |= [a=@rs b=@rs] ^- @rs + ~_ leaf+"rs-fail" + (sub:ma a b) + :: + ++ mul ~/ %mul :: multiply + |= [a=@rs b=@rs] ^- @rs + ~_ leaf+"rs-fail" + (mul:ma a b) + :: + ++ div ~/ %div :: divide + |= [a=@rs b=@rs] ^- @rs + ~_ leaf+"rs-fail" + (div:ma a b) + :: + ++ fma ~/ %fma :: fused multiply-add + |= [a=@rs b=@rs c=@rs] ^- @rs + ~_ leaf+"rs-fail" + (fma:ma a b c) + :: + ++ sqt ~/ %sqt :: square root + |= [a=@rs] ^- @rs + ~_ leaf+"rs-fail" + (sqt:ma a) + :: + ++ lth ~/ %lth :: less-than + |= [a=@rs b=@rs] + ~_ leaf+"rs-fail" + (lth:ma a b) + :: + ++ lte ~/ %lte :: less-equals + |= [a=@rs b=@rs] + ~_ leaf+"rs-fail" + (lte:ma a b) + :: + ++ equ ~/ %equ :: equals + |= [a=@rs b=@rs] + ~_ leaf+"rs-fail" + (equ:ma a b) + :: + ++ gte ~/ %gte :: greater-equals + |= [a=@rs b=@rs] + ~_ leaf+"rs-fail" + (gte:ma a b) + :: + ++ gth ~/ %gth :: greater-than + |= [a=@rs b=@rs] + ~_ leaf+"rs-fail" + (gth:ma a b) + :: + ++ sun |= [a=@u] ^- @rs (sun:ma a) :: uns integer to @rs + ++ san |= [a=@s] ^- @rs (san:ma a) :: sgn integer to @rs + ++ sig |= [a=@rs] ^- ? (sig:ma a) :: get sign + ++ exp |= [a=@rs] ^- @s (exp:ma a) :: get exponent + ++ toi |= [a=@rs] ^- (unit @s) (toi:ma a) :: round to integer + ++ drg |= [a=@rs] ^- dn (drg:ma a) :: @rs to decimal float + ++ grd |= [a=dn] ^- @rs (grd:ma a) :: decimal float to @rs + -- +:: +++ rq :: quad precision fp + ~% %rq +> ~ + ^| + :: round to nearest, round up, round down, round to zero + |_ r=$?(%n %u %d %z) + :: + ++ ma + %*(. ff w 15, p 112, b --16.383, r r) + :: + ++ sea :: @rq to fn + |= [a=@rq] (sea:ma a) + :: + ++ bit :: fn to @rq + |= [a=fn] ^- @rq (bit:ma a) + :: + ++ add ~/ %add :: add + |= [a=@rq b=@rq] ^- @rq + ~_ leaf+"rq-fail" + (add:ma a b) + :: + ++ sub ~/ %sub :: subtract + |= [a=@rq b=@rq] ^- @rq + ~_ leaf+"rq-fail" + (sub:ma a b) + :: + ++ mul ~/ %mul :: multiply + |= [a=@rq b=@rq] ^- @rq + ~_ leaf+"rq-fail" + (mul:ma a b) + :: + ++ div ~/ %div :: divide + |= [a=@rq b=@rq] ^- @rq + ~_ leaf+"rq-fail" + (div:ma a b) + :: + ++ fma ~/ %fma :: fused multiply-add + |= [a=@rq b=@rq c=@rq] ^- @rq + ~_ leaf+"rq-fail" + (fma:ma a b c) + :: + ++ sqt ~/ %sqt :: square root + |= [a=@rq] ^- @rq + ~_ leaf+"rq-fail" + (sqt:ma a) + :: + ++ lth ~/ %lth :: less-than + |= [a=@rq b=@rq] + ~_ leaf+"rq-fail" + (lth:ma a b) + :: + ++ lte ~/ %lte :: less-equals + |= [a=@rq b=@rq] + ~_ leaf+"rq-fail" + (lte:ma a b) + :: + ++ equ ~/ %equ :: equals + |= [a=@rq b=@rq] + ~_ leaf+"rq-fail" + (equ:ma a b) + :: + ++ gte ~/ %gte :: greater-equals + |= [a=@rq b=@rq] + ~_ leaf+"rq-fail" + (gte:ma a b) + :: + ++ gth ~/ %gth :: greater-than + |= [a=@rq b=@rq] + ~_ leaf+"rq-fail" + (gth:ma a b) + :: + ++ sun |= [a=@u] ^- @rq (sun:ma a) :: uns integer to @rq + ++ san |= [a=@s] ^- @rq (san:ma a) :: sgn integer to @rq + ++ sig |= [a=@rq] ^- ? (sig:ma a) :: get sign + ++ exp |= [a=@rq] ^- @s (exp:ma a) :: get exponent + ++ toi |= [a=@rq] ^- (unit @s) (toi:ma a) :: round to integer + ++ drg |= [a=@rq] ^- dn (drg:ma a) :: @rq to decimal float + ++ grd |= [a=dn] ^- @rq (grd:ma a) :: decimal float to @rq + -- +:: +++ rh :: half precision fp + ~% %rh +> ~ + ^| + :: round to nearest, round up, round down, round to zero + |_ r=$?(%n %u %d %z) + :: + ++ ma + %*(. ff w 5, p 10, b --15, r r) + :: + ++ sea :: @rh to fn + |= [a=@rh] (sea:ma a) + :: + ++ bit :: fn to @rh + |= [a=fn] ^- @rh (bit:ma a) + :: + ++ add ~/ %add :: add + |= [a=@rh b=@rh] ^- @rh + ~_ leaf+"rh-fail" + (add:ma a b) + :: + ++ sub ~/ %sub :: subtract + |= [a=@rh b=@rh] ^- @rh + ~_ leaf+"rh-fail" + (sub:ma a b) + :: + ++ mul ~/ %mul :: multiply + |= [a=@rh b=@rh] ^- @rh + ~_ leaf+"rh-fail" + (mul:ma a b) + :: + ++ div ~/ %div :: divide + |= [a=@rh b=@rh] ^- @rh + ~_ leaf+"rh-fail" + (div:ma a b) + :: + ++ fma ~/ %fma :: fused multiply-add + |= [a=@rh b=@rh c=@rh] ^- @rh + ~_ leaf+"rh-fail" + (fma:ma a b c) + :: + ++ sqt ~/ %sqt :: square root + |= [a=@rh] ^- @rh + ~_ leaf+"rh-fail" + (sqt:ma a) + :: + ++ lth ~/ %lth :: less-than + |= [a=@rh b=@rh] + ~_ leaf+"rh-fail" + (lth:ma a b) + :: + ++ lte ~/ %lte :: less-equals + |= [a=@rh b=@rh] + ~_ leaf+"rh-fail" + (lte:ma a b) + :: + ++ equ ~/ %equ :: equals + |= [a=@rh b=@rh] + ~_ leaf+"rh-fail" + (equ:ma a b) + :: + ++ gte ~/ %gte :: greater-equals + |= [a=@rh b=@rh] + ~_ leaf+"rh-fail" + (gte:ma a b) + :: + ++ gth ~/ %gth :: greater-than + |= [a=@rh b=@rh] + ~_ leaf+"rh-fail" + (gth:ma a b) + :: + ++ tos :: @rh to @rs + |= [a=@rh] (bit:rs (sea a)) + :: + ++ fos :: @rs to @rh + |= [a=@rs] (bit (sea:rs a)) + :: + ++ sun |= [a=@u] ^- @rh (sun:ma a) :: uns integer to @rh + ++ san |= [a=@s] ^- @rh (san:ma a) :: sgn integer to @rh + ++ sig |= [a=@rh] ^- ? (sig:ma a) :: get sign + ++ exp |= [a=@rh] ^- @s (exp:ma a) :: get exponent + ++ toi |= [a=@rh] ^- (unit @s) (toi:ma a) :: round to integer + ++ drg |= [a=@rh] ^- dn (drg:ma a) :: @rh to decimal float + ++ grd |= [a=dn] ^- @rh (grd:ma a) :: decimal float to @rh + -- +:: +:: 3c: urbit time ++| %urbit-time +:: +++ year :: date to @d + |= det=date + ^- @da + =+ ^= yer + ?: a.det + (add 292.277.024.400 y.det) + (sub 292.277.024.400 (dec y.det)) + =+ day=(yawn yer m.det d.t.det) + (yule day h.t.det m.t.det s.t.det f.t.det) +:: +++ yore :: @d to date + |= now=@da + ^- date + =+ rip=(yell now) + =+ ger=(yall d.rip) + :- ?: (gth y.ger 292.277.024.400) + [a=& y=(sub y.ger 292.277.024.400)] + [a=| y=+((sub 292.277.024.400 y.ger))] + [m.ger d.ger h.rip m.rip s.rip f.rip] +:: +++ yell :: tarp from @d + |= now=@d + ^- tarp + =+ sec=(rsh 6 now) + =+ ^= fan + =+ [muc=4 raw=(end 6 now)] + |- ^- (list @ux) + ?: |(=(0 raw) =(0 muc)) + ~ + => .(muc (dec muc)) + [(cut 4 [muc 1] raw) $(raw (end [4 muc] raw))] + =+ day=(div sec day:yo) + => .(sec (mod sec day:yo)) + =+ hor=(div sec hor:yo) + => .(sec (mod sec hor:yo)) + =+ mit=(div sec mit:yo) + => .(sec (mod sec mit:yo)) + [day hor mit sec fan] +:: +++ yule :: time atom + |= rip=tarp + ^- @d + =+ ^= sec ;: add + (mul d.rip day:yo) + (mul h.rip hor:yo) + (mul m.rip mit:yo) + s.rip + == + =+ ^= fac =+ muc=4 + |- ^- @ + ?~ f.rip + 0 + => .(muc (dec muc)) + (add (lsh [4 muc] i.f.rip) $(f.rip t.f.rip)) + (con (lsh 6 sec) fac) +:: +++ yall :: day / to day of year + |= day=@ud + ^- [y=@ud m=@ud d=@ud] + =+ [era=0 cet=0 lep=*?] + => .(era (div day era:yo), day (mod day era:yo)) + => ^+ . + ?: (lth day +(cet:yo)) + .(lep &, cet 0) + => .(lep |, cet 1, day (sub day +(cet:yo))) + .(cet (add cet (div day cet:yo)), day (mod day cet:yo)) + =+ yer=(add (mul 400 era) (mul 100 cet)) + |- ^- [y=@ud m=@ud d=@ud] + =+ dis=?:(lep 366 365) + ?. (lth day dis) + =+ ner=+(yer) + $(yer ner, day (sub day dis), lep =(0 (end [0 2] ner))) + |- ^- [y=@ud m=@ud d=@ud] + =+ [mot=0 cah=?:(lep moy:yo moh:yo)] + |- ^- [y=@ud m=@ud d=@ud] + =+ zis=(snag mot cah) + ?: (lth day zis) + [yer +(mot) +(day)] + $(mot +(mot), day (sub day zis)) +:: +++ yawn :: days since Jesus + |= [yer=@ud mot=@ud day=@ud] + ^- @ud + => .(mot (dec mot), day (dec day)) + => ^+ . + %= . + day + =+ cah=?:((yelp yer) moy:yo moh:yo) + |- ^- @ud + ?: =(0 mot) + day + $(mot (dec mot), cah (slag 1 cah), day (add day (snag 0 cah))) + == + |- ^- @ud + ?. =(0 (mod yer 4)) + =+ ney=(dec yer) + $(yer ney, day (add day ?:((yelp ney) 366 365))) + ?. =(0 (mod yer 100)) + =+ nef=(sub yer 4) + $(yer nef, day (add day ?:((yelp nef) 1.461 1.460))) + ?. =(0 (mod yer 400)) + =+ nec=(sub yer 100) + $(yer nec, day (add day ?:((yelp nec) 36.525 36.524))) + (add day (mul (div yer 400) (add 1 (mul 4 36.524)))) +:: +++ yelp :: leap year + |= yer=@ud ^- ? + &(=(0 (mod yer 4)) |(!=(0 (mod yer 100)) =(0 (mod yer 400)))) +:: +++ yo :: time constants + |% ++ cet 36.524 :: (add 24 (mul 100 365)) + ++ day 86.400 :: (mul 24 hor) + ++ era 146.097 :: (add 1 (mul 4 cet)) + ++ hor 3.600 :: (mul 60 mit) + ++ jes 106.751.991.084.417 :: (mul 730.692.561 era) + ++ mit 60 + ++ moh `(list @ud)`[31 28 31 30 31 30 31 31 30 31 30 31 ~] + ++ moy `(list @ud)`[31 29 31 30 31 30 31 31 30 31 30 31 ~] + ++ qad 126.144.001 :: (add 1 (mul 4 yer)) + ++ yer 31.536.000 :: (mul 365 day) + -- +:: +:: 3d: SHA hash family ++| %sha-hash-family +:: +++ shad |=(ruz=@ (shax (shax ruz))) :: double sha-256 +++ shaf :: half sha-256 + |= [sal=@ ruz=@] + =+ haz=(shas sal ruz) + (mix (end 7 haz) (rsh 7 haz)) +:: +++ sham :: 128bit noun hash + |= yux=* ^- @uvH ^- @ + ?@ yux + (shaf %mash yux) + (shaf %sham (jam yux)) +:: +++ shas :: salted hash + ~/ %shas + |= [sal=@ ruz=@] + (shax (mix sal (shax ruz))) +:: +++ shax :: sha-256 + ~/ %shax + |= ruz=@ ^- @ + (shay [(met 3 ruz) ruz]) +:: +++ shay :: sha-256 with length + ~/ %shay + |= [len=@u ruz=@] ^- @ + => .(ruz (cut 3 [0 len] ruz)) + =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))] + =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few] + =+ ral=(lsh [0 3] len) + =+ ^= ful + %+ can 0 + :~ [ral ruz] + [8 128] + [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0] + [64 (~(net fe 6) ral)] + == + =+ lex=(met 9 ful) + =+ ^= kbx 0xc671.78f2.bef9.a3f7.a450.6ceb.90be.fffa. + 8cc7.0208.84c8.7814.78a5.636f.748f.82ee. + 682e.6ff3.5b9c.ca4f.4ed8.aa4a.391c.0cb3. + 34b0.bcb5.2748.774c.1e37.6c08.19a4.c116. + 106a.a070.f40e.3585.d699.0624.d192.e819. + c76c.51a3.c24b.8b70.a81a.664b.a2bf.e8a1. + 9272.2c85.81c2.c92e.766a.0abb.650a.7354. + 5338.0d13.4d2c.6dfc.2e1b.2138.27b7.0a85. + 1429.2967.06ca.6351.d5a7.9147.c6e0.0bf3. + bf59.7fc7.b003.27c8.a831.c66d.983e.5152. + 76f9.88da.5cb0.a9dc.4a74.84aa.2de9.2c6f. + 240c.a1cc.0fc1.9dc6.efbe.4786.e49b.69c1. + c19b.f174.9bdc.06a7.80de.b1fe.72be.5d74. + 550c.7dc3.2431.85be.1283.5b01.d807.aa98. + ab1c.5ed5.923f.82a4.59f1.11f1.3956.c25b. + e9b5.dba5.b5c0.fbcf.7137.4491.428a.2f98 + =+ ^= hax 0x5be0.cd19.1f83.d9ab.9b05.688c.510e.527f. + a54f.f53a.3c6e.f372.bb67.ae85.6a09.e667 + =+ i=0 + |- ^- @ + ?: =(i lex) + (run 5 hax net) + =+ ^= wox + =+ dux=(cut 9 [i 1] ful) + =+ wox=(run 5 dux net) + =+ j=16 + |- ^- @ + ?: =(64 j) + wox + =+ :* l=(wac (sub j 15) wox) + m=(wac (sub j 2) wox) + n=(wac (sub j 16) wox) + o=(wac (sub j 7) wox) + == + =+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh [0 3] l)) + =+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh [0 10] m)) + =+ z=:(sum n x o y) + $(wox (con (lsh [5 j] z) wox), j +(j)) + =+ j=0 + =+ :* a=(wac 0 hax) + b=(wac 1 hax) + c=(wac 2 hax) + d=(wac 3 hax) + e=(wac 4 hax) + f=(wac 5 hax) + g=(wac 6 hax) + h=(wac 7 hax) + == + |- ^- @ + ?: =(64 j) + %= ^$ + i +(i) + hax %+ rep 5 + :~ (sum a (wac 0 hax)) + (sum b (wac 1 hax)) + (sum c (wac 2 hax)) + (sum d (wac 3 hax)) + (sum e (wac 4 hax)) + (sum f (wac 5 hax)) + (sum g (wac 6 hax)) + (sum h (wac 7 hax)) + == + == + =+ l=:(mix (ror 0 2 a) (ror 0 13 a) (ror 0 22 a)) :: s0 + =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj + =+ n=(sum l m) :: t2 + =+ o=:(mix (ror 0 6 e) (ror 0 11 e) (ror 0 25 e)) :: s1 + =+ p=(mix (dis e f) (dis (inv e) g)) :: ch + =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1 + $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g) +:: +++ shaw :: hash to nbits + |= [sal=@ len=@ ruz=@] + (~(raw og (shas sal (mix len ruz))) len) +:: +++ shaz :: sha-512 + |= ruz=@ ^- @ + (shal [(met 3 ruz) ruz]) +:: +++ shal :: sha-512 with length + ~/ %shal + |= [len=@ ruz=@] ^- @ + => .(ruz (cut 3 [0 len] ruz)) + =+ [few==>(fe .(a 6)) wac=|=([a=@ b=@] (cut 6 [a 1] b))] + =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few] + =+ ral=(lsh [0 3] len) + =+ ^= ful + %+ can 0 + :~ [ral ruz] + [8 128] + [(mod (sub 1.920 (mod (add 8 ral) 1.024)) 1.024) 0] + [128 (~(net fe 7) ral)] + == + =+ lex=(met 10 ful) + =+ ^= kbx 0x6c44.198c.4a47.5817.5fcb.6fab.3ad6.faec. + 597f.299c.fc65.7e2a.4cc5.d4be.cb3e.42b6. + 431d.67c4.9c10.0d4c.3c9e.be0a.15c9.bebc. + 32ca.ab7b.40c7.2493.28db.77f5.2304.7d84. + 1b71.0b35.131c.471b.113f.9804.bef9.0dae. + 0a63.7dc5.a2c8.98a6.06f0.67aa.7217.6fba. + f57d.4f7f.ee6e.d178.eada.7dd6.cde0.eb1e. + d186.b8c7.21c0.c207.ca27.3ece.ea26.619c. + c671.78f2.e372.532b.bef9.a3f7.b2c6.7915. + a450.6ceb.de82.bde9.90be.fffa.2363.1e28. + 8cc7.0208.1a64.39ec.84c8.7814.a1f0.ab72. + 78a5.636f.4317.2f60.748f.82ee.5def.b2fc. + 682e.6ff3.d6b2.b8a3.5b9c.ca4f.7763.e373. + 4ed8.aa4a.e341.8acb.391c.0cb3.c5c9.5a63. + 34b0.bcb5.e19b.48a8.2748.774c.df8e.eb99. + 1e37.6c08.5141.ab53.19a4.c116.b8d2.d0c8. + 106a.a070.32bb.d1b8.f40e.3585.5771.202a. + d699.0624.5565.a910.d192.e819.d6ef.5218. + c76c.51a3.0654.be30.c24b.8b70.d0f8.9791. + a81a.664b.bc42.3001.a2bf.e8a1.4cf1.0364. + 9272.2c85.1482.353b.81c2.c92e.47ed.aee6. + 766a.0abb.3c77.b2a8.650a.7354.8baf.63de. + 5338.0d13.9d95.b3df.4d2c.6dfc.5ac4.2aed. + 2e1b.2138.5c26.c926.27b7.0a85.46d2.2ffc. + 1429.2967.0a0e.6e70.06ca.6351.e003.826f. + d5a7.9147.930a.a725.c6e0.0bf3.3da8.8fc2. + bf59.7fc7.beef.0ee4.b003.27c8.98fb.213f. + a831.c66d.2db4.3210.983e.5152.ee66.dfab. + 76f9.88da.8311.53b5.5cb0.a9dc.bd41.fbd4. + 4a74.84aa.6ea6.e483.2de9.2c6f.592b.0275. + 240c.a1cc.77ac.9c65.0fc1.9dc6.8b8c.d5b5. + efbe.4786.384f.25e3.e49b.69c1.9ef1.4ad2. + c19b.f174.cf69.2694.9bdc.06a7.25c7.1235. + 80de.b1fe.3b16.96b1.72be.5d74.f27b.896f. + 550c.7dc3.d5ff.b4e2.2431.85be.4ee4.b28c. + 1283.5b01.4570.6fbe.d807.aa98.a303.0242. + ab1c.5ed5.da6d.8118.923f.82a4.af19.4f9b. + 59f1.11f1.b605.d019.3956.c25b.f348.b538. + e9b5.dba5.8189.dbbc.b5c0.fbcf.ec4d.3b2f. + 7137.4491.23ef.65cd.428a.2f98.d728.ae22 + =+ ^= hax 0x5be0.cd19.137e.2179.1f83.d9ab.fb41.bd6b. + 9b05.688c.2b3e.6c1f.510e.527f.ade6.82d1. + a54f.f53a.5f1d.36f1.3c6e.f372.fe94.f82b. + bb67.ae85.84ca.a73b.6a09.e667.f3bc.c908 + =+ i=0 + |- ^- @ + ?: =(i lex) + (run 6 hax net) + =+ ^= wox + =+ dux=(cut 10 [i 1] ful) + =+ wox=(run 6 dux net) + =+ j=16 + |- ^- @ + ?: =(80 j) + wox + =+ :* l=(wac (sub j 15) wox) + m=(wac (sub j 2) wox) + n=(wac (sub j 16) wox) + o=(wac (sub j 7) wox) + == + =+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh [0 7] l)) + =+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh [0 6] m)) + =+ z=:(sum n x o y) + $(wox (con (lsh [6 j] z) wox), j +(j)) + =+ j=0 + =+ :* a=(wac 0 hax) + b=(wac 1 hax) + c=(wac 2 hax) + d=(wac 3 hax) + e=(wac 4 hax) + f=(wac 5 hax) + g=(wac 6 hax) + h=(wac 7 hax) + == + |- ^- @ + ?: =(80 j) + %= ^$ + i +(i) + hax %+ rep 6 + :~ (sum a (wac 0 hax)) + (sum b (wac 1 hax)) + (sum c (wac 2 hax)) + (sum d (wac 3 hax)) + (sum e (wac 4 hax)) + (sum f (wac 5 hax)) + (sum g (wac 6 hax)) + (sum h (wac 7 hax)) + == + == + =+ l=:(mix (ror 0 28 a) (ror 0 34 a) (ror 0 39 a)) :: S0 + =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj + =+ n=(sum l m) :: t2 + =+ o=:(mix (ror 0 14 e) (ror 0 18 e) (ror 0 41 e)) :: S1 + =+ p=(mix (dis e f) (dis (inv e) g)) :: ch + =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1 + $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g) +:: +++ shan :: sha-1 (deprecated) + |= ruz=@ + =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))] + =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few] + =+ ral=(lsh [0 3] (met 3 ruz)) + =+ ^= ful + %+ can 0 + :~ [ral ruz] + [8 128] + [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0] + [64 (~(net fe 6) ral)] + == + =+ lex=(met 9 ful) + =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999 + =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301 + =+ i=0 + |- + ?: =(i lex) + (rep 5 (flop (rip 5 hax))) + =+ ^= wox + =+ dux=(cut 9 [i 1] ful) + =+ wox=(rep 5 (turn (rip 5 dux) net)) + =+ j=16 + |- ^- @ + ?: =(80 j) + wox + =+ :* l=(wac (sub j 3) wox) + m=(wac (sub j 8) wox) + n=(wac (sub j 14) wox) + o=(wac (sub j 16) wox) + == + =+ z=(rol 0 1 :(mix l m n o)) + $(wox (con (lsh [5 j] z) wox), j +(j)) + =+ j=0 + =+ :* a=(wac 0 hax) + b=(wac 1 hax) + c=(wac 2 hax) + d=(wac 3 hax) + e=(wac 4 hax) + == + |- ^- @ + ?: =(80 j) + %= ^$ + i +(i) + hax %+ rep 5 + :~ + (sum a (wac 0 hax)) + (sum b (wac 1 hax)) + (sum c (wac 2 hax)) + (sum d (wac 3 hax)) + (sum e (wac 4 hax)) + == + == + =+ fx=(con (dis b c) (dis (not 5 1 b) d)) + =+ fy=:(mix b c d) + =+ fz=:(con (dis b c) (dis b d) (dis c d)) + =+ ^= tem + ?: &((gte j 0) (lte j 19)) + :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox)) + ?: &((gte j 20) (lte j 39)) + :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox)) + ?: &((gte j 40) (lte j 59)) + :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox)) + :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox)) + $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d) +:: +++ og :: shax-powered rng + ~/ %og + |_ a=@ + ++ rad :: random in range + |= b=@ ^- @ + ~_ leaf+"rad-zero" + ?< =(0 b) + =+ c=(raw (met 0 b)) + ?:((lth c b) c $(a +(a))) + :: + ++ rads :: random continuation + |= b=@ + =+ r=(rad b) + [r +>.$(a (shas %og-s (mix a r)))] + :: + ++ raw :: random bits + ~/ %raw + |= b=@ ^- @ + %+ can + 0 + =+ c=(shas %og-a (mix b a)) + |- ^- (list [@ @]) + ?: =(0 b) + ~ + =+ d=(shas %og-b (mix b (mix a c))) + ?: (lth b 256) + [[b (end [0 b] d)] ~] + [[256 d] $(c d, b (sub b 256))] + :: + ++ raws :: random bits + |= b=@ :: continuation + =+ r=(raw b) + [r +>.$(a (shas %og-s (mix a r)))] + -- +:: +++ sha :: correct byte-order + ~% %sha ..sha ~ + => |% + ++ flin |=(a=@ (swp 3 a)) :: flip input + ++ flim |=(byts [wid (rev 3 wid dat)]) :: flip input w= length + ++ flip |=(w=@u (cury (cury rev 3) w)) :: flip output of size + ++ meet |=(a=@ [(met 3 a) a]) :: measure input size + -- + |% + :: + :: use with @ + :: + ++ sha-1 (cork meet sha-1l) + ++ sha-256 :(cork flin shax (flip 32)) + ++ sha-512 :(cork flin shaz (flip 64)) + :: + :: use with byts + :: + ++ sha-256l :(cork flim shay (flip 32)) + ++ sha-512l :(cork flim shal (flip 64)) + :: + ++ sha-1l + ~/ %sha1 + |= byts + ^- @ + =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))] + =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few] + =+ ral=(lsh [0 3] wid) + =+ ^= ful + %+ can 0 + :~ [ral (rev 3 wid dat)] + [8 128] + [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0] + [64 (~(net fe 6) ral)] + == + =+ lex=(met 9 ful) + =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999 + =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301 + =+ i=0 + |- + ?: =(i lex) + (rep 5 (flop (rip 5 hax))) + =+ ^= wox + =+ dux=(cut 9 [i 1] ful) + =+ wox=(rep 5 (turn (rip 5 dux) net)) + =+ j=16 + |- ^- @ + ?: =(80 j) + wox + =+ :* l=(wac (sub j 3) wox) + m=(wac (sub j 8) wox) + n=(wac (sub j 14) wox) + o=(wac (sub j 16) wox) + == + =+ z=(rol 0 1 :(mix l m n o)) + $(wox (con (lsh [5 j] z) wox), j +(j)) + =+ j=0 + =+ :* a=(wac 0 hax) + b=(wac 1 hax) + c=(wac 2 hax) + d=(wac 3 hax) + e=(wac 4 hax) + == + |- ^- @ + ?: =(80 j) + %= ^$ + i +(i) + hax %+ rep 5 + :~ + (sum a (wac 0 hax)) + (sum b (wac 1 hax)) + (sum c (wac 2 hax)) + (sum d (wac 3 hax)) + (sum e (wac 4 hax)) + == + == + =+ fx=(con (dis b c) (dis (not 5 1 b) d)) + =+ fy=:(mix b c d) + =+ fz=:(con (dis b c) (dis b d) (dis c d)) + =+ ^= tem + ?: &((gte j 0) (lte j 19)) + :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox)) + ?: &((gte j 20) (lte j 39)) + :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox)) + ?: &((gte j 40) (lte j 59)) + :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox)) + :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox)) + $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d) + -- +:: 3f: scrambling ++| %scrambling +:: +++ un :: =(x (wred (wren x))) + |% + ++ wren :: conceal structure + |= pyn=@ ^- @ + =+ len=(met 3 pyn) + ?: =(0 len) + 0 + => .(len (dec len)) + =+ mig=(zaft (xafo len (cut 3 [len 1] pyn))) + %+ can 3 + %- flop ^- (list [@ @]) + :- [1 mig] + |- ^- (list [@ @]) + ?: =(0 len) + ~ + => .(len (dec len)) + =+ mog=(zyft :(mix mig (end 3 len) (cut 3 [len 1] pyn))) + [[1 mog] $(mig mog)] + :: + ++ wred :: restore structure + |= cry=@ ^- @ + =+ len=(met 3 cry) + ?: =(0 len) + 0 + => .(len (dec len)) + =+ mig=(cut 3 [len 1] cry) + %+ can 3 + %- flop ^- (list [@ @]) + :- [1 (xaro len (zart mig))] + |- ^- (list [@ @]) + ?: =(0 len) + ~ + => .(len (dec len)) + =+ mog=(cut 3 [len 1] cry) + [[1 :(mix mig (end 3 len) (zyrt mog))] $(mig mog)] + :: + ++ xafo |=([a=@ b=@] +((mod (add (dec b) a) 255))) + ++ xaro |=([a=@ b=@] +((mod (add (dec b) (sub 255 (mod a 255))) 255))) + :: + ++ zaft :: forward 255-sbox + |= a=@D + =+ ^= b + 0xcc.75bc.86c8.2fb1.9a42.f0b3.79a0.92ca.21f6.1e41.cde5.fcc0. + 7e85.51ae.1005.c72d.1246.07e8.7c64.a914.8d69.d9f4.59c2.8038. + 1f4a.dca2.6fdf.66f9.f561.a12e.5a16.f7b0.a39f.364e.cb70.7318. + 1de1.ad31.63d1.abd4.db68.6a33.134d.a760.edee.5434.493a.e323. + 930d.8f3d.3562.bb81.0b24.43cf.bea5.a6eb.52b4.0229.06b2.6704. + 78c9.45ec.d75e.58af.c577.b7b9.c40e.017d.90c3.87f8.96fa.1153. + 0372.7f30.1c32.ac83.ff17.c6e4.d36d.6b55.e2ce.8c71.8a5b.b6f3. + 9d4b.eab5.8b3c.e7f2.a8fe.9574.5de0.bf20.3f15.9784.9939.5f9c. + e609.564f.d8a4.b825.9819.94aa.2c08.8e4c.9b22.477a.2840.3ed6. + 3750.6ef1.44dd.89ef.6576.d00a.fbda.9ed2.3b6c.7b0c.bde9.2ade. + 5c88.c182.481a.1b0f.2bfd.d591.2726.57ba + (cut 3 [(dec a) 1] b) + :: + ++ zart :: reverse 255-sbox + |= a=@D + =+ ^= b + 0x68.4f07.ea1c.73c9.75c2.efc8.d559.5125.f621.a7a8.8591.5613. + dd52.40eb.65a2.60b7.4bcb.1123.ceb0.1bd6.3c84.2906.b164.19b3. + 1e95.5fec.ffbc.f187.fbe2.6680.7c77.d30e.e94a.9414.fd9a.017d. + 3a7e.5a55.8ff5.8bf9.c181.e5b6.6ab2.35da.50aa.9293.3bc0.cdc6. + f3bf.1a58.4130.f844.3846.744e.36a0.f205.789e.32d8.5e54.5c22. + 0f76.fce7.4569.0d99.d26e.e879.dc16.2df4.887f.1ffe.4dba.6f5d. + bbcc.2663.1762.aed7.af8a.ca20.dbb4.9bc7.a942.834c.105b.c4d4. + 8202.3e61.a671.90e6.273d.bdab.3157.cfa4.0c2e.df86.2496.f7ed. + 2b48.2a9d.5318.a343.d128.be9c.a5ad.6bb5.6dfa.c5e1.3408.128d. + 2c04.0339.97a1.2ff0.49d0.eeb8.6c0a.0b37.b967.c347.d9ac.e072. + e409.7b9f.1598.1d3f.33de.8ce3.8970.8e7a + (cut 3 [(dec a) 1] b) + :: + ++ zyft :: forward 256-sbox + |= a=@D + =+ ^= b + 0xbb49.b71f.b881.b402.17e4.6b86.69b5.1647.115f.dddb.7ca5. + 8371.4bd5.19a9.b092.605d.0d9b.e030.a0cc.78ba.5706.4d2d. + 986a.768c.f8e8.c4c7.2f1c.effe.3cae.01c0.253e.65d3.3872. + ce0e.7a74.8ac6.daac.7e5c.6479.44ec.4143.3d20.4af0.ee6c. + c828.deca.0377.249f.ffcd.7b4f.eb7d.66f2.8951.042e.595a. + 8e13.f9c3.a79a.f788.6199.9391.7fab.6200.4ce5.0758.e2f1. + 7594.c945.d218.4248.afa1.e61a.54fb.1482.bea4.96a2.3473. + 63c2.e7cb.155b.120a.4ed7.bfd8.b31b.4008.f329.fca3.5380. + 9556.0cb2.8722.2bea.e96e.3ac5.d1bc.10e3.2c52.a62a.b1d6. + 35aa.d05e.f6a8.0f3b.31ed.559d.09ad.f585.6d21.fd1d.8d67. + 370b.26f4.70c1.b923.4684.6fbd.cf8b.5036.0539.9cdc.d93f. + 9068.1edf.8f33.b632.d427.97fa.9ee1 + (cut 3 [a 1] b) + :: + ++ zyrt :: reverse 256-sbox + |= a=@D + =+ ^= b + 0x9fc8.2753.6e02.8fcf.8b35.2b20.5598.7caa.c9a9.30b0.9b48. + 47ce.6371.80f6.407d.00dd.0aa5.ed10.ecb7.0f5a.5c3a.e605. + c077.4337.17bd.9eda.62a4.79a7.ccb8.44cd.8e64.1ec4.5b6b. + 1842.ffd8.1dfb.fd07.f2f9.594c.3be3.73c6.2cb6.8438.e434. + 8d3d.ea6a.5268.72db.a001.2e11.de8c.88d3.0369.4f7a.87e2. + 860d.0991.25d0.16b9.978a.4bf4.2a1a.e96c.fa50.85b5.9aeb. + 9dbb.b2d9.a2d1.7bba.66be.e81f.1946.29a8.f5d2.f30c.2499. + c1b3.6583.89e1.ee36.e0b4.6092.937e.d74e.2f6f.513e.9615. + 9c5d.d581.e7ab.fe74.f01b.78b1.ae75.af57.0ec2.adc7.3245. + 12bf.2314.3967.0806.31dc.cb94.d43f.493c.54a6.0421.c3a1. + 1c4a.28ac.fc0b.26ca.5870.e576.f7f1.616d.905f.ef41.33bc. + df4d.225e.2d56.7fd6.1395.a3f8.c582 + (cut 3 [a 1] b) + -- +:: +++ ob + ~% %ob ..ob + == + %fein fein + %fynd fynd + == + |% + :: + :: +fein: conceal structure, v3. + :: + :: +fein conceals planet-sized atoms. The idea is that it should not be + :: trivial to tell which planet a star has spawned under. + :: + ++ fein + ~/ %fein + |= pyn=@ ^- @ + ?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff)) + (add 0x1.0000 (feis (sub pyn 0x1.0000))) + ?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff)) + =/ lo (dis pyn 0xffff.ffff) + =/ hi (dis pyn 0xffff.ffff.0000.0000) + %+ con hi + $(pyn lo) + pyn + :: + :: +fynd: restore structure, v3. + :: + :: Restores obfuscated values that have been enciphered with +fein. + :: + ++ fynd + ~/ %fynd + |= cry=@ ^- @ + ?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff)) + (add 0x1.0000 (tail (sub cry 0x1.0000))) + ?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff)) + =/ lo (dis cry 0xffff.ffff) + =/ hi (dis cry 0xffff.ffff.0000.0000) + %+ con hi + $(cry lo) + cry + :: +feis: a four-round generalised Feistel cipher over the domain + :: [0, 2^32 - 2^16 - 1]. + :: + :: See: Black & Rogaway (2002), Ciphers for arbitrary finite domains. + :: + ++ feis + |= m=@ + ^- @ + (fee 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m) + :: + :: +tail: reverse +feis. + :: + ++ tail + |= m=@ + ^- @ + (feen 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m) + :: + :: +fee: "Fe" in B&R (2002). + :: + :: A Feistel cipher given the following parameters: + :: + :: r: number of Feistel rounds + :: a, b: parameters such that ab >= k + :: k: value such that the domain of the cipher is [0, k - 1] + :: prf: a gate denoting a family of pseudorandom functions indexed by + :: its first argument and taking its second argument as input + :: m: an input value in the domain [0, k - 1] + :: + ++ fee + |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@] + ^- @ + =/ c (fe r a b prf m) + ?: (lth c k) + c + (fe r a b prf c) + :: + :: +feen: "Fe^-1" in B&R (2002). + :: + :: Reverses a Feistel cipher constructed with parameters as described in + :: +fee. + :: + ++ feen + |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@] + ^- @ + =/ c (fen r a b prf m) + ?: (lth c k) + c + (fen r a b prf c) + :: + :: +fe: "fe" in B&R (2002). + :: + :: An internal function to +fee. + :: + :: Note that this implementation differs slightly from the reference paper + :: to support some legacy behaviour. See urbit/arvo#1105. + :: + ++ fe + |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@] + =/ j 1 + =/ ell (mod m a) + =/ arr (div m a) + |- ^- @ + :: + ?: (gth j r) + ?. =((mod r 2) 0) + (add (mul arr a) ell) + :: + :: Note that +fe differs from B&R (2002)'s "fe" below, as a previous + :: implementation of this cipher contained a bug such that certain inputs + :: could encipher to the same output. + :: + :: To correct these problem cases while also preserving the cipher's + :: legacy behaviour on most inputs, we check for a problem case (which + :: occurs when 'arr' is equal to 'a') and, if detected, use an alternate + :: permutation instead. + :: + ?: =(arr a) + (add (mul arr a) ell) + (add (mul ell a) arr) + :: + =/ f (prf (sub j 1) arr) + :: + =/ tmp + ?. =((mod j 2) 0) + (mod (add f ell) a) + (mod (add f ell) b) + :: + $(j +(j), ell arr, arr tmp) + :: + :: +fen: "fe^-1" in B&R (2002). + :: + :: Note that this implementation differs slightly from the reference paper + :: to support some legacy behaviour. See urbit/arvo#1105. + :: + ++ fen + |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@] + =/ j r + :: + =/ ahh + ?. =((mod r 2) 0) + (div m a) + (mod m a) + :: + =/ ale + ?. =((mod r 2) 0) + (mod m a) + (div m a) + :: + :: Similar to the comment in +fe, +fen differs from B&R (2002)'s "fe^-1" + :: here in order to preserve the legacy cipher's behaviour on most inputs. + :: + :: Here problem cases can be identified by 'ahh' equating with 'a'; we + :: correct those cases by swapping the values of 'ahh' and 'ale'. + :: + =/ ell + ?: =(ale a) + ahh + ale + :: + =/ arr + ?: =(ale a) + ale + ahh + :: + |- ^- @ + ?: (lth j 1) + (add (mul arr a) ell) + =/ f (prf (sub j 1) ell) + :: + :: Note that there is a slight deviation here to avoid dealing with + :: negative values. We add 'a' or 'b' to arr as appropriate and reduce + :: 'f' modulo the same number before performing subtraction. + :: + =/ tmp + ?. =((mod j 2) 0) + (mod (sub (add arr a) (mod f a)) a) + (mod (sub (add arr b) (mod f b)) b) + :: + $(j (sub j 1), ell tmp, arr ell) + :: + :: +eff: a murmur3-based pseudorandom function. 'F' in B&R (2002). + :: + ++ eff + |= [j=@ r=@] + ^- @ + (muk (snag j raku) 2 r) + :: + :: +raku: seeds for eff. + :: + ++ raku + ^- (list @ux) + :~ 0xb76d.5eed + 0xee28.1300 + 0x85bc.ae01 + 0x4b38.7af7 + == + :: + -- +:: +:: 3g: molds and mold builders ++| %molds-and-mold-builders +:: ++$ coin $~ [%$ %ud 0] :: print format + $% [%$ p=dime] :: + [%blob p=*] :: + [%many p=(list coin)] :: + == :: ++$ dime [p=@ta q=@] :: ++$ edge [p=hair q=(unit [p=* q=nail])] :: parsing output ++$ hair [p=@ud q=@ud] :: parsing trace +++ like |* a=$-(* *) :: generic edge + |: b=`*`[(hair) ~] :: + :- p=(hair -.b) :: + ^= q :: + ?@ +.b ~ :: + :- ~ :: + u=[p=(a +>-.b) q=[p=(hair -.b) q=(tape +.b)]] :: ++$ nail [p=hair q=tape] :: parsing input ++$ pint [p=[p=@ q=@] q=[p=@ q=@]] :: line+column range ++$ rule _|:($:nail $:edge) :: parsing rule ++$ spot [p=path q=pint] :: range in file ++$ tone $% [%0 product=*] :: success + [%1 block=*] :: single block + [%2 trace=(list [@ta *])] :: error report + == :: ++$ toon $% [%0 p=*] :: success + [%1 p=*] :: block + [%2 p=(list tank)] :: stack trace + == :: +++ wonk |* veq=_$:edge :: product from edge + ?~(q.veq !! p.u.q.veq) :: +-- => +:: +~% %qua + + + == + %mure mure + %mute mute + %show show + == +:: layer-4 +:: +|% +:: +:: 4a: exotic bases ++| %exotic-bases +:: +++ po :: phonetic base + ~/ %po + =+ :- ^= sis :: prefix syllables + 'dozmarbinwansamlitsighidfidlissogdirwacsabwissib\ + /rigsoldopmodfoglidhopdardorlorhodfolrintogsilmir\ + /holpaslacrovlivdalsatlibtabhanticpidtorbolfosdot\ + /losdilforpilramtirwintadbicdifrocwidbisdasmidlop\ + /rilnardapmolsanlocnovsitnidtipsicropwitnatpanmin\ + /ritpodmottamtolsavposnapnopsomfinfonbanmorworsip\ + /ronnorbotwicsocwatdolmagpicdavbidbaltimtasmallig\ + /sivtagpadsaldivdactansidfabtarmonranniswolmispal\ + /lasdismaprabtobrollatlonnodnavfignomnibpagsopral\ + /bilhaddocridmocpacravripfaltodtiltinhapmicfanpat\ + /taclabmogsimsonpinlomrictapfirhasbosbatpochactid\ + /havsaplindibhosdabbitbarracparloddosbortochilmac\ + /tomdigfilfasmithobharmighinradmashalraglagfadtop\ + /mophabnilnosmilfopfamdatnoldinhatnacrisfotribhoc\ + /nimlarfitwalrapsarnalmoslandondanladdovrivbacpol\ + /laptalpitnambonrostonfodponsovnocsorlavmatmipfip' + ^= dex :: suffix syllables + 'zodnecbudwessevpersutletfulpensytdurwepserwylsun\ + /rypsyxdyrnuphebpeglupdepdysputlughecryttyvsydnex\ + /lunmeplutseppesdelsulpedtemledtulmetwenbynhexfeb\ + /pyldulhetmevruttylwydtepbesdexsefwycburderneppur\ + /rysrebdennutsubpetrulsynregtydsupsemwynrecmegnet\ + /secmulnymtevwebsummutnyxrextebfushepbenmuswyxsym\ + /selrucdecwexsyrwetdylmynmesdetbetbeltuxtugmyrpel\ + /syptermebsetdutdegtexsurfeltudnuxruxrenwytnubmed\ + /lytdusnebrumtynseglyxpunresredfunrevrefmectedrus\ + /bexlebduxrynnumpyxrygryxfeptyrtustyclegnemfermer\ + /tenlusnussyltecmexpubrymtucfyllepdebbermughuttun\ + /bylsudpemdevlurdefbusbeprunmelpexdytbyttyplevmyl\ + /wedducfurfexnulluclennerlexrupnedlecrydlydfenwel\ + /nydhusrelrudneshesfetdesretdunlernyrsebhulryllud\ + /remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\ + /lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes' + |% + ++ ins ~/ %ins :: parse prefix + |= a=@tas + =+ b=0 + |- ^- (unit @) + ?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b)))) + ++ ind ~/ %ind :: parse suffix + |= a=@tas + =+ b=0 + |- ^- (unit @) + ?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b)))) + ++ tos ~/ %tos :: fetch prefix + |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis))) + ++ tod ~/ %tod :: fetch suffix + |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex))) + -- +:: +++ fa :: base58check + =+ key='123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz' + =/ yek=@ux ~+ + =- yek:(roll (rip 3 key) -) + =+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)] + |. + [+(b) (mix yek (lsh [3 `@u`a] (~(inv fe 3) b)))] + |% + ++ cha |=(a=char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b))) + ++ tok + |= a=@ux ^- @ux + =+ b=(pad a) + =- (~(net fe 5) (end [3 4] (shay 32 -))) + (shay (add b (met 3 a)) (lsh [3 b] (swp 3 a))) + :: + ++ pad |=(a=@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b)))) + ++ enc |=(a=@ux `@ux`(mix (lsh [3 4] a) (tok a))) + ++ den + |= a=@ux ^- (unit @ux) + =+ b=(rsh [3 4] a) + ?. =((tok b) (end [3 4] a)) + ~ + `b + -- +:: 4b: text processing ++| %text-processing +:: +++ at :: basic printing + |_ a=@ + ++ r + ?: ?& (gte (met 3 a) 2) + |- + ?: =(0 a) + & + =+ vis=(end 3 a) + ?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z'))) + $(a (rsh 3 a)) + == + == + rtam + ?: (lte (met 3 a) 2) + rud + rux + :: + ++ rf `tape`[?-(a %& '&', %| '|', * !!) ~] + ++ rn `tape`[?>(=(0 a) '~') ~] + ++ rt `tape`['\'' (weld (mesc (trip a)) `tape`['\'' ~])] + ++ rta rt + ++ rtam `tape`['%' (trip a)] + ++ rub `tape`['0' 'b' (rum 2 ~ |=(b=@ (add '0' b)))] + ++ rud (rum 10 ~ |=(b=@ (add '0' b))) + ++ rum + |= [b=@ c=tape d=$-(@ @)] + ^- tape + ?: =(0 a) + [(d 0) c] + =+ e=0 + |- ^- tape + ?: =(0 a) + c + =+ f=&(!=(0 e) =(0 (mod e ?:(=(10 b) 3 4)))) + %= $ + a (div a b) + c [(d (mod a b)) ?:(f [?:(=(10 b) ',' '-') c] c)] + e +(e) + == + :: + ++ rup + =+ b=(met 3 a) + ^- tape + :- '-' + |- ^- tape + ?: (gth (met 5 a) 1) + %+ weld + $(a (rsh 5 a), b (sub b 4)) + `tape`['-' '-' $(a (end 5 a), b 4)] + ?: =(0 b) + ['~' ~] + ?: (lte b 1) + (trip (tos:po a)) + |- ^- tape + ?: =(2 b) + =+ c=(rsh 3 a) + =+ d=(end 3 a) + (weld (trip (tod:po c)) (trip (tos:po (mix c d)))) + =+ c=(rsh [3 2] a) + =+ d=(end [3 2] a) + (weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)]) + :: + ++ ruv + ^- tape + :+ '0' + 'v' + %^ rum + 64 + ~ + |= b=@ + ?: =(63 b) + '+' + ?: =(62 b) + '-' + ?:((lth b 26) (add 65 b) ?:((lth b 52) (add 71 b) (sub b 4))) + :: + ++ rux `tape`['0' 'x' (rum 16 ~ |=(b=@ (add b ?:((lth b 10) 48 87))))] + -- +++ cass :: lowercase + |= vib=tape + ^- tape + (turn vib |=(a=@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a)))) +:: +++ cuss :: uppercase + |= vib=tape + ^- tape + (turn vib |=(a=@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32)))) +:: +++ crip |=(a=tape `@t`(rap 3 a)) :: tape to cord +:: +++ mesc :: ctrl code escape + |= vib=tape + ^- tape + ?~ vib + ~ + ?: =('\\' i.vib) + ['\\' '\\' $(vib t.vib)] + ?: ?|((gth i.vib 126) (lth i.vib 32) =(`@`39 i.vib)) + ['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))] + [i.vib $(vib t.vib)] +:: +++ runt :: prepend repeatedly + |= [[a=@ b=@] c=tape] + ^- tape + ?: =(0 a) + c + [b $(a (dec a))] +:: +++ sand :: atom sanity + |= a=@ta + (flit (sane a)) +:: +++ sane :: atom sanity + |= a=@ta + |= b=@ ^- ? + ?. =(%t (end 3 a)) + :: XX more and better sanity + :: + & + =+ [inx=0 len=(met 3 b)] + ?: =(%tas a) + |- ^- ? + ?: =(inx len) & + =+ cur=(cut 3 [inx 1] b) + ?& ?| &((gte cur 'a') (lte cur 'z')) + &(=('-' cur) !=(0 inx) !=(len inx)) + &(&((gte cur '0') (lte cur '9')) !=(0 inx)) + == + $(inx +(inx)) + == + ?: =(%ta a) + |- ^- ? + ?: =(inx len) & + =+ cur=(cut 3 [inx 1] b) + ?& ?| &((gte cur 'a') (lte cur 'z')) + &((gte cur '0') (lte cur '9')) + |(=('-' cur) =('~' cur) =('_' cur) =('.' cur)) + == + $(inx +(inx)) + == + |- ^- ? + ?: =(inx len) & + =+ cur=(cut 3 [inx 1] b) + ?: &((lth cur 32) !=(10 cur)) | + =+ tef=(teff cur) + ?& ?| =(1 tef) + =+ i=1 + |- ^- ? + ?| =(i tef) + ?& (gte (cut 3 [(add i inx) 1] b) 128) + $(i +(i)) + == == == + $(inx (add inx tef)) + == +:: +++ ruth :: biblical sanity + |= [a=@ta b=*] + ^- @ + ?^ b !! + :: ?. ((sane a) b) !! + b +:: +++ trim :: tape split + |= [a=@ b=tape] + ^- [p=tape q=tape] + ?~ b + [~ ~] + ?: =(0 a) + [~ b] + =+ c=$(a (dec a), b t.b) + [[i.b p.c] q.c] +:: +++ trip :: cord to tape + ~/ %trip + |= a=@ ^- tape + ?: =(0 (met 3 a)) + ~ + [^-(@ta (end 3 a)) $(a (rsh 3 a))] +:: +++ teff :: length utf8 + |= a=@t ^- @ + =+ b=(end 3 a) + ?: =(0 b) + ?>(=(`@`0 a) 0) + ?> |((gte b 32) =(10 b)) + ?:((lte b 127) 1 ?:((lte b 223) 2 ?:((lte b 239) 3 4))) +:: +++ taft :: utf8 to utf32 + |= a=@t + ^- @c + %+ rap 5 + |- ^- (list @c) + =+ b=(teff a) + ?: =(0 b) ~ + =+ ^= c + %+ can 0 + %+ turn + ^- (list [p=@ q=@]) + ?+ b !! + %1 [[0 7] ~] + %2 [[8 6] [0 5] ~] + %3 [[16 6] [8 6] [0 4] ~] + %4 [[24 6] [16 6] [8 6] [0 3] ~] + == + |=([p=@ q=@] [q (cut 0 [p q] a)]) + ?> =((tuft c) (end [3 b] a)) + [c $(a (rsh [3 b] a))] +:: +++ tuba :: utf8 to utf32 tape + |= a=tape + ^- (list @c) + (rip 5 (taft (rap 3 a))) :: XX horrible +:: +++ tufa :: utf32 to utf8 tape + |= a=(list @c) + ^- tape + ?~ a "" + (weld (rip 3 (tuft i.a)) $(a t.a)) +:: +++ tuft :: utf32 to utf8 text + |= a=@c + ^- @t + %+ rap 3 + |- ^- (list @) + ?: =(`@`0 a) + ~ + =+ b=(end 5 a) + =+ c=$(a (rsh 5 a)) + ?: (lte b 0x7f) + [b c] + ?: (lte b 0x7ff) + :* (mix 0b1100.0000 (cut 0 [6 5] b)) + (mix 0b1000.0000 (end [0 6] b)) + c + == + ?: (lte b 0xffff) + :* (mix 0b1110.0000 (cut 0 [12 4] b)) + (mix 0b1000.0000 (cut 0 [6 6] b)) + (mix 0b1000.0000 (end [0 6] b)) + c + == + :* (mix 0b1111.0000 (cut 0 [18 3] b)) + (mix 0b1000.0000 (cut 0 [12 6] b)) + (mix 0b1000.0000 (cut 0 [6 6] b)) + (mix 0b1000.0000 (end [0 6] b)) + c + == +:: +++ wack :: knot escape + |= a=@ta + ^- @ta + =+ b=(rip 3 a) + %+ rap 3 + |- ^- tape + ?~ b + ~ + ?: =('~' i.b) ['~' '~' $(b t.b)] + ?: =('_' i.b) ['~' '-' $(b t.b)] + [i.b $(b t.b)] +:: +++ wick :: knot unescape + |= a=@ + ^- (unit @ta) + =+ b=(rip 3 a) + =- ?^(b ~ (some (rap 3 (flop c)))) + =| c=tape + |- ^- [b=tape c=tape] + ?~ b [~ c] + ?. =('~' i.b) + $(b t.b, c [i.b c]) + ?~ t.b [b ~] + ?- i.t.b + %'~' $(b t.t.b, c ['~' c]) + %'-' $(b t.t.b, c ['_' c]) + @ [b ~] + == +:: +++ woad :: cord unescape + |= a=@ta + ^- @t + %+ rap 3 + |- ^- (list @) + ?: =(`@`0 a) + ~ + =+ b=(end 3 a) + =+ c=(rsh 3 a) + ?: =('.' b) + [' ' $(a c)] + ?. =('~' b) + [b $(a c)] + => .(b (end 3 c), c (rsh 3 c)) + ?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d)) + ^= d + =+ d=0 + |- ^- [p=@ q=@] + ?: =('.' b) + [d c] + ?< =(0 c) + %= $ + b (end 3 c) + c (rsh 3 c) + d %+ add (mul 16 d) + %+ sub b + ?: &((gte b '0') (lte b '9')) 48 + ?>(&((gte b 'a') (lte b 'z')) 87) + == + %'.' ['.' $(a c)] + %'~' ['~' $(a c)] + == +:: +++ wood :: cord escape + |= a=@t + ^- @ta + %+ rap 3 + |- ^- (list @) + ?: =(`@`0 a) + ~ + =+ b=(teff a) + =+ c=(taft (end [3 b] a)) + =+ d=$(a (rsh [3 b] a)) + ?: ?| &((gte c 'a') (lte c 'z')) + &((gte c '0') (lte c '9')) + =(`@`'-' c) + == + [c d] + ?+ c + :- '~' + =+ e=(met 2 c) + |- ^- tape + ?: =(0 e) + ['.' d] + =. e (dec e) + =+ f=(rsh [2 e] c) + [(add ?:((lte f 9) 48 87) f) $(c (end [2 e] c))] + :: + %' ' ['.' d] + %'.' ['~' '.' d] + %'~' ['~' '~' d] + == +:: +:: 4c: tank printer ++| %tank-printer +:: +++ wash :: render tank at width + |= [[tab=@ edg=@] tac=tank] ^- wall + (~(win re tac) tab edg) +:: +:: +re: tank renderer +:: +++ re + |_ tac=tank + :: +ram: render a tank to one line (flat) + :: + ++ ram + ^- tape + ?@ tac + (trip tac) + ?- -.tac + %leaf p.tac + :: + :: flat %palm rendered as %rose with welded openers + :: + %palm + =* mid p.p.tac + =* for (weld q.p.tac r.p.tac) + =* end s.p.tac + ram(tac [%rose [mid for end] q.tac]) + :: + :: flat %rose rendered with open/mid/close + :: + %rose + =* mid p.p.tac + =* for q.p.tac + =* end r.p.tac + =* lit q.tac + %+ weld + for + |- ^- tape + ?~ lit + end + %+ weld + ram(tac i.lit) + =* voz $(lit t.lit) + ?~(t.lit voz (weld mid voz)) + == + :: +win: render a tank to multiple lines (tall) + :: + :: indented by .tab, soft-wrapped at .edg + :: + ++ win + |= [tab=@ud edg=@ud] + :: output stack + :: + =| lug=wall + |^ ^- wall + ?@ tac + (rig (trip tac)) + ?- -.tac + %leaf (rig p.tac) + :: + %palm + =/ hom ram + ?: (lte (lent hom) (sub edg tab)) + (rig hom) + :: + =* for q.p.tac + =* lit q.tac + ?~ lit + (rig for) + ?~ t.lit + =: tab (add 2 tab) + lug $(tac i.lit) + == + (rig for) + :: + => .(lit `(list tank)`lit) + =/ lyn (mul 2 (lent lit)) + =. lug + |- ^- wall + ?~ lit + lug + =/ nyl (sub lyn 2) + %= ^$ + tac i.lit + tab (add tab nyl) + lug $(lit t.lit, lyn nyl) + == + (wig for) + :: + %rose + =/ hom ram + ?: (lte (lent hom) (sub edg tab)) + (rig hom) + :: + =* for q.p.tac + =* end r.p.tac + =* lit q.tac + =. lug + |- ^- wall + ?~ lit + ?~(end lug (rig end)) + %= ^$ + tac i.lit + tab (mod (add 2 tab) (mul 2 (div edg 3))) + lug $(lit t.lit) + == + ?~(for lug (wig for)) + == + :: +rig: indent tape and cons with output stack + :: + ++ rig + |= hom=tape + ^- wall + [(runt [tab ' '] hom) lug] + :: +wig: indent tape and cons with output stack + :: + :: joined with the top line if whitespace/indentation allow + :: + ++ wig + |= hom=tape + ^- wall + ?~ lug + (rig hom) + =/ wug :(add 1 tab (lent hom)) + ?. =+ mir=i.lug + |- ^- ? + ?~ mir | + ?| =(0 wug) + ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug))) + == + (rig hom) :: ^ XX regular form? + :_ t.lug + %+ runt [tab ' '] + (weld hom `tape`[' ' (slag wug i.lug)]) + -- + -- +++ show :: XX deprecated! + |= vem=* + |^ ^- tank + ?: ?=(@ vem) + [%leaf (mesc (trip vem))] + ?- vem + [s=~ c=*] + [%leaf '\'' (weld (mesc (tape +.vem)) `tape`['\'' ~])] + :: + [s=%a c=@] [%leaf (mesc (trip c.vem))] + [s=%b c=*] (shop c.vem |=(a=@ ~(rub at a))) + [s=[%c p=@] c=*] + :+ %palm + [['.' ~] ['-' ~] ~ ~] + [[%leaf (mesc (trip p.s.vem))] $(vem c.vem) ~] + :: + [s=%d c=*] (shop c.vem |=(a=@ ~(rud at a))) + [s=%k c=*] (tank c.vem) + [s=%h c=*] + :+ %rose + [['/' ~] ['/' ~] ~] + =+ yol=((list @ta) c.vem) + (turn yol |=(a=@ta [%leaf (trip a)])) + :: + [s=%l c=*] (shol c.vem) + [s=%o c=*] + %= $ + vem + :- [%m '%h::[%d %d].[%d %d]>'] + [-.c.vem +<-.c.vem +<+.c.vem +>-.c.vem +>+.c.vem ~] + == + :: + [s=%p c=*] (shop c.vem |=(a=@ ~(rup at a))) + [s=%q c=*] (shop c.vem |=(a=@ ~(r at a))) + [s=%r c=*] $(vem [[%r ' ' '{' '}'] c.vem]) + [s=%t c=*] (shop c.vem |=(a=@ ~(rt at a))) + [s=%v c=*] (shop c.vem |=(a=@ ~(ruv at a))) + [s=%x c=*] (shop c.vem |=(a=@ ~(rux at a))) + [s=[%m p=@] c=*] (shep p.s.vem c.vem) + [s=[%r p=@] c=*] + $(vem [[%r ' ' (cut 3 [0 1] p.s.vem) (cut 3 [1 1] p.s.vem)] c.vem]) + :: + [s=[%r p=@ q=@ r=@] c=*] + :+ %rose + :* p=(mesc (trip p.s.vem)) + q=(mesc (trip q.s.vem)) + r=(mesc (trip r.s.vem)) + == + |- ^- (list tank) + ?@ c.vem + ~ + [^$(vem -.c.vem) $(c.vem +.c.vem)] + :: + [s=%z c=*] $(vem [[%r %$ %$ %$] c.vem]) + * !! + == + ++ shep + |= [fom=@ gar=*] + ^- tank + =+ l=(met 3 fom) + =+ i=0 + :- %leaf + |- ^- tape + ?: (gte i l) + ~ + =+ c=(cut 3 [i 1] fom) + ?. =(37 c) + (weld (mesc [c ~]) $(i +(i))) + =+ d=(cut 3 [+(i) 1] fom) + ?. .?(gar) + ['\\' '#' $(i (add 2 i))] + (weld ~(ram re (show d -.gar)) $(i (add 2 i), gar +.gar)) + :: + ++ shop + |= [aug=* vel=$-(a=@ tape)] + ^- tank + ?: ?=(@ aug) + [%leaf (vel aug)] + :+ %rose + [[' ' ~] ['[' ~] [']' ~]] + => .(aug `*`aug) + |- ^- (list tank) + ?: ?=(@ aug) + [^$ ~] + [^$(aug -.aug) $(aug +.aug)] + :: + ++ shol + |= lim=* + :+ %rose + [['.' ~] ~ ~] + |- ^- (list tank) + ?: ?=(@ lim) ~ + :_ $(lim +.lim) + ?+ -.lim (show '#') + ~ (show '$') + c=@ (show c.lim) + [%& %1] (show '.') + [%& c=@] + [%leaf '+' ~(rud at c.lim)] + :: + [%| @ ~] (show ',') + [%| n=@ ~ c=@] + [%leaf (weld (reap n.lim '^') ?~(c.lim "$" (trip c.lim)))] + == + -- +:: +:: 4d: parsing (tracing) ++| %parsing-tracing +:: +++ last |= [zyc=hair naz=hair] :: farther trace + ^- hair + ?: =(p.zyc p.naz) + ?:((gth q.zyc q.naz) zyc naz) + ?:((gth p.zyc p.naz) zyc naz) +:: +++ lust |= [weq=char naz=hair] :: detect newline + ^- hair + ?:(=(`@`10 weq) [+(p.naz) 1] [p.naz +(q.naz)]) +:: +:: 4e: parsing (combinators) ++| %parsing-combinators +:: +++ bend :: conditional comp + ~/ %bend + |* raq=_|*([a=* b=*] [~ u=[a b]]) + ~/ %fun + |* [vex=edge sab=rule] + ?~ q.vex + vex + =+ yit=(sab q.u.q.vex) + =+ yur=(last p.vex p.yit) + ?~ q.yit + [p=yur q=q.vex] + =+ vux=(raq p.u.q.vex p.u.q.yit) + ?~ vux + [p=yur q=q.vex] + [p=yur q=[~ u=[p=u.vux q=q.u.q.yit]]] +:: +++ comp + ~/ %comp + |* raq=_|*([a=* b=*] [a b]) :: arbitrary compose + ~/ %fun + |* [vex=edge sab=rule] + ~! +< + ?~ q.vex + vex + =+ yit=(sab q.u.q.vex) + =+ yur=(last p.vex p.yit) + ?~ q.yit + [p=yur q=q.yit] + [p=yur q=[~ u=[p=(raq p.u.q.vex p.u.q.yit) q=q.u.q.yit]]] +:: +++ fail |=(tub=nail [p=p.tub q=~]) :: never parse +++ glue :: add rule + ~/ %glue + |* bus=rule + ~/ %fun + |* [vex=edge sab=rule] + (plug vex ;~(pfix bus sab)) +:: +++ less :: no first and second + |* [vex=edge sab=rule] + ?~ q.vex + =+ roq=(sab) + [p=(last p.vex p.roq) q=q.roq] + (fail +<.sab) +:: +++ pfix :: discard first rule + ~/ %pfix + |* sam=[vex=edge sab=rule] + %. sam + (comp |*([a=* b=*] b)) +:: +++ plug :: first then second + ~/ %plug + |* [vex=edge sab=rule] + ?~ q.vex + vex + =+ yit=(sab q.u.q.vex) + =+ yur=(last p.vex p.yit) + ?~ q.yit + [p=yur q=q.yit] + [p=yur q=[~ u=[p=[p.u.q.vex p.u.q.yit] q=q.u.q.yit]]] +:: +++ pose :: first or second + ~/ %pose + |* [vex=edge sab=rule] + ?~ q.vex + =+ roq=(sab) + [p=(last p.vex p.roq) q=q.roq] + vex +:: +++ simu :: first and second + |* [vex=edge sab=rule] + ?~ q.vex + vex + =+ roq=(sab) + roq +:: +++ sfix :: discard second rule + ~/ %sfix + |* sam=[vex=edge sab=rule] + %. sam + (comp |*([a=* b=*] a)) +:: +:: 4f: parsing (rule builders) ++| %parsing-rule-builders +:: +++ bass :: leftmost base + |* [wuc=@ tyd=rule] + %+ cook + |= waq=(list @) + %+ roll + waq + =|([p=@ q=@] |.((add p (mul wuc q)))) + tyd +:: +++ boss :: rightmost base + |* [wuc=@ tyd=rule] + %+ cook + |= waq=(list @) + %+ reel + waq + =|([p=@ q=@] |.((add p (mul wuc q)))) + tyd +:: +++ cold :: replace w+ constant + ~/ %cold + |* [cus=* sef=rule] + ~/ %fun + |= tub=nail + =+ vex=(sef tub) + ?~ q.vex + vex + [p=p.vex q=[~ u=[p=cus q=q.u.q.vex]]] +:: +++ cook :: apply gate + ~/ %cook + |* [poq=gate sef=rule] + ~/ %fun + |= tub=nail + =+ vex=(sef tub) + ?~ q.vex + vex + [p=p.vex q=[~ u=[p=(poq p.u.q.vex) q=q.u.q.vex]]] +:: +++ easy :: always parse + ~/ %easy + |* huf=* + ~/ %fun + |= tub=nail + ^- (like _huf) + [p=p.tub q=[~ u=[p=huf q=tub]]] +:: +++ fuss + |= [sic=@t non=@t] + ;~(pose (cold %& (jest sic)) (cold %| (jest non))) +:: +++ full :: has to fully parse + |* sef=rule + |= tub=nail + =+ vex=(sef tub) + ?~(q.vex vex ?:(=(~ q.q.u.q.vex) vex [p=p.vex q=~])) +:: +++ funk :: add to tape first + |* [pre=tape sef=rule] + |= tub=nail + (sef p.tub (weld pre q.tub)) +:: +++ here :: place-based apply + ~/ %here + |* [hez=_|=([a=pint b=*] [a b]) sef=rule] + ~/ %fun + |= tub=nail + =+ vex=(sef tub) + ?~ q.vex + vex + [p=p.vex q=[~ u=[p=(hez [p.tub p.q.u.q.vex] p.u.q.vex) q=q.u.q.vex]]] +:: +++ inde |* sef=rule :: indentation block + |= nail ^+ (sef) + =+ [har tap]=[p q]:+< + =+ lev=(fil 3 (dec q.har) ' ') + =+ eol=(just `@t`10) + =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap) + ;~(simu ;~(plug eol eol) eol) + ?~ q.roq roq + =+ vex=(sef har(q 1) p.u.q.roq) + =+ fur=p.vex(q (add (dec q.har) q.p.vex)) + ?~ q.vex vex(p fur) + =- vex(p fur, u.q -) + :+ &3.vex + &4.vex(q.p (add (dec q.har) q.p.&4.vex)) + =+ res=|4.vex + |- ?~ res |4.roq + ?. =(10 -.res) [-.res $(res +.res)] + (welp [`@t`10 (trip lev)] $(res +.res)) +:: +++ ifix + |* [fel=[rule rule] hof=rule] + ~! +< + ~! +<:-.fel + ~! +<:+.fel + ;~(pfix -.fel ;~(sfix hof +.fel)) +:: +++ jest :: match a cord + |= daf=@t + |= tub=nail + =+ fad=daf + |- ^- (like @t) + ?: =(`@`0 daf) + [p=p.tub q=[~ u=[p=fad q=tub]]] + ?: |(?=(~ q.tub) !=((end 3 daf) i.q.tub)) + (fail tub) + $(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 daf)) +:: +++ just :: XX redundant, jest + ~/ %just :: match a char + |= daf=char + ~/ %fun + |= tub=nail + ^- (like char) + ?~ q.tub + (fail tub) + ?. =(daf i.q.tub) + (fail tub) + (next tub) +:: +++ knee :: callbacks + |* [gar=* sef=_|.(*rule)] + |= tub=nail + ^- (like _gar) + ((sef) tub) +:: +++ mask :: match char in set + ~/ %mask + |= bud=(list char) + ~/ %fun + |= tub=nail + ^- (like char) + ?~ q.tub + (fail tub) + ?. (lien bud |=(a=char =(i.q.tub a))) + (fail tub) + (next tub) +:: +++ more :: separated, * + |* [bus=rule fel=rule] + ;~(pose (most bus fel) (easy ~)) +:: +++ most :: separated, + + |* [bus=rule fel=rule] + ;~(plug fel (star ;~(pfix bus fel))) +:: +++ next :: consume a char + |= tub=nail + ^- (like char) + ?~ q.tub + (fail tub) + =+ zac=(lust i.q.tub p.tub) + [zac [~ i.q.tub [zac t.q.tub]]] +:: +++ perk :: parse cube fork + |* a=(pole @tas) + ?~ a fail + ;~ pose + (cold -.a (jest -.a)) + $(a +.a) + == +:: +++ pick :: rule for ++each + |* [a=rule b=rule] + ;~ pose + (stag %& a) + (stag %| b) + == +++ plus |*(fel=rule ;~(plug fel (star fel))) :: +++ punt |*([a=rule] ;~(pose (stag ~ a) (easy ~))) :: +++ sear :: conditional cook + |* [pyq=$-(* (unit)) sef=rule] + |= tub=nail + =+ vex=(sef tub) + ?~ q.vex + vex + =+ gey=(pyq p.u.q.vex) + ?~ gey + [p=p.vex q=~] + [p=p.vex q=[~ u=[p=u.gey q=q.u.q.vex]]] +:: +++ shim :: match char in range + ~/ %shim + |= [les=@ mos=@] + ~/ %fun + |= tub=nail + ^- (like char) + ?~ q.tub + (fail tub) + ?. ?&((gte i.q.tub les) (lte i.q.tub mos)) + (fail tub) + (next tub) +:: +++ stag :: add a label + ~/ %stag + |* [gob=* sef=rule] + ~/ %fun + |= tub=nail + =+ vex=(sef tub) + ?~ q.vex + vex + [p=p.vex q=[~ u=[p=[gob p.u.q.vex] q=q.u.q.vex]]] +:: +++ stet :: + |* leh=(list [?(@ [@ @]) rule]) + |- + ?~ leh + ~ + [i=[p=-.i.leh q=+.i.leh] t=$(leh t.leh)] +:: +++ stew :: switch by first char + ~/ %stew + |* leh=(list [p=?(@ [@ @]) q=rule]) :: char+range keys + =+ ^= wor :: range complete lth + |= [ort=?(@ [@ @]) wan=?(@ [@ @])] + ?@ ort + ?@(wan (lth ort wan) (lth ort -.wan)) + ?@(wan (lth +.ort wan) (lth +.ort -.wan)) + =+ ^= hel :: build parser map + =+ hel=`(tree _?>(?=(^ leh) i.leh))`~ + |- ^+ hel + ?~ leh + ~ + =+ yal=$(leh t.leh) + |- ^+ hel + ?~ yal + [i.leh ~ ~] + ?: (wor p.i.leh p.n.yal) + =+ nuc=$(yal l.yal) + ?> ?=(^ nuc) + ?: (mor p.n.yal p.n.nuc) + [n.yal nuc r.yal] + [n.nuc l.nuc [n.yal r.nuc r.yal]] + =+ nuc=$(yal r.yal) + ?> ?=(^ nuc) + ?: (mor p.n.yal p.n.nuc) + [n.yal l.yal nuc] + [n.nuc [n.yal l.yal l.nuc] r.nuc] + ~% %fun ..^$ ~ + |= tub=nail + ?~ q.tub + (fail tub) + |- + ?~ hel + (fail tub) + ?: ?@ p.n.hel + =(p.n.hel i.q.tub) + ?&((gte i.q.tub -.p.n.hel) (lte i.q.tub +.p.n.hel)) + :: (q.n.hel [(lust i.q.tub p.tub) t.q.tub]) + (q.n.hel tub) + ?: (wor i.q.tub p.n.hel) + $(hel l.hel) + $(hel r.hel) +:: +++ slug :: + |* raq=_=>(~ |*([a=* b=*] [a b])) + |* [bus=rule fel=rule] + ;~((comp raq) fel (stir +<+.raq raq ;~(pfix bus fel))) +:: +++ star :: 0 or more times + |* fel=rule + (stir `(list _(wonk *fel))`~ |*([a=* b=*] [a b]) fel) +:: +++ stir + ~/ %stir + |* [rud=* raq=_=>(~ |*([a=* b=*] [a b])) fel=rule] + ~/ %fun + |= tub=nail + ^- (like _rud) + :: + :: lef: successful interim parse results (per .fel) + :: wag: initial accumulator (.rud in .tub at farthest success) + :: + =+ ^= [lef wag] + =| lef=(list _(fel tub)) + |- ^- [_lef (pair hair [~ u=(pair _rud nail)])] + =+ vex=(fel tub) + ?~ q.vex + :- lef + [p.vex [~ rud tub]] + $(lef [vex lef], tub q.u.q.vex) + :: + :: fold .lef into .wag, combining results with .raq + :: + %+ roll lef + |= _[vex=(fel tub) wag=wag] :: q.vex is always (some) + ^+ wag + :- (last p.vex p.wag) + [~ (raq p.u.+.q.vex p.u.q.wag) q.u.q.wag] +:: +++ stun :: parse several times + ~/ %stun + |* [lig=[@ @] fel=rule] + |= tub=nail + ^- (like (list _(wonk (fel)))) + ?: =(0 +.lig) + [p.tub [~ ~ tub]] + =+ vex=(fel tub) + ?~ q.vex + ?: =(0 -.lig) + [p.vex [~ ~ tub]] + vex + =+ ^= wag %= $ + -.lig ?:(=(0 -.lig) 0 (dec -.lig)) + +.lig ?:(=(0 +.lig) 0 (dec +.lig)) + tub q.u.q.vex + == + ?~ q.wag + wag + [p.wag [~ [p.u.q.vex p.u.q.wag] q.u.q.wag]] +:: +:: 4g: parsing (outside caller) ++| %parsing-outside-caller +:: +++ rash |*([naf=@ sab=rule] (scan (trip naf) sab)) +++ rose |* [los=tape sab=rule] + =+ vex=(sab [[1 1] los]) + =+ len=(lent los) + ?. =(+(len) q.p.vex) [%| p=(dec q.p.vex)] + ?~ q.vex + [%& p=~] + [%& p=[~ u=p.u.q.vex]] +++ rush |*([naf=@ sab=rule] (rust (trip naf) sab)) +++ rust |* [los=tape sab=rule] + =+ vex=((full sab) [[1 1] los]) + ?~(q.vex ~ [~ u=p.u.q.vex]) +++ scan |* [los=tape sab=rule] + =+ vex=((full sab) [[1 1] los]) + ?~ q.vex + ~_ (show [%m '{%d %d}'] p.p.vex q.p.vex ~) + ~_(leaf+"syntax error" !!) + p.u.q.vex +:: +:: 4h: parsing (ascii glyphs) ++| %parsing-ascii-glyphs +:: +++ ace (just ' ') :: spACE +++ bar (just '|') :: vertical BAR +++ bas (just '\\') :: Back Slash (escaped) +++ buc (just '$') :: dollars BUCks +++ cab (just '_') :: CABoose +++ cen (just '%') :: perCENt +++ col (just ':') :: COLon +++ com (just ',') :: COMma +++ doq (just '"') :: Double Quote +++ dot (just '.') :: dot dot dot ... +++ fas (just '/') :: Forward Slash +++ gal (just '<') :: Greater Left +++ gar (just '>') :: Greater Right +++ hax (just '#') :: Hash +++ hep (just '-') :: HyPhen +++ kel (just '{') :: Curly Left +++ ker (just '}') :: Curly Right +++ ket (just '^') :: CareT +++ lus (just '+') :: pLUS +++ mic (just ';') :: seMIColon +++ pal (just '(') :: Paren Left +++ pam (just '&') :: AMPersand pampersand +++ par (just ')') :: Paren Right +++ pat (just '@') :: AT pat +++ sel (just '[') :: Square Left +++ ser (just ']') :: Square Right +++ sig (just '~') :: SIGnature squiggle +++ soq (just '\'') :: Single Quote +++ tar (just '*') :: sTAR +++ tic (just '`') :: backTiCk +++ tis (just '=') :: 'tis tis, it is +++ wut (just '?') :: wut, what? +++ zap (just '!') :: zap! bang! crash!! +:: +:: 4i: parsing (useful idioms) ++| %parsing-useful-idioms +:: +++ alf ;~(pose low hig) :: alphabetic +++ aln ;~(pose low hig nud) :: alphanumeric +++ alp ;~(pose low hig nud hep) :: alphanumeric and - +++ bet ;~(pose (cold 2 hep) (cold 3 lus)) :: axis syntax - + +++ bin (bass 2 (most gon but)) :: binary to atom +++ but (cook |=(a=@ (sub a '0')) (shim '0' '1')) :: binary digit +++ cit (cook |=(a=@ (sub a '0')) (shim '0' '7')) :: octal digit +++ dem (bass 10 (most gon dit)) :: decimal to atom +++ dit (cook |=(a=@ (sub a '0')) (shim '0' '9')) :: decimal digit +++ dog ;~(plug dot gay) :: . number separator +++ dof ;~(plug hep gay) :: - @q separator +++ doh ;~(plug ;~(plug hep hep) gay) :: -- phon separator +++ dun (cold ~ ;~(plug hep hep)) :: -- (stop) to ~ +++ duz (cold ~ ;~(plug tis tis)) :: == (stet) to ~ +++ gah (mask [`@`10 ' ' ~]) :: newline or ace +++ gap (cold ~ ;~(plug gaq (star ;~(pose vul gah)))) :: plural space +++ gaq ;~ pose :: end of line + (just `@`10) + ;~(plug gah ;~(pose gah vul)) + vul + == +++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white +++ gay ;~(pose gap (easy ~)) :: +++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ / +++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < > +++ hex (bass 16 (most gon hit)) :: hex to atom +++ hig (shim 'A' 'Z') :: uppercase +++ hit ;~ pose :: hex digits + dit + (cook |=(a=char (sub a 87)) (shim 'a' 'f')) + (cook |=(a=char (sub a 55)) (shim 'A' 'F')) + == +++ iny :: indentation block + |* sef=rule + |= nail ^+ (sef) + =+ [har tap]=[p q]:+< + =+ lev=(fil 3 (dec q.har) ' ') + =+ eol=(just `@t`10) + =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap) + ;~(simu ;~(plug eol eol) eol) + ?~ q.roq roq + =+ vex=(sef har(q 1) p.u.q.roq) + =+ fur=p.vex(q (add (dec q.har) q.p.vex)) + ?~ q.vex vex(p fur) + =- vex(p fur, u.q -) + :+ &3.vex + &4.vex(q.p (add (dec q.har) q.p.&4.vex)) + =+ res=|4.vex + |- ?~ res |4.roq + ?. =(10 -.res) [-.res $(res +.res)] + (welp [`@t`10 (trip lev)] $(res +.res)) +:: +++ low (shim 'a' 'z') :: lowercase +++ mes %+ cook :: hexbyte + |=([a=@ b=@] (add (mul 16 a) b)) + ;~(plug hit hit) +++ nix (boss 256 (star ;~(pose aln cab))) :: +++ nud (shim '0' '9') :: numeric +++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control +++ qat ;~ pose :: chars in blockcord + prn + ;~(less ;~(plug (just `@`10) soz) (just `@`10)) + == +++ qit ;~ pose :: chars in a cord + ;~(less bas soq prn) + ;~(pfix bas ;~(pose bas soq mes)) :: escape chars + == +++ qut ;~ simu soq :: cord + ;~ pose + ;~ less soz + (ifix [soq soq] (boss 256 (more gon qit))) + == + =+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a')) + %- iny %+ ifix + :- ;~(plug soz hed) + ;~(plug (just '\0a') soz) + (boss 256 (star qat)) + == + == +++ soz ;~(plug soq soq soq) :: delimiting ''' +++ sym :: symbol + %+ cook + |=(a=tape (rap 3 ^-((list @) a))) + ;~(plug low (star ;~(pose nud low hep))) +:: +++ mixed-case-symbol + %+ cook + |=(a=tape (rap 3 ^-((list @) a))) + ;~(plug alf (star alp)) +:: +++ ven ;~ (comp |=([a=@ b=@] (peg a b))) :: +>- axis syntax + bet + =+ hom=`?`| + |= tub=nail + ^- (like @) + =+ vex=?:(hom (bet tub) (gul tub)) + ?~ q.vex + [p.tub [~ 1 tub]] + =+ wag=$(p.tub p.vex, hom !hom, tub q.u.q.vex) + ?> ?=(^ q.wag) + [p.wag [~ (peg p.u.q.vex p.u.q.wag) q.u.q.wag]] + == +++ vit :: base64 digit + ;~ pose + (cook |=(a=@ (sub a 65)) (shim 'A' 'Z')) + (cook |=(a=@ (sub a 71)) (shim 'a' 'z')) + (cook |=(a=@ (add a 4)) (shim '0' '9')) + (cold 62 (just '-')) + (cold 63 (just '+')) + == +++ vul %+ cold ~ :: comments + ;~ plug col col + (star prn) + (just `@`10) + == +:: +:: 4j: parsing (bases and base digits) ++| %parsing-bases-and-base-digits +:: +++ ab + |% + ++ bix (bass 16 (stun [2 2] six)) + ++ fem (sear |=(a=@ (cha:fa a)) aln) + ++ haf (bass 256 ;~(plug tep tiq (easy ~))) + ++ hef %+ sear |=(a=@ ?:(=(a 0) ~ (some a))) + %+ bass 256 + ;~(plug tip tiq (easy ~)) + ++ hif (bass 256 ;~(plug tip tiq (easy ~))) + ++ hof (bass 0x1.0000 ;~(plug hef (stun [1 3] ;~(pfix hep hif)))) + ++ huf (bass 0x1.0000 ;~(plug hef (stun [0 3] ;~(pfix hep hif)))) + ++ hyf (bass 0x1.0000 ;~(plug hif (stun [3 3] ;~(pfix hep hif)))) + ++ pev (bass 32 ;~(plug sev (stun [0 4] siv))) + ++ pew (bass 64 ;~(plug sew (stun [0 4] siw))) + ++ piv (bass 32 (stun [5 5] siv)) + ++ piw (bass 64 (stun [5 5] siw)) + ++ qeb (bass 2 ;~(plug seb (stun [0 3] sib))) + ++ qex (bass 16 ;~(plug sex (stun [0 3] hit))) + ++ qib (bass 2 (stun [4 4] sib)) + ++ qix (bass 16 (stun [4 4] six)) + ++ seb (cold 1 (just '1')) + ++ sed (cook |=(a=@ (sub a '0')) (shim '1' '9')) + ++ sev ;~(pose sed sov) + ++ sew ;~(pose sed sow) + ++ sex ;~(pose sed sox) + ++ sib (cook |=(a=@ (sub a '0')) (shim '0' '1')) + ++ sid (cook |=(a=@ (sub a '0')) (shim '0' '9')) + ++ siv ;~(pose sid sov) + ++ siw ;~(pose sid sow) + ++ six ;~(pose sid sox) + ++ sov (cook |=(a=@ (sub a 87)) (shim 'a' 'v')) + ++ sow ;~ pose + (cook |=(a=@ (sub a 87)) (shim 'a' 'z')) + (cook |=(a=@ (sub a 29)) (shim 'A' 'Z')) + (cold 62 (just '-')) + (cold 63 (just '~')) + == + ++ sox (cook |=(a=@ (sub a 87)) (shim 'a' 'f')) + ++ ted (bass 10 ;~(plug sed (stun [0 2] sid))) + ++ tep (sear |=(a=@ ?:(=(a 'doz') ~ (ins:po a))) til) + ++ tip (sear |=(a=@ (ins:po a)) til) + ++ tiq (sear |=(a=@ (ind:po a)) til) + ++ tid (bass 10 (stun [3 3] sid)) + ++ til (boss 256 (stun [3 3] low)) + ++ urs %+ cook + |=(a=tape (rap 3 ^-((list @) a))) + (star ;~(pose nud low hep dot sig cab)) + ++ urt %+ cook + |=(a=tape (rap 3 ^-((list @) a))) + (star ;~(pose nud low hep dot sig)) + ++ urx %+ cook + |=(a=tape (rap 3 ^-((list @) a))) + %- star + ;~ pose + nud + low + hep + cab + (cold ' ' dot) + (cook tuft (ifix [sig dot] hex)) + ;~(pfix sig ;~(pose sig dot)) + == + ++ voy ;~(pfix bas ;~(pose bas soq bix)) + -- +++ ag + |% + ++ ape |*(fel=rule ;~(pose (cold `@`0 (just '0')) fel)) + ++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab))))) + ++ bip =+ tod=(ape qex:ab) + (bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod)))) + ++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab))))) + ++ dim (ape dip) + ++ dip (bass 10 ;~(plug sed:ab (star sid:ab))) + ++ dum (bass 10 (plus sid:ab)) + ++ fed %+ cook fynd:ob + ;~ pose + %+ bass 0x1.0000.0000.0000.0000 :: oversized + ;~ plug + huf:ab + (plus ;~(pfix doh hyf:ab)) + == + hof:ab :: planet or moon + haf:ab :: star + tiq:ab :: galaxy + == + ++ feq %+ cook |=(a=(list @) (rep 4 (flop a))) + ;~ plug + ;~(pose hif:ab tiq:ab) + (star ;~(pfix dof hif:ab)) + == + ++ fim (sear den:fa (bass 58 (plus fem:ab))) + ++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab))))) + ++ lip =+ tod=(ape ted:ab) + (bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod)))) + ++ mot ;~ pose + ;~ pfix + (just '1') + (cook |=(a=@ (add 10 (sub a '0'))) (shim '0' '2')) + == + sed:ab + == + ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab))))) + ++ vum (bass 32 (plus siv:ab)) + ++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab))))) + -- +++ mu + |_ [top=@ bot=@] + ++ zag [p=(end 4 (add top bot)) q=bot] + ++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot] + ++ zug (mix (lsh 4 top) bot) + -- +++ ne + |_ tig=@ + ++ c (cut 3 [tig 1] key:fa) + ++ d (add tig '0') + ++ x ?:((gte tig 10) (add tig 87) d) + ++ v ?:((gte tig 10) (add tig 87) d) + ++ w ?:(=(tig 63) '~' ?:(=(tig 62) '-' ?:((gte tig 36) (add tig 29) x))) + -- +:: +:: 4k: atom printing ++| %atom-printing +:: +++ co + !: + ~% %co ..co ~ + =< |_ lot=coin + ++ rear |=(rom=tape rend(rep rom)) + ++ rent ~+ `@ta`(rap 3 rend) + ++ rend + ^- tape + ~+ + ?: ?=(%blob -.lot) + ['~' '0' ((v-co 1) (jam p.lot))] + ?: ?=(%many -.lot) + :- '.' + |- ^- tape + ?~ p.lot + ['_' '_' rep] + ['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))] + =+ [yed=(end 3 p.p.lot) hay=(cut 3 [1 1] p.p.lot)] + |- ^- tape + ?+ yed (z-co q.p.lot) + %c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)] + %d + ?+ hay (z-co q.p.lot) + %a + =+ yod=(yore q.p.lot) + =? rep ?=(^ f.t.yod) ['.' (s-co f.t.yod)] + =? rep !&(?=(~ f) =(0 h) =(0 m) =(0 s)):t.yod + =. rep ['.' (y-co s.t.yod)] + =. rep ['.' (y-co m.t.yod)] + ['.' '.' (y-co h.t.yod)] + =. rep ['.' (a-co d.t.yod)] + =. rep ['.' (a-co m.yod)] + =? rep !a.yod ['-' rep] + ['~' (a-co y.yod)] + :: + %r + =+ yug=(yell q.p.lot) + =? rep ?=(^ f.yug) ['.' (s-co f.yug)] + :- '~' + ?: &(=(0 d.yug) =(0 m.yug) =(0 h.yug) =(0 s.yug)) + ['s' '0' rep] + =? rep !=(0 s.yug) ['.' 's' (a-co s.yug)] + =? rep !=(0 m.yug) ['.' 'm' (a-co m.yug)] + =? rep !=(0 h.yug) ['.' 'h' (a-co h.yug)] + =? rep !=(0 d.yug) ['.' 'd' (a-co d.yug)] + +.rep + == + :: + %f + ?: =(& q.p.lot) + ['.' 'y' rep] + ?:(=(| q.p.lot) ['.' 'n' rep] (z-co q.p.lot)) + :: + %n ['~' rep] + %i + ?+ hay (z-co q.p.lot) + %f ((ro-co [3 10 4] |=(a=@ ~(d ne a))) q.p.lot) + %s ((ro-co [4 16 8] |=(a=@ ~(x ne a))) q.p.lot) + == + :: + %p + =+ sxz=(fein:ob q.p.lot) + =+ dyx=(met 3 sxz) + :- '~' + ?: (lte dyx 1) + (weld (trip (tod:po sxz)) rep) + =+ dyy=(met 4 sxz) + =| imp=@ud + |- ^- tape + ?: =(imp dyy) + rep + %= $ + imp +(imp) + rep =/ log (cut 4 [imp 1] sxz) + ;: weld + (trip (tos:po (rsh 3 log))) + (trip (tod:po (end 3 log))) + ?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-") + rep + == == + :: + %q + :+ '.' '~' + =; res=(pair ? tape) + (weld q.res rep) + %+ roll + =* val q.p.lot + ?:(=(0 val) ~[0] (rip 3 val)) + |= [q=@ s=? r=tape] + :- !s + %+ weld + (trip (?:(s tod:po tos:po) q)) + ?.(&(s !=(r "")) r ['-' r]) + :: + %r + ?+ hay (z-co q.p.lot) + %d ['.' '~' (r-co (rlyd q.p.lot))] + %h ['.' '~' '~' (r-co (rlyh q.p.lot))] + %q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))] + %s ['.' (r-co (rlys q.p.lot))] + == + :: + %u + ?: ?=(%c hay) + %+ welp ['0' 'c' (reap (pad:fa q.p.lot) '1')] + (c-co (enc:fa q.p.lot)) + :: + =; gam=(pair tape tape) + (weld p.gam ?:(=(0 q.p.lot) `tape`['0' ~] q.gam)) + ?+ hay [~ ((ox-co [10 3] |=(a=@ ~(d ne a))) q.p.lot)] + %b [['0' 'b' ~] ((ox-co [2 4] |=(a=@ ~(d ne a))) q.p.lot)] + %i [['0' 'i' ~] ((d-co 1) q.p.lot)] + %x [['0' 'x' ~] ((ox-co [16 4] |=(a=@ ~(x ne a))) q.p.lot)] + %v [['0' 'v' ~] ((ox-co [32 5] |=(a=@ ~(x ne a))) q.p.lot)] + %w [['0' 'w' ~] ((ox-co [64 5] |=(a=@ ~(w ne a))) q.p.lot)] + == + :: + %s + %+ weld + ?:((syn:si q.p.lot) "--" "-") + $(yed 'u', q.p.lot (abs:si q.p.lot)) + :: + %t + ?: =('a' hay) + ?: =('s' (cut 3 [2 1] p.p.lot)) + (weld (rip 3 q.p.lot) rep) + ['~' '.' (weld (rip 3 q.p.lot) rep)] + ['~' '~' (weld (rip 3 (wood q.p.lot)) rep)] + == + -- + =| rep=tape + =< |% + :: rendering idioms, output zero-padded to minimum lengths + :: + :: +a-co: decimal + :: +c-co: base58check + :: +d-co: decimal, takes minimum output digits + :: +r-co: floating point + :: +s-co: list of '.'-prefixed base16, 4 digit minimum + :: +v-co: base32, takes minimum output digits + :: +w-co: base64, takes minimum output digits + :: +x-co: base16, takes minimum output digits + :: +y-co: decimal, 2 digit minimum + :: +z-co: '0x'-prefixed base16 + :: + ++ a-co |=(dat=@ ((d-co 1) dat)) + ++ c-co (em-co [58 1] |=([? b=@ c=tape] [~(c ne b) c])) + ++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c]))) + :: + ++ r-co + |= a=dn + ?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rep) + ?: ?=([%n *] a) (weld "nan" rep) + =; rep ?:(s.a rep ['-' rep]) + =/ f ((d-co 1) a.a) + =^ e e.a + =/ e=@s (sun:si (lent f)) + =/ sci :(sum:si e.a e -1) + ?: (syn:si (dif:si e.a --3)) [--1 sci] :: 12000 -> 12e3 e>+2 + ?: !(syn:si (dif:si sci -2)) [--1 sci] :: 0.001 -> 1e-3 e<-2 + [(sum:si sci --1) --0] :: 1.234e2 -> '.'@3 -> 123 .4 + =? rep !=(--0 e.a) + :(weld ?:((syn:si e.a) "e" "e-") ((d-co 1) (abs:si e.a))) + (weld (ed-co e f) rep) + :: + ++ s-co + |= esc=(list @) ^- tape + ?~ esc rep + ['.' =>(.(rep $(esc t.esc)) ((x-co 4) i.esc))] + :: + ++ v-co |=(min=@ (em-co [32 min] |=([? b=@ c=tape] [~(v ne b) c]))) + ++ w-co |=(min=@ (em-co [64 min] |=([? b=@ c=tape] [~(w ne b) c]))) + ++ x-co |=(min=@ (em-co [16 min] |=([? b=@ c=tape] [~(x ne b) c]))) + ++ y-co |=(dat=@ ((d-co 2) dat)) + ++ z-co |=(dat=@ `tape`['0' 'x' ((x-co 1) dat)]) + -- + |% + :: +em-co: format in numeric base + :: + :: in .bas, format .min digits of .hol with .par + :: + :: - .hol is processed least-significant digit first + :: - all available digits in .hol will be processed, but + :: .min digits can exceed the number available in .hol + :: - .par handles all accumulated output on each call, + :: and can edit it, prepend or append digits, &c + :: - until .hol is exhausted, .par's sample is [| digit output], + :: subsequently, it's [& 0 output] + :: + ++ em-co + |= [[bas=@ min=@] par=$-([? @ tape] tape)] + |= hol=@ + ^- tape + ?: &(=(0 hol) =(0 min)) + rep + =/ [dar=@ rad=@] (dvr hol bas) + %= $ + min ?:(=(0 min) 0 (dec min)) + hol dar + rep (par =(0 dar) rad rep) + == + :: + :: +ed-co: format in numeric base, with output length + :: + :: - like +em-co, but .par's sample will be [| digit output] + :: on the first call, regardless of the available digits in .hol + :: - used only for @r* floats + :: + ++ ed-co + |= [exp=@s int=tape] ^- tape + =/ [pos=? dig=@u] [=(--1 (cmp:si exp --0)) (abs:si exp)] + ?. pos + (into (weld (reap +(dig) '0') int) 1 '.') + =/ len (lent int) + ?: (lth dig len) (into int dig '.') + (weld int (reap (sub dig len) '0')) + :: + :: +ox-co: format '.'-separated digit sequences in numeric base + :: + :: in .bas, format each digit of .hol with .dug, + :: with '.' separators every .gop digits. + :: + :: - .hol is processed least-significant digit first + :: - .dug handles individual digits, output is prepended + :: - every segment but the last is zero-padded to .gop + :: + ++ ox-co + |= [[bas=@ gop=@] dug=$-(@ @)] + %+ em-co + [(pow bas gop) 0] + |= [top=? seg=@ res=tape] + %+ weld + ?:(top ~ `tape`['.' ~]) + %. seg + %+ em-co(rep res) + [bas ?:(top 0 gop)] + |=([? b=@ c=tape] [(dug b) c]) + :: + :: +ro-co: format '.'-prefixed bloqs in numeric base + :: + :: in .bas, for .buz bloqs 0 to .dop, format at least one + :: digit of .hol, prefixed with '.' + :: + :: - used only for @i* addresses + :: + ++ ro-co + |= [[buz=@ bas=@ dop=@] dug=$-(@ @)] + |= hol=@ + ^- tape + ?: =(0 dop) + rep + :- '.' + =/ pod (dec dop) + %. (cut buz [pod 1] hol) + %+ em-co(rep $(dop pod)) + [bas 1] + |=([? b=@ c=tape] [(dug b) c]) + -- +:: +:: 4l: atom parsing ++| %atom-parsing +:: +++ so + ~% %so + ~ + |% + ++ bisk + ~+ + ;~ pose + ;~ pfix (just '0') + ;~ pose + (stag %ub ;~(pfix (just 'b') bay:ag)) + (stag %uc ;~(pfix (just 'c') fim:ag)) + (stag %ui ;~(pfix (just 'i') dim:ag)) + (stag %ux ;~(pfix (just 'x') hex:ag)) + (stag %uv ;~(pfix (just 'v') viz:ag)) + (stag %uw ;~(pfix (just 'w') wiz:ag)) + == + == + (stag %ud dem:ag) + == + ++ crub + ~+ + ;~ pose + (cook |=(det=date `dime`[%da (year det)]) when) + :: + %+ cook + |= [a=(list [p=?(%d %h %m %s) q=@]) b=(list @)] + =+ rop=`tarp`[0 0 0 0 b] + |- ^- dime + ?~ a + [%dr (yule rop)] + ?- p.i.a + %d $(a t.a, d.rop (add q.i.a d.rop)) + %h $(a t.a, h.rop (add q.i.a h.rop)) + %m $(a t.a, m.rop (add q.i.a m.rop)) + %s $(a t.a, s.rop (add q.i.a s.rop)) + == + ;~ plug + %+ most + dot + ;~ pose + ;~(pfix (just 'd') (stag %d dim:ag)) + ;~(pfix (just 'h') (stag %h dim:ag)) + ;~(pfix (just 'm') (stag %m dim:ag)) + ;~(pfix (just 's') (stag %s dim:ag)) + == + ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~)) + == + :: + (stag %p fed:ag) + ;~(pfix dot (stag %ta urs:ab)) + ;~(pfix sig (stag %t urx:ab)) + ;~(pfix hep (stag %c (cook taft urx:ab))) + == + ++ nuck + ~/ %nuck |= a=nail %. a + %+ knee *coin |. ~+ + %- stew + ^. stet ^. limo + :~ :- ['a' 'z'] (cook |=(a=@ta [%$ %tas a]) sym) + :- ['0' '9'] (stag %$ bisk) + :- '-' (stag %$ tash) + :- '.' ;~(pfix dot perd) + :- '~' ;~(pfix sig ;~(pose twid (easy [%$ %n 0]))) + == + ++ nusk + ~+ + :(sear |=(a=@ta (rush a nuck)) wick urt:ab) + ++ perd + ~+ + ;~ pose + (stag %$ zust) + (stag %many (ifix [cab ;~(plug cab cab)] (more cab nusk))) + == + ++ royl + ~+ + ;~ pose + (stag %rh royl-rh) + (stag %rq royl-rq) + (stag %rd royl-rd) + (stag %rs royl-rs) + == + :: + ++ royl-rh (cook rylh ;~(pfix ;~(plug sig sig) (cook royl-cell royl-rn))) + ++ royl-rq (cook rylq ;~(pfix ;~(plug sig sig sig) (cook royl-cell royl-rn))) + ++ royl-rd (cook ryld ;~(pfix sig (cook royl-cell royl-rn))) + ++ royl-rs (cook ryls (cook royl-cell royl-rn)) + :: + ++ royl-rn + =/ moo + |= a=tape + :- (lent a) + (scan a (bass 10 (plus sid:ab))) + ;~ pose + ;~ plug + (easy %d) + ;~(pose (cold | hep) (easy &)) + ;~ plug dim:ag + ;~ pose + ;~(pfix dot (cook moo (plus (shim '0' '9')))) + (easy [0 0]) + == + ;~ pose + ;~ pfix + (just 'e') + ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag) + == + (easy [& 0]) + == + == + == + :: + ;~ plug + (easy %i) + ;~ sfix + ;~(pose (cold | hep) (easy &)) + (jest 'inf') + == + == + :: + ;~ plug + (easy %n) + (cold ~ (jest 'nan')) + == + == + :: + ++ royl-cell + |= rn + ^- dn + ?. ?=([%d *] +<) +< + =+ ^= h + (dif:si (new:si f.b i.b) (sun:si d.b)) + [%d a h (add (mul c.b (pow 10 d.b)) e.b)] + :: + ++ tash + ~+ + =+ ^= neg + |= [syn=? mol=dime] ^- dime + ?> =('u' (end 3 p.mol)) + [(cat 3 's' (rsh 3 p.mol)) (new:si syn q.mol)] + ;~ pfix hep + ;~ pose + (cook |=(a=dime (neg | a)) bisk) + ;~(pfix hep (cook |=(a=dime (neg & a)) bisk)) + == + == + :: + ++ twid + ~+ + ;~ pose + %+ stag %blob + %+ sear |=(a=@ (mole |.((cue a)))) + ;~(pfix (just '0') vum:ag) + :: + (stag %$ crub) + == + :: + ++ when + ~+ + ;~ plug + %+ cook + |=([a=@ b=?] [b a]) + ;~(plug dim:ag ;~(pose (cold | hep) (easy &))) + ;~(pfix dot mot:ag) :: month + ;~(pfix dot dip:ag) :: day + ;~ pose + ;~ pfix + ;~(plug dot dot) + ;~ plug + dum:ag + ;~(pfix dot dum:ag) + ;~(pfix dot dum:ag) + ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~)) + == + == + (easy [0 0 0 ~]) + == + == + :: + ++ zust + ~+ + ;~ pose + (stag %is bip:ag) + (stag %if lip:ag) + royl + (stag %f ;~(pose (cold & (just 'y')) (cold | (just 'n')))) + (stag %q ;~(pfix sig feq:ag)) + == + -- +:: +:: 4m: formatting functions ++| %formatting-functions +++ scot + ~/ %scot + |=(mol=dime ~(rent co %$ mol)) +++ scow + ~/ %scow + |=(mol=dime ~(rend co %$ mol)) +++ slat |=(mod=@tas |=(txt=@ta (slaw mod txt))) +++ slav |=([mod=@tas txt=@ta] (need (slaw mod txt))) +++ slaw + ~/ %slaw + |= [mod=@tas txt=@ta] + ^- (unit @) + ?+ mod + :: slow fallback case to the full slay + :: + =+ con=(slay txt) + ?.(&(?=([~ %$ @ @] con) =(p.p.u.con mod)) ~ [~ q.p.u.con]) + :: + %da + (rush txt ;~(pfix sig (cook year when:so))) + :: + %p + (rush txt ;~(pfix sig fed:ag)) + :: + %ud + (rush txt dem:ag) + :: + %ux + (rush txt ;~(pfix (jest '0x') hex:ag)) + :: + %uv + (rush txt ;~(pfix (jest '0v') viz:ag)) + :: + %ta + (rush txt ;~(pfix ;~(plug sig dot) urs:ab)) + :: + %tas + (rush txt sym) + == +:: +++ slay + |= txt=@ta ^- (unit coin) + =+ ^= vex + ?: (gth 0x7fff.ffff txt) :: XX petty cache + ~+ ((full nuck:so) [[1 1] (trip txt)]) + ((full nuck:so) [[1 1] (trip txt)]) + ?~ q.vex + ~ + [~ p.u.q.vex] +:: +++ smyt :: pretty print path + |= bon=path ^- tank + :+ %rose [['/' ~] ['/' ~] ~] + (turn bon |=(a=@ [%leaf (trip a)])) +:: +++ spat |=(pax=path (crip (spud pax))) :: render path to cord +++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape +++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path +++ stap :: path parser + %+ sear + |= p=path + ^- (unit path) + ?: ?=([~ ~] p) `~ + ?. =(~ (rear p)) `p + ~ + ;~(pfix fas (most fas urs:ab)) +:: +++ stip :: typed path parser + =< swot + |% + ++ swot |=(n=nail (;~(pfix fas (more fas spot)) n)) + :: + ++ spot + %+ sear (soft iota) + %- stew + ^. stet ^. limo + :~ :- 'a'^'z' (stag %tas sym) + :- '$' (cold [%tas %$] buc) + :- '0'^'9' bisk:so + :- '-' tash:so + :- '.' zust:so + :- '~' ;~(pfix sig ;~(pose crub:so (easy [%n ~]))) + :- '\'' (stag %t qut) + == + -- +:: +++ pout + |= =pith + ^- path + %+ turn pith + |= i=iota + ?@(i i (scot i)) +:: +++ pave + |= =path + ^- pith + %+ turn path + |= i=@ta + (fall (rush i spot:stip) [%ta i]) +:: +:: 4n: virtualization ++| %virtualization +:: +:: +mack: untyped, scry-less, unitary virtualization +:: +++ mack + |= [sub=* fol=*] + ^- (unit) + =/ ton (mink [sub fol] |~(^ ~)) + ?.(?=(%0 -.ton) ~ `product.ton) +:: +mink: raw virtual nock +:: +++ mink !. + ~/ %mink + |= $: [subject=* formula=*] + scry=$-(^ (unit (unit))) + == + =| trace=(list [@ta *]) + |^ ^- tone + ?+ formula [%2 trace] + [^ *] + =/ head $(formula -.formula) + ?. ?=(%0 -.head) head + =/ tail $(formula +.formula) + ?. ?=(%0 -.tail) tail + [%0 product.head product.tail] + :: + [%0 axis=@] + =/ part (frag axis.formula subject) + ?~ part [%2 trace] + [%0 u.part] + :: + [%1 constant=*] + [%0 constant.formula] + :: + [%2 subject=* formula=*] + =/ subject $(formula subject.formula) + ?. ?=(%0 -.subject) subject + =/ formula $(formula formula.formula) + ?. ?=(%0 -.formula) formula + %= $ + subject product.subject + formula product.formula + == + :: + [%3 argument=*] + =/ argument $(formula argument.formula) + ?. ?=(%0 -.argument) argument + [%0 .?(product.argument)] + :: + [%4 argument=*] + =/ argument $(formula argument.formula) + ?. ?=(%0 -.argument) argument + ?^ product.argument [%2 trace] + [%0 .+(product.argument)] + :: + [%5 a=* b=*] + =/ a $(formula a.formula) + ?. ?=(%0 -.a) a + =/ b $(formula b.formula) + ?. ?=(%0 -.b) b + [%0 =(product.a product.b)] + :: + [%6 test=* yes=* no=*] + =/ result $(formula test.formula) + ?. ?=(%0 -.result) result + ?+ product.result + [%2 trace] + %& $(formula yes.formula) + %| $(formula no.formula) + == + :: + [%7 subject=* next=*] + =/ subject $(formula subject.formula) + ?. ?=(%0 -.subject) subject + %= $ + subject product.subject + formula next.formula + == + :: + [%8 head=* next=*] + =/ head $(formula head.formula) + ?. ?=(%0 -.head) head + %= $ + subject [product.head subject] + formula next.formula + == + :: + [%9 axis=@ core=*] + =/ core $(formula core.formula) + ?. ?=(%0 -.core) core + =/ arm (frag axis.formula product.core) + ?~ arm [%2 trace] + %= $ + subject product.core + formula u.arm + == + :: + [%10 [axis=@ value=*] target=*] + ?: =(0 axis.formula) [%2 trace] + =/ target $(formula target.formula) + ?. ?=(%0 -.target) target + =/ value $(formula value.formula) + ?. ?=(%0 -.value) value + =/ mutant=(unit *) + (edit axis.formula product.target product.value) + ?~ mutant [%2 trace] + [%0 u.mutant] + :: + [%11 tag=@ next=*] + =/ next $(formula next.formula) + ?. ?=(%0 -.next) next + :- %0 + .* subject + [11 tag.formula 1 product.next] + :: + [%11 [tag=@ clue=*] next=*] + =/ clue $(formula clue.formula) + ?. ?=(%0 -.clue) clue + =/ next + =? trace + ?=(?(%hunk %hand %lose %mean %spot) tag.formula) + [[tag.formula product.clue] trace] + $(formula next.formula) + ?. ?=(%0 -.next) next + :- %0 + .* subject + [11 [tag.formula 1 product.clue] 1 product.next] + :: + [%12 ref=* path=*] + =/ ref $(formula ref.formula) + ?. ?=(%0 -.ref) ref + =/ path $(formula path.formula) + ?. ?=(%0 -.path) path + =/ result (scry product.ref product.path) + ?~ result + [%1 product.path] + ?~ u.result + [%2 [%hunk product.ref product.path] trace] + [%0 u.u.result] + == + :: + ++ frag + |= [axis=@ noun=*] + ^- (unit) + ?: =(0 axis) ~ + |- ^- (unit) + ?: =(1 axis) `noun + ?@ noun ~ + =/ pick (cap axis) + %= $ + axis (mas axis) + noun ?-(pick %2 -.noun, %3 +.noun) + == + :: + ++ edit + |= [axis=@ target=* value=*] + ^- (unit) + ?: =(1 axis) `value + ?@ target ~ + =/ pick (cap axis) + =/ mutant + %= $ + axis (mas axis) + target ?-(pick %2 -.target, %3 +.target) + == + ?~ mutant ~ + ?- pick + %2 `[u.mutant +.target] + %3 `[-.target u.mutant] + == + -- +:: +mock: virtual nock +:: +++ mock + |= [[sub=* fol=*] gul=$-(^ (unit (unit)))] + (mook (mink [sub fol] gul)) +:: +mook: convert %tone to %toon, rendering stack frames +:: +++ mook + |= ton=tone + ^- toon + ?. ?=([%2 *] ton) + ton + |^ [%2 (turn skip rend)] + :: + ++ skip + ^+ trace.ton + =/ yel (lent trace.ton) + ?. (gth yel 1.024) trace.ton + %+ weld + (scag 512 trace.ton) + ^+ trace.ton + :_ (slag (sub yel 512) trace.ton) + :- %lose + (crip "[skipped {(scow %ud (sub yel 1.024))} frames]") + :: + :: +rend: raw stack frame to tank + :: + :: $% [%hunk ref=* path] :: failed scry ([~ ~]) + :: [%lose cord] :: skipped frames + :: [%hand *] :: mug any + :: [%mean $@(cord (trap tank))] :: ~_ et al + :: [%spot spot] :: source location + :: == + :: + ++ rend + |= [tag=@ta dat=*] + ^- tank + ?+ tag + :: + leaf+"mook.{(rip 3 tag)}" + :: + %hunk + ?@ dat leaf+"mook.hunk" + =/ sof=(unit path) ((soft path) +.dat) + ?~ sof leaf+"mook.hunk" + (smyt u.sof) + :: + %lose + ?^ dat leaf+"mook.lose" + leaf+(rip 3 dat) + :: + %hand + leaf+(scow %p (mug dat)) + :: + %mean + ?@ dat leaf+(rip 3 dat) + =/ mac (mack dat -.dat) + ?~ mac leaf+"####" + =/ sof ((soft tank) u.mac) + ?~ sof leaf+"mook.mean" + u.sof + :: + %spot + =/ sof=(unit spot) ((soft spot) dat) + ?~ sof leaf+"mook.spot" + :+ %rose [":" ~ ~] + :~ (smyt p.u.sof) + =* l p.q.u.sof + =* r q.q.u.sof + =/ ud |=(a=@u (scow %ud a)) + leaf+"<[{(ud p.l)} {(ud q.l)}].[{(ud p.r)} {(ud q.r)}]>" + == + == + -- +:: +mole: typed unitary virtual +:: +++ mole + ~/ %mole + |* tap=(trap) + ^- (unit _$:tap) + =/ mur (mure tap) + ?~(mur ~ `$:tap) +:: +mong: virtual slam +:: +++ mong + |= [[gat=* sam=*] gul=$-(^ (unit (unit)))] + ^- toon + ?. ?=([* ^] gat) [%2 ~] + (mock [gat(+< sam) %9 2 %0 1] gul) +:: +mule: typed virtual +:: +++ mule + ~/ %mule + |* tap=(trap) + =/ mud (mute tap) + ?- -.mud + %& [%& p=$:tap] + %| [%| p=p.mud] + == +:: +mure: untyped unitary virtual +:: +++ mure + |= tap=(trap) + ^- (unit) + =/ ton (mink [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3]))) + ?.(?=(%0 -.ton) ~ `product.ton) +:: +mute: untyped virtual +:: +++ mute + |= tap=(trap) + ^- (each * (list tank)) + =/ ton (mock [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3]))) + ?- -.ton + %0 [%& p.ton] + :: + %1 =/ sof=(unit path) ((soft path) p.ton) + [%| ?~(sof leaf+"mute.hunk" (smyt u.sof)) ~] + :: + %2 [%| p.ton] + == +:: +slum: slam a gate on a sample using raw nock, untyped +:: +++ slum + ~/ %slum + |= sub=[gat=* sam=*] + .*(sub [%9 2 %10 [6 %0 3] %0 2]) +:: +soft: virtual clam +:: +++ soft + |* han=$-(* *) + |=(fud=* (mole |.((han fud)))) +:: +:: 4o: molds and mold builders ++| %molds-and-mold-builders +:: ++$ abel typo :: original sin: type ++$ alas (list (pair term hoon)) :: alias list ++$ atom @ :: just an atom ++$ aura @ta :: atom format ++$ base :: base mold + $@ $? %noun :: any noun + %cell :: any cell + %flag :: loobean + %null :: ~ == 0 + %void :: empty set + == :: + [%atom p=aura] :: atom +:: ++$ woof $@(@ [~ p=hoon]) :: simple embed ++$ chum $? lef=term :: jet name + [std=term kel=@] :: kelvin version + [ven=term pro=term kel=@] :: vendor and product + [ven=term pro=term ver=@ kel=@] :: all of the above + == :: ++$ coil $: p=garb :: name, wet=dry, vary + q=type :: context + r=(pair seminoun (map term tome)) :: chapters + == :: ++$ garb (trel (unit term) poly vair) :: core ++$ poly ?(%wet %dry) :: polarity ++$ foot $% [%dry p=hoon] :: dry arm, geometric + [%wet p=hoon] :: wet arm, generic + == :: ++$ link :: lexical segment + $% [%chat p=term] :: |chapter + [%cone p=aura q=atom] :: %constant + [%frag p=term] :: .face + [%funk p=term] :: +arm + [%plan p=term] :: $spec + == :: ++$ cuff (list link) :: parsed lex segments ++$ crib [summary=cord details=(list sect)] :: ++$ help [=cuff =crib] :: documentation ++$ limb $@ term :: wing element + $% [%& p=axis] :: by geometry + [%| p=@ud q=(unit term)] :: by name + == :: + :: XX more and better sanity + :: ++$ null ~ :: null, nil, etc ++$ onyx (list (pair type foot)) :: arm activation ++$ opal :: limb match + $% [%& p=type] :: leg + [%| p=axis q=(set [p=type q=foot])] :: arm + == :: ++$ pica (pair ? cord) :: & prose, | code ++$ palo (pair vein opal) :: wing trace, match ++$ pock (pair axis nock) :: changes ++$ port (each palo (pair type nock)) :: successful match ++$ spec :: structure definition + $~ [%base %null] :: + $% [%base p=base] :: base type + [%dbug p=spot q=spec] :: set debug + [%gist p=[%help p=help] q=spec] :: formal comment + [%leaf p=term q=@] :: constant atom + [%like p=wing q=(list wing)] :: reference + [%loop p=term] :: hygienic reference + [%made p=(pair term (list term)) q=spec] :: annotate synthetic + [%make p=hoon q=(list spec)] :: composed spec + [%name p=term q=spec] :: annotate simple + [%over p=wing q=spec] :: relative to subject + :: :: + [%bcgr p=spec q=spec] :: $>, filter: require + [%bcbc p=spec q=(map term spec)] :: $$, recursion + [%bcbr p=spec q=hoon] :: $|, verify + [%bccb p=hoon] :: $_, example + [%bccl p=[i=spec t=(list spec)]] :: $:, tuple + [%bccn p=[i=spec t=(list spec)]] :: $%, head pick + [%bcdt p=spec q=(map term spec)] :: $., read-write core + [%bcgl p=spec q=spec] :: $<, filter: exclude + [%bchp p=spec q=spec] :: $-, function core + [%bckt p=spec q=spec] :: $^, cons pick + [%bcls p=stud q=spec] :: $+, standard + [%bcfs p=spec q=(map term spec)] :: $/, write-only core + [%bcmc p=hoon] :: $;, manual + [%bcpm p=spec q=hoon] :: $&, repair + [%bcsg p=hoon q=spec] :: $~, default + [%bctc p=spec q=(map term spec)] :: $`, read-only core + [%bcts p=skin q=spec] :: $=, name + [%bcpt p=spec q=spec] :: $@, atom pick + [%bcwt p=[i=spec t=(list spec)]] :: $?, full pick + [%bczp p=spec q=(map term spec)] :: $!, opaque core + == :: ++$ tent :: model builder + $% [%| p=wing q=tent r=(list spec)] :: ~(p q r...) + [%& p=(list wing)] :: a.b:c.d + == :: ++$ tiki :: test case + $% [%& p=(unit term) q=wing] :: simple wing + [%| p=(unit term) q=hoon] :: named wing + == :: ++$ skin :: texture + $@ =term :: name/~[term %none] + $% [%base =base] :: base match + [%cell =skin =skin] :: pair + [%dbug =spot =skin] :: trace + [%leaf =aura =atom] :: atomic constant + [%help =help =skin] :: describe + [%name =term =skin] :: apply label + [%over =wing =skin] :: relative to + [%spec =spec =skin] :: cast to + [%wash depth=@ud] :: strip faces + == :: ++$ tome (pair what (map term hoon)) :: core chapter ++$ tope :: topographic type + $@ $? %& :: cell or atom + %| :: atom + == :: + (pair tope tope) :: cell +++ hoot :: hoon tools + |% + +$ beer $@(char [~ p=hoon]) :: simple embed + +$ mane $@(@tas [@tas @tas]) :: XML name+space + +$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node + +$ marl (list tuna) :: dynamic XML nodes + +$ mart (list [n=mane v=(list beer)]) :: dynamic XML attrs + +$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag + +$ mare (each manx marl) :: node or nodes + +$ maru (each tuna marl) :: interp or nodes + +$ tuna :: maybe interpolation + $~ [[%$ ~] ~] + $^ manx + $: ?(%tape %manx %marl %call) + p=hoon + == + -- :: ++$ hoon :: hoon AST + $~ [%zpzp ~] :: + $^ [p=hoon q=hoon] :: + $% :: + [%$ p=axis] :: simple leg + :: :: + [%base p=base] :: base spec + [%bust p=base] :: bunt base + [%dbug p=spot q=hoon] :: debug info in trace + [%eror p=tape] :: assembly error + [%hand p=type q=nock] :: premade result + [%note p=note q=hoon] :: annotate + [%fits p=hoon q=wing] :: underlying ?= + [%knit p=(list woof)] :: assemble string + [%leaf p=(pair term @)] :: symbol spec + [%limb p=term] :: take limb + [%lost p=hoon] :: not to be taken + [%rock p=term q=*] :: fixed constant + [%sand p=term q=*] :: unfixed constant + [%tell p=(list hoon)] :: render as tape + [%tune p=$@(term tune)] :: minimal face + [%wing p=wing] :: take wing + [%yell p=(list hoon)] :: render as tank + [%xray p=manx:hoot] :: ;foo; templating + :: :::::: cores + [%brbc sample=(lest term) body=spec] :: |$ + [%brcb p=spec q=alas r=(map term tome)] :: |_ + [%brcl p=hoon q=hoon] :: |: + [%brcn p=(unit term) q=(map term tome)] :: |% + [%brdt p=hoon] :: |. + [%brkt p=hoon q=(map term tome)] :: |^ + [%brhp p=hoon] :: |- + [%brsg p=spec q=hoon] :: |~ + [%brtr p=spec q=hoon] :: |* + [%brts p=spec q=hoon] :: |= + [%brpt p=(unit term) q=(map term tome)] :: |@ + [%brwt p=hoon] :: |? + :: :::::: tuples + [%clcb p=hoon q=hoon] :: :_ [q p] + [%clkt p=hoon q=hoon r=hoon s=hoon] :: :^ [p q r s] + [%clhp p=hoon q=hoon] :: :- [p q] + [%clls p=hoon q=hoon r=hoon] :: :+ [p q r] + [%clsg p=(list hoon)] :: :~ [p ~] + [%cltr p=(list hoon)] :: :* p as a tuple + :: :::::: invocations + [%cncb p=wing q=(list (pair wing hoon))] :: %_ + [%cndt p=hoon q=hoon] :: %. + [%cnhp p=hoon q=hoon] :: %- + [%cncl p=hoon q=(list hoon)] :: %: + [%cntr p=wing q=hoon r=(list (pair wing hoon))] :: %* + [%cnkt p=hoon q=hoon r=hoon s=hoon] :: %^ + [%cnls p=hoon q=hoon r=hoon] :: %+ + [%cnsg p=wing q=hoon r=(list hoon)] :: %~ + [%cnts p=wing q=(list (pair wing hoon))] :: %= + :: :::::: nock + [%dtkt p=spec q=hoon] :: .^ nock 11 + [%dtls p=hoon] :: .+ nock 4 + [%dttr p=hoon q=hoon] :: .* nock 2 + [%dtts p=hoon q=hoon] :: .= nock 5 + [%dtwt p=hoon] :: .? nock 3 + :: :::::: type conversion + [%ktbr p=hoon] :: ^| contravariant + [%ktdt p=hoon q=hoon] :: ^. self-cast + [%ktls p=hoon q=hoon] :: ^+ expression cast + [%kthp p=spec q=hoon] :: ^- structure cast + [%ktpm p=hoon] :: ^& covariant + [%ktsg p=hoon] :: ^~ constant + [%ktts p=skin q=hoon] :: ^= label + [%ktwt p=hoon] :: ^? bivariant + [%kttr p=spec] :: ^* example + [%ktcl p=spec] :: ^: filter + :: :::::: hints + [%sgbr p=hoon q=hoon] :: ~| sell on trace + [%sgcb p=hoon q=hoon] :: ~_ tank on trace + [%sgcn p=chum q=hoon r=tyre s=hoon] :: ~% general jet hint + [%sgfs p=chum q=hoon] :: ~/ function j-hint + [%sggl p=$@(term [p=term q=hoon]) q=hoon] :: ~< backward hint + [%sggr p=$@(term [p=term q=hoon]) q=hoon] :: ~> forward hint + [%sgbc p=term q=hoon] :: ~$ profiler hit + [%sgls p=@ q=hoon] :: ~+ cache=memoize + [%sgpm p=@ud q=hoon r=hoon] :: ~& printf=priority + [%sgts p=hoon q=hoon] :: ~= don't duplicate + [%sgwt p=@ud q=hoon r=hoon s=hoon] :: ~? tested printf + [%sgzp p=hoon q=hoon] :: ~! type on trace + :: :::::: miscellaneous + [%mcts p=marl:hoot] :: ;= list templating + [%mccl p=hoon q=(list hoon)] :: ;: binary to nary + [%mcfs p=hoon] :: ;/ [%$ [%$ p ~] ~] + [%mcgl p=spec q=hoon r=hoon s=hoon] :: ;< bind + [%mcsg p=hoon q=(list hoon)] :: ;~ kleisli arrow + [%mcmc p=spec q=hoon] :: ;; normalize + :: :::::: compositions + [%tsbr p=spec q=hoon] :: =| push bunt + [%tscl p=(list (pair wing hoon)) q=hoon] :: =: q w= p changes + [%tsfs p=skin q=hoon r=hoon] :: =/ typed variable + [%tsmc p=skin q=hoon r=hoon] :: =; =/(q p r) + [%tsdt p=wing q=hoon r=hoon] :: =. r with p as q + [%tswt p=wing q=hoon r=hoon s=hoon] :: =? conditional =. + [%tsgl p=hoon q=hoon] :: =< =>(q p) + [%tshp p=hoon q=hoon] :: =- =+(q p) + [%tsgr p=hoon q=hoon] :: => q w=subject p + [%tskt p=skin q=wing r=hoon s=hoon] :: =^ state machine + [%tsls p=hoon q=hoon] :: =+ q w=[p subject] + [%tssg p=(list hoon)] :: =~ hoon stack + [%tstr p=(pair term (unit spec)) q=hoon r=hoon] :: =* new style + [%tscm p=hoon q=hoon] :: =, overload p in q + :: :::::: conditionals + [%wtbr p=(list hoon)] :: ?| loobean or + [%wthp p=wing q=(list (pair spec hoon))] :: ?- pick case in q + [%wtcl p=hoon q=hoon r=hoon] :: ?: if=then=else + [%wtdt p=hoon q=hoon r=hoon] :: ?. ?:(p r q) + [%wtkt p=wing q=hoon r=hoon] :: ?^ if p is a cell + [%wtgl p=hoon q=hoon] :: ?< ?:(p !! q) + [%wtgr p=hoon q=hoon] :: ?> ?:(p q !!) + [%wtls p=wing q=hoon r=(list (pair spec hoon))] :: ?+ ?- w=default + [%wtpm p=(list hoon)] :: ?& loobean and + [%wtpt p=wing q=hoon r=hoon] :: ?@ if p is atom + [%wtsg p=wing q=hoon r=hoon] :: ?~ if p is null + [%wthx p=skin q=wing] :: ?# if q matches p + [%wtts p=spec q=wing] :: ?= if q matches p + [%wtzp p=hoon] :: ?! loobean not + :: :::::: special + [%zpcm p=hoon q=hoon] :: !, + [%zpgr p=hoon] :: !> + [%zpgl p=spec q=hoon] :: !< + [%zpmc p=hoon q=hoon] :: !; + [%zpts p=hoon] :: != + [%zppt p=(list wing) q=hoon r=hoon] :: !@ + [%zpwt p=$@(p=@ [p=@ q=@]) q=hoon] :: !? + [%zpzp ~] :: !! + == :: ++$ tyre (list [p=term q=hoon]) :: ++$ tyke (list (unit hoon)) :: +:: :::::: virtual nock ++$ nock $^ [p=nock q=nock] :: autocons + $% [%1 p=*] :: constant + [%2 p=nock q=nock] :: compose + [%3 p=nock] :: cell test + [%4 p=nock] :: increment + [%5 p=nock q=nock] :: equality test + [%6 p=nock q=nock r=nock] :: if, then, else + [%7 p=nock q=nock] :: serial compose + [%8 p=nock q=nock] :: push onto subject + [%9 p=@ q=nock] :: select arm and fire + [%10 p=[p=@ q=nock] q=nock] :: edit + [%11 p=$@(@ [p=@ q=nock]) q=nock] :: hint + [%12 p=nock q=nock] :: grab data from sky + [%0 p=@] :: axis select + == :: ++$ note :: type annotation + $% [%help p=help] :: documentation + [%know p=stud] :: global standard + [%made p=term q=(unit (list wing))] :: structure + == :: ++$ type $~ %noun :: + $@ $? %noun :: any nouns + %void :: no noun + == :: + $% [%atom p=term q=(unit @)] :: atom / constant + [%cell p=type q=type] :: ordered pair + [%core p=type q=coil] :: object + [%face p=$@(term tune) q=type] :: namespace + [%fork p=(set type)] :: union + [%hint p=(pair type note) q=type] :: annotation + [%hold p=type q=hoon] :: lazy evaluation + == :: ++$ tony :: ++tone done right + $% [%0 p=tine q=*] :: success + [%1 p=(set)] :: blocks + [%2 p=(list [@ta *])] :: error ~_s + == :: ++$ tine :: partial noun + $@ ~ :: open + $% [%& p=tine q=tine] :: half-blocked + [%| p=(set)] :: fully blocked + == :: ++$ tool $@(term tune) :: type decoration ++$ tune :: complex + $~ [~ ~] :: + $: p=(map term (unit hoon)) :: aliases + q=(list hoon) :: bridges + == :: ++$ typo type :: old type ++$ vase [p=type q=*] :: type-value pair ++$ vise [p=typo q=*] :: old vase ++$ vial ?(%read %rite %both %free) :: co/contra/in/bi ++$ vair ?(%gold %iron %lead %zinc) :: in/contra/bi/co ++$ vein (list (unit axis)) :: search trace ++$ sect (list pica) :: paragraph ++$ whit :: prefix docs parse + $: bat=(map cuff (pair cord (list sect))) :: batch comment + == :: ++$ whiz cord :: postfix doc parse ++$ what (unit (pair cord (list sect))) :: help slogan/section ++$ wing (list limb) :: search path +:: +:: +block: abstract identity of resource awaited +:: ++$ block + path +:: +:: +result: internal interpreter result +:: ++$ result + $@(~ seminoun) +:: +:: +thunk: fragment constructor +:: ++$ thunk + $-(@ud (unit noun)) +:: +:: +seminoun: +:: ++$ seminoun + :: partial noun; blocked subtrees are ~ + :: + $~ [[%full / ~ ~] ~] + [mask=stencil data=noun] +:: +:: +stencil: noun knowledge map +:: ++$ stencil + $% :: + :: %half: noun has partial block substructure + :: + [%half left=stencil rite=stencil] + :: + :: %full: noun is either fully complete, or fully blocked + :: + [%full blocks=(set block)] + :: + :: %lazy: noun can be generated from virtual subtree + :: + [%lazy fragment=axis resolve=thunk] + == +:: ++$ output + :: ~: interpreter stopped + :: + %- unit + $% :: + :: %done: output is complete + :: + [%done p=noun] + :: + :: %wait: output is waiting for resources + :: + [%wait p=(list block)] + == +:: profiling ++$ doss + $: mon=moan :: sample count + hit=(map term @ud) :: hit points + cut=(map path hump) :: cut points + == ++$ moan :: sample metric + $: fun=@ud :: samples in C + noc=@ud :: samples in nock + glu=@ud :: samples in glue + mal=@ud :: samples in alloc + far=@ud :: samples in frag + coy=@ud :: samples in copy + euq=@ud :: samples in equal + == :: +:: ++$ hump + $: mon=moan :: sample count + out=(map path @ud) :: calls out of + inn=(map path @ud) :: calls into + == +-- +:: +~% %pen + + + == + %ap ap + %ut ut + == +:: layer-5 +:: +|% +:: +:: 5aa: new partial nock interpreter ++| %new-partial-nock-interpreter +:: +++ musk !. :: nock with block set + |% + ++ 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 + :: + done/data.noy + :: reduce block set to block list + :: + wait/~(tap in blocks) + :: + ++ araw + :: execute nock on partial subject + :: + |= $: :: bus: subject, a partial noun + :: fol: formula, a complete noun + :: + bus=seminoun + fol=noun + == + :: interpreter loop + :: + |- ^- 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 + :: + [full/~ 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 + :: + [full/~ .?(fig)] + :: + :: 4; increment + :: + [%4 b=*] + %+ require + $(fol b.fol) + |= :: fig: increment input + :: + fig=noun + :: stop for cells, increment for atoms + :: + ?^(fig ~ [full/~ +(fig)]) + :: + :: 5; compare + :: + [%5 b=* c=*] + %+ require + $(fol b.fol) + |= :: hed: left input + :: + hed=noun + %+ require + ^$(fol c.fol) + |= :: tal: right input + :: + tal=noun + [full/~ =(hed tal)] + :: + :: 6; if-then-else + :: + [%6 b=* c=* d=*] + :: semantic expansion + :: + %+ require + $(fol b.fol) + |= :: fig: boolean + :: + fig=noun + :: apply proper booleans + :: + ?: =(& fig) ^$(fol c.fol) + ?: =(| fig) ^$(fol d.fol) + :: stop on bad test + :: + ~ + :: + :: 7; composition + :: + [%7 b=* c=*] + :: one: input + :: + =+ one=$(fol b.fol) + :: propagate stop + :: + ?~ one ~ + :: complete composition + :: + $(fol c.fol, bus one) + :: + :: 8; introduction + :: + [%8 b=* c=*] + :: one: input + :: + =+ one=$(fol b.fol) + :: propagate stop + :: + ?~ one ~ + :: complete introduction + :: + $(fol c.fol, bus (combine one bus)) + :: + :: 9; invocation + :: + [%9 b=* c=*] + :: semantic expansion + :: + ?^ b.fol ~ + :: one: core + :: + =+ one=$(fol c.fol) + :: propagate stop + :: + ?~ one ~ + :: if core is constant + :: + ?: ?=([[%full ~] *] one) + :: then call virtual nock directly + :: + =+ (mack data.one [%9 b.fol %0 1]) + :: propagate stop + :: + ?~ - ~ + :: produce result + :: + [[%full ~] u.-] + :: else complete call + :: + %+ require + :: retrieve formula + :: + (fragment b.fol one) + :: continue + :: + |=(noun ^$(bus one, fol +<)) + :: + :: 10; edit + :: + [%10 [b=@ c=*] d=*] + :: tar: target of edit + :: + =+ tar=$(fol d.fol) + :: propagate stop + :: + ?~ tar ~ + :: inn: inner value + :: + =+ inn=$(fol c.fol) + :: propagate stop + :: + ?~ inn ~ + (mutate b.fol inn tar) + :: + :: 11; static hint + :: + [%11 @ c=*] + :: ignore hint + :: + $(fol c.fol) + :: + :: 11; dynamic hint + :: + [%11 [b=* c=*] d=*] + :: noy: dynamic hint + :: + =+ noy=$(fol c.fol) + :: propagate stop + :: + ?~ noy ~ + :: if hint is a fully computed trace + :: + ?: &(?=(%spot b.fol) ?=([[%full ~] *] noy)) + :: compute within trace + :: + ~_((show %o +.noy) $(fol d.fol)) + :: else ignore hint + :: + $(fol d.fol) + == + :: + ++ apex + :: execute nock on partial subject + :: + |= $: :: bus: subject, a partial noun + :: fol: formula, a complete noun + :: + bus=seminoun + fol=noun + == + ~+ + ^- output + :: simplify result + :: + (abet (araw bus fol)) + :: + ++ combine + :: combine a pair of seminouns + :: + |= $: :: hed: head of pair + :: tal: tail of pair + :: + hed=seminoun + tal=seminoun + == + ^- seminoun + ?. ?& &(?=(%full -.mask.hed) ?=(%full -.mask.tal)) + =(=(~ blocks.mask.hed) =(~ blocks.mask.tal)) + == + :: default merge + :: + [half/[mask.hed mask.tal] [data.hed data.tal]] + :: both sides total + :: + ?: =(~ blocks.mask.hed) + :: both sides are complete + :: + [full/~ data.hed data.tal] + :: both sides are blocked + :: + [full/(~(uni in blocks.mask.hed) blocks.mask.tal) ~] + :: + ++ complete + :: complete any laziness + :: + |= bus=seminoun + ^- seminoun + ?- -.mask.bus + %full bus + %lazy :: fragment 1 is the whole thing + :: + ?: =(1 fragment.mask.bus) + :: blocked; we can't get fragment 1 while compiling it + :: + [[%full [~ ~ ~]] ~] + :: execute thunk + :: + =+ (resolve.mask.bus fragment.mask.bus) + :: if product is nil + :: + ?~ - + :: then blocked + :: + [[%full [~ ~ ~]] ~] + :: else use value + :: + [[%full ~] u.-] + %half :: recursive descent + :: + %+ combine + $(bus [left.mask.bus -.data.bus]) + $(bus [rite.mask.bus +.data.bus]) + == + :: + ++ 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: top of axis (2 or 3) + :: lat: rest of axis + :: + =+ [now=(cap axe) lat=(mas axe)] + ?- -.mask.bus + %lazy :: propagate laziness + :: + bus(fragment.mask (peg fragment.mask.bus axe)) + :: + %full :: if fully blocked, produce self + :: + ?^ blocks.mask.bus bus + :: descending into atom, stop + :: + ?@ data.bus ~ + :: descend into complete cell + :: + $(axe lat, bus [full/~ ?:(=(2 now) -.data.bus +.data.bus)]) + :: + %half :: descend into partial cell + :: + %= $ + axe lat + bus ?: =(2 now) + [left.mask.bus -.data.bus] + [rite.mask.bus +.data.bus] + == == + :: + ++ mutate + :: change a single axis in a seminoun + :: + |= $: :: axe: axis within big to change + :: lit: (little) seminoun to insert within big at axe + :: big: seminoun to mutate + :: + axe=@ + lit=seminoun + big=seminoun + == + ^- result + :: stop on zero axis + :: + ?~ axe ~ + :: edit root of big means discard it + :: + ?: =(1 axe) lit + :: decompose axis into path of head-tail + :: + |- ^- result + ?: =(2 axe) + :: mutate head of cell + :: + =+ tal=(fragment 3 big) + :: propagate stop + :: + ?~ tal ~ + (combine lit tal) + ?: =(3 axe) + :: mutate tail of cell + :: + =+ hed=(fragment 2 big) + :: propagate stop + :: + ?~ hed ~ + (combine hed lit) + :: deeper axis: keep one side of big and + :: recurse into the other with smaller axe + :: + =+ mor=(mas axe) + =+ hed=(fragment 2 big) + :: propagate stop + :: + ?~ hed ~ + =+ tal=(fragment 3 big) + :: propagate stop + :: + ?~ tal ~ + ?: =(2 (cap axe)) + :: recurse into the head + :: + =+ mut=$(big hed, axe mor) + :: propagate stop + :: + ?~ mut ~ + (combine mut tal) + :: recurse into the tail + :: + =+ mut=$(big tal, axe mor) + :: propagate stop + :: + ?~ mut ~ + (combine hed mut) + :: + ++ require + :: require complete intermediate step + :: + |= $: noy=result + yen=$-(* result) + == + ^- result + :: propagate stop + :: + ?~ noy ~ + :: suppress laziness + :: + =/ bus=seminoun (complete noy) + ?< ?=(%lazy -.mask.bus) + :: if partial block, squash blocks and stop + :: + ?: ?=(%half -.mask.bus) [full/(squash mask.bus) ~] + :: if full block, propagate block + :: + ?: ?=(^ blocks.mask.bus) [mask.bus ~] + :: otherwise use complete noun + :: + (yen data.bus) + :: + ++ squash + :: convert stencil to block set + :: + |= tyn=stencil + ^- (set block) + ?- -.tyn + %lazy $(tyn -:(complete tyn ~)) + %full blocks.tyn + %half (~(uni in $(tyn left.tyn)) $(tyn rite.tyn)) + == + -- +:: +:: 5a: compiler utilities ++| %compiler-utilities +:: +++ bool `type`(fork [%atom %f `0] [%atom %f `1] ~) :: make loobean +++ cell :: make %cell type + ~/ %cell + |= [hed=type tal=type] + ^- type + ?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal])) +:: +++ core :: make %core type + ~/ %core + |= [pac=type con=coil] + ^- type + ?:(=(%void pac) %void [%core pac con]) +:: +++ hint + |= [p=(pair type note) q=type] + ^- type + ?: =(%void q) %void + ?: =(%noun q) %noun + [%hint p q] +:: +++ face :: make %face type + ~/ %face + |= [giz=$@(term tune) der=type] + ^- type + ?: =(%void der) + %void + [%face giz der] +:: +++ fork :: make %fork type + ~/ %fork + |= yed=(list type) + =| lez=(set type) + |- ^- type + ?~ yed + ?~ lez %void + ?: ?=([* ~ ~] lez) n.lez + [%fork lez] + %= $ + yed t.yed + lez + ?: =(%void i.yed) lez + ?: ?=([%fork *] i.yed) (~(uni in lez) p.i.yed) + (~(put in lez) i.yed) + == +:: +++ cove :: extract [0 *] axis + |= nug=nock + ?- nug + [%0 *] p.nug + [%11 *] $(nug q.nug) + * ~_(leaf+"cove" !!) + == +++ comb :: combine two formulas + ~/ %comb + |= [mal=nock buz=nock] + ^- nock + ?: ?&(?=([%0 *] mal) !=(0 p.mal)) + ?: ?&(?=([%0 *] buz) !=(0 p.buz)) + [%0 (peg p.mal p.buz)] + ?: ?=([%2 [%0 *] [%0 *]] buz) + [%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]] + [%7 mal buz] + ?: ?=([^ [%0 %1]] mal) + [%8 p.mal buz] + ?: =([%0 %1] buz) + mal + [%7 mal buz] +:: +++ cond :: ?: compile + ~/ %cond + |= [pex=nock yom=nock woq=nock] + ^- nock + ?- pex + [%1 %0] yom + [%1 %1] woq + * [%6 pex yom woq] + == +:: +++ cons :: make formula cell + ~/ %cons + |= [vur=nock sed=nock] + ^- nock + :: this optimization can remove crashes which are essential + :: + :: ?: ?=([[%0 *] [%0 *]] +<) + :: ?: ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2))) + :: [%0 (div p.vur 2)] + :: [vur sed] + ?: ?=([[%1 *] [%1 *]] +<) + [%1 p.vur p.sed] + [vur sed] +:: +++ fitz :: odor compatibility + ~/ %fitz + |= [yaz=term wix=term] + =+ ^= fiz + |= mot=@ta ^- [p=@ q=@ta] + =+ len=(met 3 mot) + ?: =(0 len) + [0 %$] + =+ tyl=(rsh [3 (dec len)] mot) + ?: &((gte tyl 'A') (lte tyl 'Z')) + [(sub tyl 64) (end [3 (dec len)] mot)] + [0 mot] + =+ [yoz=(fiz yaz) wux=(fiz wix)] + ?& ?| =(0 p.yoz) + =(0 p.wux) + &(!=(0 p.wux) (lte p.wux p.yoz)) + == + |- ?| =(%$ p.yoz) + =(%$ p.wux) + ?& =((end 3 p.yoz) (end 3 p.wux)) + $(p.yoz (rsh 3 p.yoz), p.wux (rsh 3 p.wux)) + == + == + == +:: +++ flan :: loobean & + ~/ %flan + |= [bos=nock nif=nock] + ^- nock + ?: =(bos nif) bos + ?: =([%0 0] bos) nif + ?: =([%0 0] nif) bos + ?- bos + [%1 %1] bos + [%1 %0] nif + * + ?- nif + [%1 %1] nif + [%1 %0] bos + * [%6 bos nif [%1 1]] + == + == +:: +++ flip :: loobean negation + ~/ %flip + |= dyr=nock + ?: =([%0 0] dyr) dyr + [%6 dyr [%1 1] [%1 0]] +:: +++ flor :: loobean | + ~/ %flor + |= [bos=nock nif=nock] + ^- nock + ?: =(bos nif) bos + ?: =([%0 0] bos) nif + ?: =([%0 0] nif) bos + ?- bos + [%1 %1] nif + [%1 %0] bos + * + ?- nif + [%1 %1] bos + [%1 %0] nif + * [%6 bos [%1 0] nif] + == + == +:: +++ hike + ~/ %hike + |= [a=axis pac=(list (pair axis nock))] + |^ =/ rel=(map axis nock) (roll pac insert) + =/ ord=(list axis) (sort ~(tap in ~(key by rel)) gth) + |- ^- nock + ?~ ord + [%0 a] + =/ b=axis i.ord + =/ c=nock (~(got by rel) b) + =/ d=nock $(ord t.ord) + [%10 [b c] d] + :: + ++ contains + |= [container=axis contained=axis] + ^- ? + =/ big=@ (met 0 container) + =/ small=@ (met 0 contained) + ?: (lte small big) | + =/ dif=@ (sub small big) + =(container (rsh [0 dif] contained)) + :: + ++ parent + |= a=axis + `axis`(rsh 0 a) + :: + ++ sibling + |= a=axis + ^- axis + ?~ (mod a 2) + +(a) + (dec a) + :: + ++ insert + |= [e=[axe=axis fol=nock] n=(map axis nock)] + ^- (map axis nock) + ?: =/ a=axis axe.e + |- ^- ? + ?: =(1 a) | + ?: (~(has by n) a) + & + $(a (parent a)) + :: parent already in + n + =. n + :: remove children + %+ roll ~(tap by n) + |= [[axe=axis fol=nock] m=_n] + ?. (contains axe.e axe) m + (~(del by m) axe) + =/ sib (sibling axe.e) + =/ un (~(get by n) sib) + ?~ un (~(put by n) axe.e fol.e) + :: replace sibling with parent + %= $ + n (~(del by n) sib) + e :- (parent sib) + ?: (gth sib axe.e) + (cons fol.e u.un) + (cons u.un fol.e) + == + -- +:: +++ jock + |= rad=? + |= lot=coin ^- hoon + ?- -.lot + ~ + ?:(rad [%rock p.lot] [%sand p.lot]) + :: + %blob + ?: rad + [%rock %$ p.lot] + ?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)]) + :: + %many + [%cltr (turn p.lot |=(a=coin ^$(lot a)))] + == +:: +++ look + ~/ %look + |= [cog=term dab=(map term hoon)] + =+ axe=1 + |- ^- (unit [p=axis q=hoon]) + ?- dab + ~ ~ + :: + [* ~ ~] + ?:(=(cog p.n.dab) [~ axe q.n.dab] ~) + :: + [* ~ *] + ?: =(cog p.n.dab) + [~ (peg axe 2) q.n.dab] + ?: (gor cog p.n.dab) + ~ + $(axe (peg axe 3), dab r.dab) + :: + [* * ~] + ?: =(cog p.n.dab) + [~ (peg axe 2) q.n.dab] + ?: (gor cog p.n.dab) + $(axe (peg axe 3), dab l.dab) + ~ + :: + [* * *] + ?: =(cog p.n.dab) + [~ (peg axe 2) q.n.dab] + ?: (gor cog p.n.dab) + $(axe (peg axe 6), dab l.dab) + $(axe (peg axe 7), dab r.dab) + == +:: +++ loot + ~/ %loot + |= [cog=term dom=(map term tome)] + =+ axe=1 + |- ^- (unit [p=axis q=hoon]) + ?- dom + ~ ~ + :: + [* ~ ~] + %+ bind (look cog q.q.n.dom) + |=((pair axis hoon) [(peg axe p) q]) + :: + [* ~ *] + =+ yep=(look cog q.q.n.dom) + ?^ yep + [~ (peg (peg axe 2) p.u.yep) q.u.yep] + $(axe (peg axe 3), dom r.dom) + :: + [* * ~] + =+ yep=(look cog q.q.n.dom) + ?^ yep + [~ (peg (peg axe 2) p.u.yep) q.u.yep] + $(axe (peg axe 3), dom l.dom) + :: + [* * *] + =+ yep=(look cog q.q.n.dom) + ?^ yep + [~ (peg (peg axe 2) p.u.yep) q.u.yep] + =+ pey=$(axe (peg axe 6), dom l.dom) + ?^ pey pey + $(axe (peg axe 7), dom r.dom) + == +:: +:: 5b: macro expansion ++| %macro-expansions +:: +++ ah :: tiki engine + |_ tik=tiki + ++ blue + |= gen=hoon + ^- hoon + ?. &(?=(%| -.tik) ?=(~ p.tik)) gen + [%tsgr [%$ 3] gen] + :: + ++ teal + |= mod=spec + ^- spec + ?: ?=(%& -.tik) mod + [%over [%& 3]~ mod] + :: + ++ tele + |= syn=skin + ^- skin + ?: ?=(%& -.tik) syn + [%over [%& 3]~ syn] + :: + ++ gray + |= gen=hoon + ^- hoon + ?- -.tik + %& ?~(p.tik gen [%tstr [u.p.tik ~] [%wing q.tik] gen]) + %| [%tsls ?~(p.tik q.tik [%ktts u.p.tik q.tik]) gen] + == + :: + ++ puce + ^- wing + ?- -.tik + %& ?~(p.tik q.tik [u.p.tik ~]) + %| [[%& 2] ~] + == + :: + ++ wthp |= opt=(list (pair spec hoon)) + %+ gray %wthp + [puce (turn opt |=([a=spec b=hoon] [a (blue b)]))] + ++ wtkt |=([sic=hoon non=hoon] (gray [%wtkt puce (blue sic) (blue non)])) + ++ wtls |= [gen=hoon opt=(list (pair spec hoon))] + %+ gray %wtls + [puce (blue gen) (turn opt |=([a=spec b=hoon] [a (blue b)]))] + ++ wtpt |=([sic=hoon non=hoon] (gray [%wtpt puce (blue sic) (blue non)])) + ++ wtsg |=([sic=hoon non=hoon] (gray [%wtsg puce (blue sic) (blue non)])) + ++ wthx |=(syn=skin (gray [%wthx (tele syn) puce])) + ++ wtts |=(mod=spec (gray [%wtts (teal mod) puce])) + -- +:: +++ ax + =+ :* :: .dom: axis to home + :: .hay: wing to home + :: .cox: hygienic context + :: .bug: debug annotations + :: .nut: annotations + :: .def: default expression + :: + dom=`axis`1 + hay=*wing + cox=*(map term spec) + bug=*(list spot) + nut=*(unit note) + def=*(unit hoon) + == + |_ mod=spec + :: + ++ autoname + :: derive name from spec + :: + |- ^- (unit term) + ?- -.mod + %base ?.(?=([%atom *] p.mod) ~ ?:(=(%$ p.p.mod) `%atom `p.p.mod)) + %dbug $(mod q.mod) + %gist $(mod q.mod) + %leaf `p.mod + %loop `p.mod + %like ?~(p.mod ~ ?^(i.p.mod ?:(?=(%& -.i.p.mod) ~ q.i.p.mod) `i.p.mod)) + %make ~(name ap p.mod) + %made $(mod q.mod) + %over $(mod q.mod) + %name $(mod q.mod) + :: + %bcbc $(mod p.mod) + %bcbr $(mod p.mod) + %bccb ~(name ap p.mod) + %bccl $(mod i.p.mod) + %bccn $(mod i.p.mod) + %bcdt ~ + %bcgl $(mod q.mod) + %bcgr $(mod q.mod) + %bchp $(mod p.mod) + %bckt $(mod q.mod) + %bcls $(mod q.mod) + %bcfs ~ + %bcmc ~(name ap p.mod) + %bcpm $(mod p.mod) + %bcsg $(mod q.mod) + %bctc ~ + %bcts $(mod q.mod) + %bcpt $(mod q.mod) + %bcwt $(mod i.p.mod) + %bczp ~ + == + :: + ++ function + :: construct a function example + :: + |= [fun=spec arg=spec] + ^- hoon + :: minimal context as subject + :: + :+ %tsgr + :: context is example of both specs + :: + [example:clear(mod fun) example:clear(mod arg)] + :: produce an %iron (contravariant) core + :: + :- %ktbr + :: make an actual gate + :: + :+ %brcl + [%$ 2] + [%$ 15] + :: + ++ interface + :: construct a core example + :: + |= [variance=vair payload=spec arms=(map term spec)] + ^- hoon + :: attach proper variance control + :: + =- ?- variance + %gold - + %lead [%ktwt -] + %zinc [%ktpm -] + %iron [%ktbr -] + == + ^- hoon + :+ %tsgr example:clear(mod payload) + :+ %brcn ~ + =- [[%$ ~ -] ~ ~] + %- ~(gas by *(map term hoon)) + %+ turn + ~(tap by arms) + |= [=term =spec] + :: + :: note that we *don't* make arm specs in an interface + :: hygienic -- we leave them in context, to support + :: maximum programmer flexibility + :: + [term example:clear(mod spec)] + :: + ++ home + :: express a hoon against the original subject + :: + |= gen=hoon + ^- hoon + =/ ,wing + ?: =(1 dom) + hay + (weld hay `wing`[[%& dom] ~]) + ?~ - gen + [%tsgr [%wing -] gen] + :: + ++ clear + :: clear annotations + ^+ . + .(bug ~, def ~, nut ~) + :: + ++ basal + :: example base case + :: + |= bas=base + ?- bas + :: + [%atom *] + :: we may want sped + :: + [%sand p.bas ?:(=(%da p.bas) ~2000.1.1 0)] + :: + %noun + :: raw nock produces noun type + :: + =+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -]) + :: + %cell + :: reduce to pair of nouns + :: + =+($(bas %noun) [- -]) + :: + %flag + :: comparison produces boolean type + :: + =+([%rock %$ 0] [%ktls [%dtts - -] -]) + :: + %null + [%rock %n 0] + :: + %void + [%zpzp ~] + == + :: + ++ unfold + |= [fun=hoon arg=(list spec)] + ^- hoon + [%cncl fun (turn arg |=(spec ktcl/+<))] + :: + ++ unreel + |= [one=wing res=(list wing)] + ^- hoon + ?~(res [%wing one] [%tsgl [%wing one] $(one i.res, res t.res)]) + :: + ++ descend + :: record an axis to original subject + :: + |= axe=axis + +>(dom (peg axe dom)) + :: + ++ decorate + :: apply documentation to expression + :: + |= gen=hoon + ^- hoon + =- ?~(nut - [%note u.nut -]) + |- + ?~(bug gen [%dbug i.bug $(bug t.bug)]) + :: + ++ pieces + :: enumerate tuple wings + :: + |= =(list term) + ^- (^list wing) + (turn list |=(=term `wing`[term ~])) + :: + ++ spore + :: build default sample + :: + ^- hoon + :: sample is always typeless + :: + :+ %ktls + [%bust %noun] + :: consume debugging context + :: + %- decorate + :: use home as subject + :: + %- home + :: if default is set, use it + :: + ?^ def u.def + :: else map structure to expression + :: + ~+ + |- ^- hoon + ?- mod + [%base *] ?:(=(%void p.mod) [%rock %n 0] (basal p.mod)) + [%bcbc *] :: track hygienic recursion points lexically + :: + %= $ + mod p.mod + cox :: merge lexically and don't forget %$ + :: + (~(put by ^+(cox (~(uni by cox) q.mod))) %$ p.mod) + == + [%dbug *] [%dbug p.mod $(mod q.mod)] + [%gist *] $(mod q.mod) + [%leaf *] [%rock p.mod q.mod] + [%loop *] ~|([%loop p.mod] $(mod (~(got by cox) p.mod))) + [%like *] $(mod bcmc/(unreel p.mod q.mod)) + [%made *] $(mod q.mod) + [%make *] $(mod bcmc/(unfold p.mod q.mod)) + [%name *] $(mod q.mod) + [%over *] $(hay p.mod, mod q.mod) + :: + [%bcbr *] $(mod p.mod) + [%bccb *] [%rock %n 0] + [%bccl *] |- ^- hoon + ?~ t.p.mod ^$(mod i.p.mod) + :- ^$(mod i.p.mod) + $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod) + [%bccn *] :: use last entry + :: + |- ^- hoon + ?~ t.p.mod ^$(mod i.p.mod) + $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod) + [%bchp *] :: see under %bccb + :: + [%rock %n 0] + [%bcgl *] $(mod q.mod) + [%bcgr *] $(mod q.mod) + [%bckt *] $(mod q.mod) + [%bcls *] [%note [%know p.mod] $(mod q.mod)] + [%bcmc *] :: borrow sample + :: + [%tsgl [%$ 6] p.mod] + [%bcpm *] $(mod p.mod) + [%bcsg *] [%kthp q.mod p.mod] + [%bcts *] [%ktts p.mod $(mod q.mod)] + [%bcpt *] $(mod p.mod) + [%bcwt *] :: use last entry + :: + |- ^- hoon + ?~ t.p.mod ^$(mod i.p.mod) + $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod) + [%bcdt *] [%rock %n 0] + [%bcfs *] [%rock %n 0] + [%bctc *] [%rock %n 0] + [%bczp *] [%rock %n 0] + == + :: + ++ example + :: produce a correctly typed default instance + :: + ~+ + ^- hoon + ?+ mod + :: in the general case, make and analyze a spore + :: + :+ %tsls + spore + ~(relative analyze:(descend 3) 2) + :: + [%base *] (decorate (basal p.mod)) + [%dbug *] example(mod q.mod, bug [p.mod bug]) + [%gist *] example(mod q.mod, nut `p.mod) + [%leaf *] (decorate [%rock p.mod q.mod]) + [%like *] example(mod bcmc/(unreel p.mod q.mod)) + [%loop *] [%limb p.mod] + [%made *] example(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)]) + [%make *] example(mod bcmc/(unfold p.mod q.mod)) + [%name *] example(mod q.mod, nut `made/[p.mod ~]) + [%over *] example(hay p.mod, mod q.mod) + :: + [%bccb *] (decorate (home p.mod)) + [%bccl *] %- decorate + |- ^- hoon + ?~ t.p.mod + example:clear(mod i.p.mod) + :- example:clear(mod i.p.mod) + example:clear(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod) + [%bchp *] (decorate (function:clear p.mod q.mod)) + [%bcmc *] (decorate (home [%tsgl [%limb %$] p.mod])) + [%bcsg *] [%ktls example(mod q.mod) (home p.mod)] + [%bcls *] (decorate [%note [%know p.mod] example(mod q.mod)]) + [%bcts *] (decorate [%ktts p.mod example:clear(mod q.mod)]) + [%bcdt *] (decorate (home (interface %gold p.mod q.mod))) + [%bcfs *] (decorate (home (interface %iron p.mod q.mod))) + [%bczp *] (decorate (home (interface %lead p.mod q.mod))) + [%bctc *] (decorate (home (interface %zinc p.mod q.mod))) + == + :: + ++ factory + :: make a normalizing gate (mold) + :: + ^- hoon + :: process annotations outside construct, to catch default + :: + ::TODO: try seeing if putting %gist in here fixes %brbc + ?: ?=(%dbug -.mod) factory(mod q.mod, bug [p.mod bug]) + ?: ?=(%bcsg -.mod) factory(mod q.mod, def `[%kthp q.mod p.mod]) + ^- hoon + :: if we recognize an indirection + :: + ?: &(=(~ def) ?=(?(%bcmc %like %loop %make) -.mod)) + :: then short-circuit it + :: + %- decorate + %- home + ?- -.mod + %bcmc p.mod + %like (unreel p.mod q.mod) + %loop [%limb p.mod] + %make (unfold p.mod q.mod) + == + :: else build a gate + :: + :+ %brcl + [%ktsg spore] + :+ %tsls + ~(relative analyze:(descend 7) 6) + :: trigger unifying equality + :: + :+ %tsls [%dtts $/14 $/2] + $/6 + :: + ++ analyze + :: normalize a fragment of the subject + :: + |_ $: :: axe: axis to fragment + :: + axe=axis + == + ++ basic + |= bas=base + ^- hoon + ?- bas + [%atom *] + :+ %ktls example + ^- hoon + :^ %zppt + [[[%| 0 `%ruth] ~] ~] + [%cnls [%limb %ruth] [%sand %ta p.bas] fetch] + [%wtpt fetch-wing fetch [%zpzp ~]] + :: + %cell + :+ %ktls example + =+ fetch-wing + :- [%wing [[%& %2] -]] + [%wing [[%& %3] -]] + :: + %flag + :^ %wtcl + [%dtts [%rock %$ &] [%$ axe]] + [%rock %f &] + :+ %wtgr + [%dtts [%rock %$ |] [%$ axe]] + [%rock %f |] + :: + %noun + fetch + :: + %null + :+ %wtgr + [%dtts [%bust %noun] [%$ axe]] + [%rock %n ~] + ::: + %void + [%zpzp ~] + == + ++ clear + .(..analyze ^clear) + :: + ++ fetch + :: load the fragment + :: + ^- hoon + [%$ axe] + :: + ++ fetch-wing + :: load, as a wing + :: + ^- wing + [[%& axe] ~] + :: + ++ choice + :: match full models, by trying them + :: + |= $: :: one: first option + :: rep: other options + :: + one=spec + rep=(list spec) + == + ^- hoon + :: if no other choices, construct head + :: + ?~ rep relative:clear(mod one) + :: build test + :: + :^ %wtcl + :: if we fit the type of this choice + :: + [%fits example:clear(mod one) fetch-wing] + :: build with this choice + :: + relative:clear(mod one) + :: continue through loop + :: + $(one i.rep, rep t.rep) + :: + ++ switch + |= $: :: one: first format + :: two: more formats + :: + one=spec + rep=(list spec) + == + |- ^- hoon + :: if no other choices, construct head + :: + ?~ rep relative:clear(mod one) + :: fin: loop completion + :: + =/ fin=hoon $(one i.rep, rep t.rep) + :: interrogate this instance + :: + :^ %wtcl + :: test if the head matches this wing + :: + :+ %fits + [%tsgl [%$ 2] example:clear(mod one)] + fetch-wing(axe (peg axe 2)) + :: if so, use this form + :: + relative:clear(mod one) + :: continue in the loop + :: + fin + :: + ++ relative + :: local constructor + :: + ~+ + ^- hoon + ?- mod + :: + :: base + :: + [%base *] + (decorate (basic:clear p.mod)) + :: + :: debug + :: + [%dbug *] + relative(mod q.mod, bug [p.mod bug]) + :: + :: formal comment + :: + [%gist *] + relative(mod q.mod, nut `p.mod) + :: + :: constant + :: + [%leaf *] + %- decorate + :+ %wtgr + [%dtts fetch [%rock %$ q.mod]] + [%rock p.mod q.mod] + :: + :: composite + :: + [%make *] + relative(mod bcmc/(unfold p.mod q.mod)) + :: + :: indirect + :: + [%like *] + relative(mod bcmc/(unreel p.mod q.mod)) + :: + :: loop + :: + [%loop *] + (decorate [%cnhp [%limb p.mod] fetch]) + :: + :: simple named structure + :: + [%name *] + relative(mod q.mod, nut `made/[p.mod ~]) + :: + :: synthetic named structure + :: + [%made *] + relative(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)]) + :: + :: subjective + :: + [%over *] + relative(hay p.mod, mod q.mod) + :: + :: recursive, $$ + :: + [%bcbc *] + :: + :: apply semantically + :: + :+ %brkt + relative(mod p.mod, dom (peg 3 dom)) + =- [[%$ ~ -] ~ ~] + %- ~(gas by *(map term hoon)) + ^- (list (pair term hoon)) + %+ turn + ~(tap by q.mod) + |= [=term =spec] + [term relative(mod spec, dom (peg 3 dom))] + :: + :: normalize, $& + :: + [%bcpm *] + :: push the raw result + :: + :+ %tsls relative(mod p.mod) + :: push repair function + :: + :+ %tsls + [%tsgr $/3 q.mod] + :: push repaired product + :: + :+ %tsls + [%cnhp $/2 $/6] + :: sanity-check repaired product + :: + :+ %wtgr + :: either + :: + :~ %wtbr + :: the repair did not change anything + :: + [%dtts $/14 $/2] + :: when we fix it again, it stays fixed + :: + [%dtts $/2 [%cnhp $/6 $/2]] + == + $/2 + :: + :: verify, $| + :: + [%bcbr *] + ^- hoon + :: push the raw product + :: + :+ %tsls relative(mod p.mod) + ^- hoon + :: assert + :: + :+ %wtgr + :: run the verifier + :: + [%cnhp [%tsgr $/3 q.mod] $/2] + :: produce verified product + :: + $/2 + :: + :: special, $_ + :: + [%bccb *] + (decorate (home p.mod)) + :: + :: switch, $% + :: + [%bccn *] + (decorate (switch i.p.mod t.p.mod)) + :: + :: tuple, $: + :: + [%bccl *] + %- decorate + |- ^- hoon + ?~ t.p.mod + relative:clear(mod i.p.mod) + :- relative:clear(mod i.p.mod, axe (peg axe 2)) + %= relative + i.p.mod i.t.p.mod + t.p.mod t.t.p.mod + axe (peg axe 3) + == + :: + :: exclude, $< + :: + [%bcgl *] + :+ %tsls + relative:clear(mod q.mod) + :+ %wtgl + [%wtts [%over ~[&/3] p.mod] ~[&/4]] + $/2 + :: + :: require, $> + :: + [%bcgr *] + :+ %tsls + relative:clear(mod q.mod) + :+ %wtgr + [%wtts [%over ~[&/3] p.mod] ~[&/4]] + $/2 + :: + :: function + :: + [%bchp *] + %- decorate + =/ fun (function:clear p.mod q.mod) + ?^ def + [%ktls fun u.def] + fun + :: + :: bridge, $^ + :: + [%bckt *] + %- decorate + :^ %wtcl + [%dtwt fetch(axe (peg axe 2))] + relative:clear(mod p.mod) + relative:clear(mod q.mod) + :: + :: synthesis, $; + :: + [%bcmc *] + (decorate [%cncl (home p.mod) fetch ~]) + :: + :: default + :: + [%bcsg *] + relative(mod q.mod, def `[%kthp q.mod p.mod]) + :: + :: choice, $? + :: + [%bcwt *] + (decorate (choice i.p.mod t.p.mod)) + :: + :: name, $= + :: + [%bcts *] + [%ktts p.mod relative(mod q.mod)] + :: + :: branch, $@ + :: + [%bcpt *] + %- decorate + :^ %wtcl + [%dtwt fetch] + relative:clear(mod q.mod) + relative:clear(mod p.mod) + :: + [%bcls *] [%note [%know p.mod] relative(mod q.mod)] + [%bcdt *] (decorate (home (interface %gold p.mod q.mod))) + [%bcfs *] (decorate (home (interface %iron p.mod q.mod))) + [%bczp *] (decorate (home (interface %lead p.mod q.mod))) + [%bctc *] (decorate (home (interface %zinc p.mod q.mod))) + == + -- + -- +:: +++ ap :: hoon engine + ~% %ap + +>+ + == + %open open + %rake rake + == + |_ gen=hoon + :: + ++ grip + |= =skin + =| rel=wing + |- ^- hoon + ?- skin + @ + [%tsgl [%tune skin] gen] + [%base *] + ?: ?=(%noun base.skin) + gen + [%kthp skin gen] + :: + [%cell *] + =+ haf=~(half ap gen) + ?^ haf + :- $(skin skin.skin, gen p.u.haf) + $(skin ^skin.skin, gen q.u.haf) + :+ %tsls + gen + :- $(skin skin.skin, gen [%$ 4]) + $(skin ^skin.skin, gen [%$ 5]) + :: + [%dbug *] + [%dbug spot.skin $(skin skin.skin)] + :: + [%leaf *] + [%kthp skin gen] + :: + [%help *] + [%note [%help help.skin] $(skin skin.skin)] + :: + [%name *] + [%tsgl [%tune term.skin] $(skin skin.skin)] + :: + [%over *] + $(skin skin.skin, rel (weld wing.skin rel)) + :: + [%spec *] + :+ %kthp + ?~(rel spec.skin [%over rel spec.skin]) + $(skin skin.skin) + :: + [%wash *] + :+ %tsgl + :- %wing + |- ^- wing + ?: =(0 depth.skin) ~ + [[%| 0 ~] $(depth.skin (dec depth.skin))] + gen + == + :: + ++ name + |- ^- (unit term) + ?+ gen ~ + [%wing *] ?~ p.gen ~ + ?^ i.p.gen + ?:(?=(%& -.i.p.gen) ~ q.i.p.gen) + `i.p.gen + [%limb *] `p.gen + [%dbug *] $(gen ~(open ap gen)) + [%tsgl *] $(gen ~(open ap gen)) + [%tsgr *] $(gen q.gen) + == + :: + ++ feck + |- ^- (unit term) + ?- gen + [%sand %tas @] [~ q.gen] + [%dbug *] $(gen q.gen) + * ~ + == + :: + :: not used at present; see comment at %csng in ++open +:::: +::++ hail +:: |= axe=axis +:: =| air=(list (pair wing hoon)) +:: |- ^+ air +:: =+ hav=half +:: ?~ hav [[[[%| 0 ~] [%& axe] ~] gen] air] +:: $(gen p.u.hav, axe (peg axe 2), air $(gen q.u.hav, axe (peg axe 3))) +:: + ++ half + |- ^- (unit (pair hoon hoon)) + ?+ gen ~ + [^ *] `[p.gen q.gen] + [%dbug *] $(gen q.gen) + [%clcb *] `[q.gen p.gen] + [%clhp *] `[p.gen q.gen] + [%clkt *] `[p.gen %clls q.gen r.gen s.gen] + [%clsg *] ?~(p.gen ~ `[i.p.gen %clsg t.p.gen]) + [%cltr *] ?~ p.gen ~ + ?~(t.p.gen $(gen i.p.gen) `[i.p.gen %cltr t.p.gen]) + == +:::: + :: +flay: hoon to skin + :: + ++ flay + |- ^- (unit skin) + ?+ gen + =+(open ?:(=(- gen) ~ $(gen -))) + :: + [^ *] + =+ [$(gen p.gen) $(gen q.gen)] + ?~(-< ~ ?~(-> ~ `[%cell -<+ ->+])) + :: + [%base *] + `gen + :: + [%rock *] + ?@(q.gen `[%leaf p.gen q.gen] ~) + :: + [%cnts [@ ~] ~] + `i.p.gen + :: + [%tsgr *] + %+ biff reek(gen p.gen) + |= =wing + (bind ^$(gen q.gen) |=(=skin [%over wing skin])) + :: + [%limb @] + `p.gen + :: + :: [%rock *] + :: [%spec %leaf q.gen q.gen] + :: + [%note [%help *] *] + (bind $(gen q.gen) |=(=skin [%help p.p.gen skin])) + :: + [%wing *] + ?: ?=([@ ~] p.gen) + `i.p.gen + =/ depth 0 + |- ^- (unit skin) + ?~ p.gen `[%wash depth] + ?. =([%| 0 ~] i.p.gen) ~ + $(p.gen t.p.gen) + :: + [%kttr *] + `[%spec p.gen %base %noun] + :: + [%ktts *] + %+ biff $(gen q.gen) + |= =skin + ?@ p.gen `[%name p.gen skin] + ?. ?=([%name @ [%base %noun]] p.gen) ~ + `[%name term.p.gen skin] + == + :: + :: +open: desugarer + ++ open + ^- hoon + ?- gen + [~ *] [%cnts [[%& p.gen] ~] ~] + :: + [%base *] ~(factory ax `spec`gen) + [%bust *] ~(example ax %base p.gen) + [%ktcl *] ~(factory ax p.gen) + [%dbug *] q.gen + [%eror *] ~_((crip p.gen) !!) + :: + [%knit *] :: + :+ %tsgr [%ktts %v %$ 1] :: => v=. + :- %brhp :: |- + :+ %ktls :: ^+ + :- %brhp :: |- + :^ %wtcl :: ?: + [%bust %flag] :: ? + [%bust %null] :: ~ + :- [%ktts %i [%sand 'tD' *@]] :: :- i=~~ + [%ktts %t [%limb %$]] :: t=$ + |- ^- hoon :: + ?~ p.gen :: + [%bust %null] :: ~ + =+ res=$(p.gen t.p.gen) :: + ^- hoon :: + ?@ i.p.gen :: + [[%sand 'tD' i.p.gen] res] :: [~~{i.p.gen} {res}] + :+ %tsls :: + :- :+ %ktts :: ^= + %a :: a + :+ %ktls :: ^+ + [%limb %$] :: $ + [%tsgr [%limb %v] p.i.p.gen] :: =>(v {p.i.p.gen}) + [%ktts %b res] :: b=[res] + ^- hoon :: + :- %brhp :: |- + :^ %wtpt :: ?@ + [%a ~] :: a + [%limb %b] :: b + :- [%tsgl [%$ 2] [%limb %a]] :: :- -.a + :+ %cnts :: %= + [%$ ~] :: $ + [[[%a ~] [%tsgl [%$ 3] [%limb %a]]] ~] :: a +.a + :: + [%leaf *] ~(factory ax `spec`gen) + [%limb *] [%cnts [p.gen ~] ~] + [%tell *] [%cncl [%limb %noah] [%zpgr [%cltr p.gen]] ~] + [%wing *] [%cnts p.gen ~] + [%yell *] [%cncl [%limb %cain] [%zpgr [%cltr p.gen]] ~] + [%note *] q.gen + :: + ::TODO: does %gist need to be special cased here? + [%brbc *] =- ?~ - !! + :+ %brtr + [%bccl -] + |- + ?. ?=([%gist *] body.gen) + [%ktcl body.gen] + [%note p.body.gen $(body.gen q.body.gen)] + %+ turn `(list term)`sample.gen + |= =term + ^- spec + =/ tar [%base %noun] + [%bcts term [%bcsg tar [%bchp tar tar]]] + [%brcb *] :+ %tsls [%kttr p.gen] + :+ %brcn ~ + %- ~(run by r.gen) + |= =tome + :- p.tome + %- ~(run by q.tome) + |= =hoon + ?~ q.gen hoon + [%tstr [p.i.q.gen ~] q.i.q.gen $(q.gen t.q.gen)] + [%brcl *] [%tsls p.gen [%brdt q.gen]] + [%brdt *] :+ %brcn ~ + =- [[%$ ~ -] ~ ~] + (~(put by *(map term hoon)) %$ p.gen) + [%brkt *] :+ %tsgl [%limb %$] + :+ %brcn ~ + =+ zil=(~(get by q.gen) %$) + ?~ zil + %+ ~(put by q.gen) %$ + [*what [[%$ p.gen] ~ ~]] + %+ ~(put by q.gen) %$ + [p.u.zil (~(put by q.u.zil) %$ p.gen)] + [%brhp *] [%tsgl [%limb %$] [%brdt p.gen]] + [%brsg *] [%ktbr [%brts p.gen q.gen]] + [%brtr *] :+ %tsls [%kttr p.gen] + :+ %brpt ~ + =- [[%$ ~ -] ~ ~] + (~(put by *(map term hoon)) %$ q.gen) + [%brts *] :+ %brcb p.gen + =- [~ [[%$ ~ -] ~ ~]] + (~(put by *(map term hoon)) %$ q.gen) + [%brwt *] [%ktwt %brdt p.gen] + :: + [%clkt *] [p.gen q.gen r.gen s.gen] + [%clls *] [p.gen q.gen r.gen] + [%clcb *] [q.gen p.gen] + [%clhp *] [p.gen q.gen] + [%clsg *] + |- ^- hoon + ?~ p.gen + [%rock %n ~] + [i.p.gen $(p.gen t.p.gen)] + :: + [%cltr *] + |- ^- hoon + ?~ p.gen + [%zpzp ~] + ?~ t.p.gen + i.p.gen + [i.p.gen $(p.gen t.p.gen)] + :: + [%kttr *] [%ktsg ~(example ax p.gen)] + [%cncb *] [%ktls [%wing p.gen] %cnts p.gen q.gen] + [%cndt *] [%cncl q.gen [p.gen ~]] + [%cnkt *] [%cncl p.gen q.gen r.gen s.gen ~] + [%cnls *] [%cncl p.gen q.gen r.gen ~] + [%cnhp *] [%cncl p.gen q.gen ~] + :: this probably should work, but doesn't + :: + :: [%cncl *] [%cntr [%$ ~] p.gen [[[[%& 6] ~] [%cltr q.gen]] ~]] + [%cncl *] [%cnsg [%$ ~] p.gen q.gen] + [%cnsg *] + :: this complex matching system is a leftover from the old + :: "electroplating" era. %cnsg should be removed and replaced + :: with the commented-out %cncl above. but something is broken. + :: + :^ %cntr p.gen q.gen + =+ axe=6 + |- ^- (list [wing hoon]) + ?~ r.gen ~ + ?~ t.r.gen [[[[%| 0 ~] [%& axe] ~] i.r.gen] ~] + :- [[[%| 0 ~] [%& (peg axe 2)] ~] i.r.gen] + $(axe (peg axe 3), r.gen t.r.gen) + :: + [%cntr *] + ?: =(~ r.gen) + [%tsgr q.gen [%wing p.gen]] + :+ %tsls + q.gen + :+ %cnts + (weld p.gen `wing`[[%& 2] ~]) + (turn r.gen |=([p=wing q=hoon] [p [%tsgr [%$ 3] q]])) + :: + [%ktdt *] [%ktls [%cncl p.gen q.gen ~] q.gen] + [%kthp *] [%ktls ~(example ax p.gen) q.gen] + [%ktts *] (grip(gen q.gen) p.gen) + :: + [%sgbr *] + :+ %sggr + :- %mean + =+ fek=~(feck ap p.gen) + ?^ fek [%rock %tas u.fek] + [%brdt [%cncl [%limb %cain] [%zpgr [%tsgr [%$ 3] p.gen]] ~]] + q.gen + :: + [%sgcb *] [%sggr [%mean [%brdt p.gen]] q.gen] + [%sgcn *] + :+ %sggl + :- %fast + :- %clls + :+ [%rock %$ p.gen] + [%zpts q.gen] + :- %clsg + =+ nob=`(list hoon)`~ + |- ^- (list hoon) + ?~ r.gen + nob + [[[%rock %$ p.i.r.gen] [%zpts q.i.r.gen]] $(r.gen t.r.gen)] + s.gen + :: + [%sgfs *] [%sgcn p.gen [%$ 7] ~ q.gen] + [%sggl *] [%tsgl [%sggr p.gen [%$ 1]] q.gen] + [%sgbc *] [%sggr [%live [%rock %$ p.gen]] q.gen] + [%sgls *] [%sggr [%memo %rock %$ p.gen] q.gen] + [%sgpm *] + :+ %sggr + [%slog [%sand %$ p.gen] [%cncl [%limb %cain] [%zpgr q.gen] ~]] + r.gen + :: + [%sgts *] [%sggr [%germ p.gen] q.gen] + [%sgwt *] + :+ %tsls [%wtdt q.gen [%bust %null] [[%bust %null] r.gen]] + :^ %wtsg [%& 2]~ + [%tsgr [%$ 3] s.gen] + [%sgpm p.gen [%$ 5] [%tsgr [%$ 3] s.gen]] + :: + [%mcts *] + |- + ?~ p.gen [%bust %null] + ?- -.i.p.gen + ^ [[%xray i.p.gen] $(p.gen t.p.gen)] + %manx [p.i.p.gen $(p.gen t.p.gen)] + %tape [[%mcfs p.i.p.gen] $(p.gen t.p.gen)] + %call [%cncl p.i.p.gen [$(p.gen t.p.gen)]~] + %marl =- [%cndt [p.i.p.gen $(p.gen t.p.gen)] -] + ^- hoon + :+ %tsbr [%base %cell] + :+ %brpt ~ + ^- (map term tome) + =- [[%$ ~ -] ~ ~] + ^- (map term hoon) + :_ [~ ~] + =+ sug=[[%& 12] ~] + :- %$ + :^ %wtsg sug + [%cnts sug [[[[%& 1] ~] [%$ 13]] ~]] + [%cnts sug [[[[%& 3] ~] [%cnts [%$ ~] [[sug [%$ 25]] ~]]] ~]] + == + :: + [%mccl *] + ?- q.gen + ~ [%zpzp ~] + [* ~] i.q.gen + ^ + :+ %tsls + p.gen + =+ yex=`(list hoon)`q.gen + |- ^- hoon + ?- yex + [* ~] [%tsgr [%$ 3] i.yex] + [* ^] [%cncl [%$ 2] [%tsgr [%$ 3] i.yex] $(yex t.yex) ~] + ~ !! + == + == + :: + [%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~]) + [%mcgl *] [%cnls [%cnhp q ktcl+p] r [%brts p [%tsgr $+3 s]]]:gen + :: + [%mcsg *] :: ;~ + |- ^- hoon + ?- q.gen + ~ ~_(leaf+"open-mcsg" !!) + ^ + :+ %tsgr [%ktts %v %$ 1] :: => v=. + |- ^- hoon :: + ?: ?=(~ t.q.gen) :: + [%tsgr [%limb %v] i.q.gen] :: =>(v {i.q.gen}) + :+ %tsls [%ktts %a $(q.gen t.q.gen)] :: =+ ^= a + :+ %tsls :: {$(q.gen t.q.gen)} + [%ktts %b [%tsgr [%limb %v] i.q.gen]] :: =+ ^= b + :+ %tsls :: =>(v {i.q.gen}) + :+ %ktts %c :: =+ c=,.+6.b + :+ %tsgl :: + [%wing [%| 0 ~] [%& 6] ~] :: + [%limb %b] :: + :- %brdt :: |. + :^ %cnls :: %+ + [%tsgr [%limb %v] p.gen] :: =>(v {p.gen}) + [%cncl [%limb %b] [%limb %c] ~] :: (b c) + :+ %cnts [%a ~] :: a(,.+6 c) + [[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] :: + == :: + :: + [%mcmc *] :: ;; + [%cnhp ~(factory ax p.gen) q.gen] + :: + [%tsbr *] + [%tsls ~(example ax p.gen) q.gen] + :: + [%tstr *] + :+ %tsgl + r.gen + [%tune [[p.p.gen ~ ?~(q.p.gen q.gen [%kthp u.q.p.gen q.gen])] ~ ~] ~] + :: + [%tscl *] + [%tsgr [%cncb [[%& 1] ~] p.gen] q.gen] + :: + [%tsfs *] + [%tsls [%ktts p.gen q.gen] r.gen] + :: + [%tsmc *] [%tsfs p.gen r.gen q.gen] + [%tsdt *] + [%tsgr [%cncb [[%& 1] ~] [[p.gen q.gen] ~]] r.gen] + [%tswt *] :: =? + [%tsdt p.gen [%wtcl q.gen r.gen [%wing p.gen]] s.gen] + :: + [%tskt *] :: =^ + =+ wuy=(weld q.gen `wing`[%v ~]) :: + :+ %tsgr [%ktts %v %$ 1] :: => v=. + :+ %tsls [%ktts %a %tsgr [%limb %v] r.gen] :: =+ a==>(v \r.gen) + :^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]] + :+ %tsgr :- :+ %ktts [%over [%v ~] p.gen] + [%tsgl [%$ 2] [%limb %a]] + [%limb %v] + s.gen + :: + [%tsgl *] [%tsgr q.gen p.gen] + [%tsls *] [%tsgr [p.gen [%$ 1]] q.gen] + [%tshp *] [%tsls q.gen p.gen] + [%tssg *] + |- ^- hoon + ?~ p.gen [%$ 1] + ?~ t.p.gen i.p.gen + [%tsgr i.p.gen $(p.gen t.p.gen)] + :: + [%wtbr *] + |- + ?~(p.gen [%rock %f 1] [%wtcl i.p.gen [%rock %f 0] $(p.gen t.p.gen)]) + :: + [%wtdt *] [%wtcl p.gen r.gen q.gen] + [%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen] + [%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]] + [%wtkt *] [%wtcl [%wtts [%base %atom %$] p.gen] r.gen q.gen] + :: + [%wthp *] + |- + ?~ q.gen + [%lost [%wing p.gen]] + :^ %wtcl + [%wtts p.i.q.gen p.gen] + q.i.q.gen + $(q.gen t.q.gen) + :: + [%wtls *] + [%wthp p.gen (weld r.gen `_r.gen`[[[%base %noun] q.gen] ~])] + :: + [%wtpm *] + |- + ?~(p.gen [%rock %f 0] [%wtcl i.p.gen $(p.gen t.p.gen) [%rock %f 1]]) + :: + [%xray *] + |^ :- [(open-mane n.g.p.gen) %clsg (turn a.g.p.gen open-mart)] + [%mcts c.p.gen] + :: + ++ open-mane + |= a=mane:hoot + ?@(a [%rock %tas a] [[%rock %tas -.a] [%rock %tas +.a]]) + :: + ++ open-mart + |= [n=mane:hoot v=(list beer:hoot)] + [(open-mane n) %knit v] + -- + :: + [%wtpt *] [%wtcl [%wtts [%base %atom %$] p.gen] q.gen r.gen] + [%wtsg *] [%wtcl [%wtts [%base %null] p.gen] q.gen r.gen] + [%wtts *] [%fits ~(example ax p.gen) q.gen] + [%wtzp *] [%wtcl p.gen [%rock %f 1] [%rock %f 0]] + [%zpgr *] + [%cncl [%limb %onan] [%zpmc [%kttr [%bcmc %limb %abel]] p.gen] ~] + :: + [%zpwt *] + ?: ?: ?=(@ p.gen) + (lte hoon-version p.gen) + &((lte hoon-version p.p.gen) (gte hoon-version q.p.gen)) + q.gen + ~_(leaf+"hoon-version" !!) + :: + * gen + == + :: + ++ rake ~>(%mean.'rake-hoon' (need reek)) + ++ reek + ^- (unit wing) + ?+ gen ~ + [~ *] `[[%& p.gen] ~] + [%limb *] `[p.gen ~] + [%wing *] `p.gen + [%cnts * ~] `p.gen + [%dbug *] reek(gen q.gen) + == + ++ rusk + ^- term + =+ wig=rake + ?. ?=([@ ~] wig) + ~>(%mean.'rusk-hoon' !!) + i.wig + -- +:: +:: 5c: compiler backend and prettyprinter ++| %compiler-backend-and-prettyprinter +:: +++ ut + ~% %ut + +>+ + == + %ar ar + %fan fan + %rib rib + %vet vet + %blow blow + %burp burp + %busk busk + %buss buss + %crop crop + %duck duck + %dune dune + %dunk dunk + %epla epla + %emin emin + %emul emul + %feel feel + %felt felt + %fine fine + %fire fire + %fish fish + %fond fond + %fund fund + %funk funk + %fuse fuse + %gain gain + %lose lose + %mile mile + %mine mine + %mint mint + %moot moot + %mull mull + %nest nest + %peel peel + %play play + %peek peek + %repo repo + %rest rest + %sink sink + %tack tack + %toss toss + %wrap wrap + == + =+ :* fan=*(set [type hoon]) + rib=*(set [type type hoon]) + vet=`?`& + == + =+ sut=`type`%noun + |% + ++ clip + |= ref=type + ?> ?|(!vet (nest(sut ref) & sut)) + ref + :: + :: +ar: texture engine + :: + ++ ar !: + ~% %ar + +> + == + %fish fish + %gain gain + %lose lose + == + |_ [ref=type =skin] + :: + :: +fish: make a $nock that tests a .ref at .axis for .skin + :: + ++ fish + |= =axis + ^- nock + ?@ skin [%1 &] + ?- -.skin + :: + %base + ?- base.skin + %cell $(skin [%cell [%base %noun] [%base %noun]]) + %flag ?: (~(nest ut bool) | ref) + [%1 &] + %+ flan + $(skin [%base %atom %$]) + %+ flor + [%5 [%0 axis] [%1 &]] + [%5 [%0 axis] [%1 |]] + %noun [%1 &] + %null $(skin [%leaf %n ~]) + %void [%1 |] + [%atom *] ?: (~(nest ut [%atom %$ ~]) | ref) + [%1 &] + ?: (~(nest ut [%cell %noun %noun]) | ref) + [%1 |] + (flip [%3 %0 axis]) + == + :: + %cell + ?: (~(nest ut [%atom %$ ~]) | ref) [%1 |] + %+ flan + ?: (~(nest ut [%cell %noun %noun]) | ref) + [%1 &] + [%3 %0 axis] + %+ flan + $(ref (peek(sut ref) %free 2), skin skin.skin) + $(ref (peek(sut ref) %free 3), skin ^skin.skin) + :: + %leaf + ?: (~(nest ut [%atom %$ `atom.skin]) | ref) + [%1 &] + [%5 [%1 atom.skin] [%0 axis]] + :: + %dbug $(skin skin.skin) + %help $(skin skin.skin) + %name $(skin skin.skin) + %over $(skin skin.skin) + %spec $(skin skin.skin) + %wash [%1 1] + == + :: + :: +gain: make a $type by restricting .ref to .skin + :: + ++ gain + |- ^- type + ?@ skin [%face skin ref] + ?- -.skin + :: + %base + ?- base.skin + %cell $(skin [%cell [%base %noun] [%base %noun]]) + %flag (fork $(skin [%leaf %f &]) $(skin [%leaf %f |]) ~) + %null $(skin [%leaf %n ~]) + %void %void + %noun ?:((~(nest ut %void) | ref) %void ref) + [%atom *] + =| gil=(set type) + |- ^- type + ?- ref + %void %void + %noun [%atom p.base.skin ~] + [%atom *] ?. (fitz p.base.skin p.ref) + ~>(%mean.'atom-mismatch' !!) + :+ %atom + (max p.base.skin p.ref) + q.ref + [%cell *] %void + [%core *] %void + [%face *] (face p.ref $(ref q.ref)) + [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type)))) + [%hint *] (hint p.ref $(ref q.ref)) + [%hold *] ?: (~(has in gil) ref) %void + $(gil (~(put in gil) ref), ref repo(sut ref)) + == + == + :: + %cell + =| gil=(set type) + |- ^- type + ?- ref + %void %void + %noun [%cell %noun %noun] + [%atom *] %void + [%cell *] =+ ^$(skin skin.skin, ref p.ref) + ?: =(%void -) %void + (cell - ^$(skin ^skin.skin, ref q.ref)) + [%core *] =+ ^$(skin skin.skin, ref p.ref) + ?: =(%void -) %void + ?. =(%noun ^skin.skin) + (cell - ^$(skin ^skin.skin, ref %noun)) + [%core - q.ref] + [%face *] (face p.ref $(ref q.ref)) + [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type)))) + [%hint *] (hint p.ref $(ref q.ref)) + [%hold *] ?: (~(has in gil) ref) %void + $(gil (~(put in gil) ref), ref repo(sut ref)) + == + :: + %leaf + =| gil=(set type) + |- ^- type + ?- ref + %void %void + %noun [%atom aura.skin `atom.skin] + [%atom *] ?: &(?=(^ q.ref) !=(atom.skin u.q.ref)) + %void + ?. (fitz aura.skin p.ref) + ~>(%mean.'atom-mismatch' !!) + :+ %atom + (max aura.skin p.ref) + `atom.skin + [%cell *] %void + [%core *] %void + [%face *] (face p.ref $(ref q.ref)) + [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type)))) + [%hint *] (hint p.ref $(ref q.ref)) + [%hold *] ?: (~(has in gil) ref) %void + $(gil (~(put in gil) ref), ref repo(sut ref)) + == + :: + %dbug $(skin skin.skin) + %help (hint [sut %help help.skin] $(skin skin.skin)) + %name (face term.skin $(skin skin.skin)) + %over $(skin skin.skin, sut (~(play ut sut) %wing wing.skin)) + %spec =/ yon $(skin skin.skin) + =/ hit (~(play ut sut) ~(example ax spec.skin)) + ?> (~(nest ut hit) & yon) + hit + %wash =- $(ref (~(play ut ref) -)) + :- %wing + |- ^- wing + ?: =(0 depth.skin) ~ + [[%| 0 ~] $(depth.skin (dec depth.skin))] + == + :: + :: +lose: make a $type by restricting .ref to exclude .skin + :: + ++ lose + |- ^- type + ?@ skin [%face skin ref] + ?- -.skin + :: + %base + ?- base.skin + %cell $(skin [%cell [%base %noun] [%base %noun]]) + %flag $(skin [%base %atom %f]) + %null $(skin [%leaf %n ~]) + %void ref + %noun %void + [%atom *] + =| gil=(set type) + |- ^- type + ?- ref + %void %void + %noun [%cell %noun %noun] + [%atom *] %void + [%cell *] ref + [%core *] ref + [%face *] (face p.ref $(ref q.ref)) + [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type)))) + [%hint *] (hint p.ref $(ref q.ref)) + [%hold *] ?: (~(has in gil) ref) %void + $(gil (~(put in gil) ref), ref repo(sut ref)) + == + == + :: + %cell + =| gil=(set type) + |- ^- type + ?- ref + %void %void + %noun [%atom %$ ~] + [%atom *] ref + [%cell *] =+ ^$(skin skin.skin, ref p.ref) + ?: =(%void -) %void + (cell - ^$(skin ^skin.skin, ref q.ref)) + [%core *] =+ ^$(skin skin.skin, ref p.ref) + ?: =(%void -) %void + ?. =(%noun ^skin.skin) + (cell - ^$(skin ^skin.skin, ref %noun)) + [%core - q.ref] + [%face *] (face p.ref $(ref q.ref)) + [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type)))) + [%hint *] (hint p.ref $(ref q.ref)) + [%hold *] ?: (~(has in gil) ref) %void + $(gil (~(put in gil) ref), ref repo(sut ref)) + == + :: + %leaf + =| gil=(set type) + |- ^- type + ?- ref + %void %void + %noun %noun + [%atom *] ?: =(q.ref `atom.skin) + %void + ref + [%cell *] ref + [%core *] ref + [%face *] (face p.ref $(ref q.ref)) + [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type)))) + [%hint *] (hint p.ref $(ref q.ref)) + [%hold *] ?: (~(has in gil) ref) %void + $(gil (~(put in gil) ref), ref repo(sut ref)) + == + :: + %dbug $(skin skin.skin) + %help $(skin skin.skin) + %name $(skin skin.skin) + %over $(skin skin.skin) + %spec $(skin skin.skin) + %wash ref + == + -- + :: + ++ blow + |= [gol=type gen=hoon] + ^- [type nock] + =+ pro=(mint gol gen) + =+ jon=(apex:musk bran q.pro) + ?: |(?=(~ jon) ?=(%wait -.u.jon)) + [p.pro q.pro] + [p.pro %1 p.u.jon] + :: + ++ bran + ~+ + =+ gil=*(set type) + |- ~+ ^- seminoun:musk + ?- sut + %noun [full/[~ ~ ~] ~] + %void [full/[~ ~ ~] ~] + [%atom *] ?~(q.sut [full/[~ ~ ~] ~] [full/~ u.q.sut]) + [%cell *] (combine:musk $(sut p.sut) $(sut q.sut)) + [%core *] %+ combine:musk + p.r.q.sut + $(sut p.sut) + [%face *] $(sut repo) + [%fork *] [full/[~ ~ ~] ~] + [%hint *] $(sut repo) + [%hold *] ?: (~(has in gil) sut) + [full/[~ ~ ~] ~] + $(sut repo, gil (~(put in gil) sut)) + == + :: + ++ burp + :: expel undigested seminouns + :: + ^- type + ~+ + =- ?.(=(sut -) - sut) + ?+ sut sut + [%cell *] [%cell burp(sut p.sut) burp(sut q.sut)] + [%core *] :+ %core + burp(sut p.sut) + :* p.q.sut + burp(sut q.q.sut) + :_ q.r.q.sut + ?: ?=([[%full ~] *] p.r.q.sut) + p.r.q.sut + [[%full ~ ~ ~] ~] + == + [%face *] [%face p.sut burp(sut q.sut)] + [%fork *] [%fork (~(run in p.sut) |=(type burp(sut +<)))] + [%hint *] (hint [burp(sut p.p.sut) q.p.sut] burp(sut q.sut)) + [%hold *] [%hold burp(sut p.sut) q.sut] + == + :: + ++ busk + ~/ %busk + |= gen=hoon + ^- type + [%face [~ [gen ~]] sut] + :: + ++ buss + ~/ %buss + |= [cog=term gen=hoon] + ^- type + [%face [[[cog ~ gen] ~ ~] ~] sut] + :: + ++ crop + ~/ %crop + |= ref=type + =+ bix=*(set [type type]) + =< dext + |% + ++ dext + ^- type + ~_ leaf+"crop" + :: ~_ (dunk 'dext: sut') + :: ~_ (dunk(sut ref) 'dext: ref') + ?: |(=(sut ref) =(%noun ref)) + %void + ?: =(%void ref) + sut + ?- sut + [%atom *] + ?+ ref sint + [%atom *] ?^ q.sut + ?^(q.ref ?:(=(q.ref q.sut) %void sut) %void) + ?^(q.ref sut %void) + [%cell *] sut + == + :: + [%cell *] + ?+ ref sint + [%atom *] sut + [%cell *] ?. (nest(sut p.ref) | p.sut) sut + (cell p.sut dext(sut q.sut, ref q.ref)) + == + :: + [%core *] ?:(?=(?([%atom *] [%cell *]) ref) sut sint) + [%face *] (face p.sut dext(sut q.sut)) + [%fork *] (fork (turn ~(tap in p.sut) |=(type dext(sut +<)))) + [%hint *] (hint p.sut dext(sut q.sut)) + [%hold *] ?< (~(has in bix) [sut ref]) + dext(sut repo, bix (~(put in bix) [sut ref])) + %noun dext(sut repo) + %void %void + == + :: + ++ sint + ^- type + ?+ ref !! + [%core *] sut + [%face *] dext(ref repo(sut ref)) + [%fork *] =+ yed=~(tap in p.ref) + |- ^- type + ?~ yed sut + $(yed t.yed, sut dext(ref i.yed)) + [%hint *] dext(ref repo(sut ref)) + [%hold *] dext(ref repo(sut ref)) + == + -- + :: + ++ cool + |= [pol=? hyp=wing ref=type] + ^- type + =+ fid=(find %both hyp) + ?- -.fid + %| sut + %& =< q + %+ take p.p.fid + |=(a=type ?:(pol (fuse(sut a) ref) (crop(sut a) ref))) + == + :: + ++ duck ^-(tank ~(duck us sut)) + ++ dune |.(duck) + ++ dunk + |= paz=term ^- tank + :+ %palm + [['.' ~] ['-' ~] ~ ~] + [[%leaf (mesc (trip paz))] duck ~] + :: + ++ elbo + |= [lop=palo rig=(list (pair wing hoon))] + ^- type + ?: ?=(%& -.q.lop) + |- ^- type + ?~ rig + p.q.lop + =+ zil=(play q.i.rig) + =+ dar=(tack(sut p.q.lop) p.i.rig zil) + %= $ + rig t.rig + p.q.lop q.dar + == + =+ hag=~(tap in q.q.lop) + %- fire + |- ^+ hag + ?~ rig + hag + =+ zil=(play q.i.rig) + =+ dix=(toss p.i.rig zil hag) + %= $ + rig t.rig + hag q.dix + == + :: + ++ ergo + |= [lop=palo rig=(list (pair wing hoon))] + ^- (pair type nock) + =+ axe=(tend p.lop) + =| hej=(list (pair axis nock)) + ?: ?=(%& -.q.lop) + =- [p.- (hike axe q.-)] + |- ^- (pair type (list (pair axis nock))) + ?~ rig + [p.q.lop hej] + =+ zil=(mint %noun q.i.rig) + =+ dar=(tack(sut p.q.lop) p.i.rig p.zil) + %= $ + rig t.rig + p.q.lop q.dar + hej [[p.dar q.zil] hej] + == + =+ hag=~(tap in q.q.lop) + =- [(fire p.-) [%9 p.q.lop (hike axe q.-)]] + |- ^- (pair (list (pair type foot)) (list (pair axis nock))) + ?~ rig + [hag hej] + =+ zil=(mint %noun q.i.rig) + =+ dix=(toss p.i.rig p.zil hag) + %= $ + rig t.rig + hag q.dix + hej [[p.dix q.zil] hej] + == + :: + ++ endo + |= [lop=(pair palo palo) dox=type rig=(list (pair wing hoon))] + ^- (pair type type) + ?: ?=(%& -.q.p.lop) + ?> ?=(%& -.q.q.lop) + |- ^- (pair type type) + ?~ rig + [p.q.p.lop p.q.q.lop] + =+ zil=(mull %noun dox q.i.rig) + =+ ^= dar + :- p=(tack(sut p.q.p.lop) p.i.rig p.zil) + q=(tack(sut p.q.q.lop) p.i.rig q.zil) + ?> =(p.p.dar p.q.dar) + %= $ + rig t.rig + p.q.p.lop q.p.dar + p.q.q.lop q.q.dar + == + ?> ?=(%| -.q.q.lop) + ?> =(p.q.p.lop p.q.q.lop) + =+ hag=[p=~(tap in q.q.p.lop) q=~(tap in q.q.q.lop)] + =- [(fire p.-) (fire(vet |) q.-)] + |- ^- (pair (list (pair type foot)) (list (pair type foot))) + ?~ rig + hag + =+ zil=(mull %noun dox q.i.rig) + =+ ^= dix + :- p=(toss p.i.rig p.zil p.hag) + q=(toss p.i.rig q.zil q.hag) + ?> =(p.p.dix p.q.dix) + %= $ + rig t.rig + hag [q.p.dix q.q.dix] + == + :: + ++ et + |_ [hyp=wing rig=(list (pair wing hoon))] + :: + ++ play + ^- type + =+ lug=(find %read hyp) + ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.p.lug)) + (elbo p.lug rig) + :: + ++ mint + |= gol=type + ^- (pair type nock) + =+ lug=(find %read hyp) + ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.lug)) + =- ?>(?|(!vet (nest(sut gol) & p.-)) -) + (ergo p.lug rig) + :: + ++ mull + |= [gol=type dox=type] + ^- [type type] + =+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)] + ?: ?=(%| -.p.lug) + ?> &(?=(%| -.q.lug) ?=(~ rig)) + [p.p.p.lug p.p.q.lug] + ?> ?=(%& -.q.lug) + =- ?>(?|(!vet (nest(sut gol) & p.-)) -) + (endo [p.p.lug p.q.lug] dox rig) + -- + :: + ++ epla + ~/ %epla + |= [hyp=wing rig=(list (pair wing hoon))] + ^- type + ~(play et hyp rig) + :: + ++ emin + ~/ %emin + |= [gol=type hyp=wing rig=(list (pair wing hoon))] + ^- (pair type nock) + (~(mint et hyp rig) gol) + :: + ++ emul + ~/ %emul + |= [gol=type dox=type hyp=wing rig=(list (pair wing hoon))] + ^- (pair type type) + (~(mull et hyp rig) gol dox) + :: + ++ felt !! + :: :: + ++ feel :: detect existence + |= rot=(list wing) + ^- ? + =. rot (flop rot) + |- ^- ? + ?~ rot & + =/ yep (fond %free i.rot) + ?~ yep | + ?- -.yep + %& %= $ + rot t.rot + sut p:(fine %& p.yep) + == + %| ?- -.p.yep + %& | + %| %= $ + rot t.rot + sut p:(fine %| p.p.yep) + == + == == + :: + ++ fond + ~/ %fond + |= [way=vial hyp=wing] + => |% + ++ pony :: raw match + $@ ~ :: void + %+ each :: natural/abnormal + palo :: arm or leg + %+ each :: abnormal + @ud :: unmatched + (pair type nock) :: synthetic + -- + ^- pony + ?~ hyp + [%& ~ %& sut] + =+ mor=$(hyp t.hyp) + ?- -.mor + %| + ?- -.p.mor + %& mor + %| + =+ fex=(mint(sut p.p.p.mor) %noun [%wing i.hyp ~]) + [%| %| p.fex (comb q.p.p.mor q.fex)] + == + :: + %& + =. sut + =* lap q.p.mor + ?- -.lap + %& p.lap + %| (fork (turn ~(tap in q.lap) head)) + == + => :_ + + :* axe=`axis`1 + lon=p.p.mor + heg=?^(i.hyp i.hyp [%| p=0 q=(some i.hyp)]) + == + ?: ?=(%& -.heg) + [%& [`p.heg lon] %& (peek way p.heg)] + =| gil=(set type) + =< $ + |% ++ here ?: =(0 p.heg) + [%& [~ `axe lon] %& sut] + [%| %& (dec p.heg)] + ++ lose [%| %& p.heg] + ++ stop ?~(q.heg here lose) + ++ twin |= [hax=pony yor=pony] + ^- pony + ~_ leaf+"find-fork" + ?: =(hax yor) hax + ?~ hax yor + ?~ yor hax + ?: ?=(%| -.hax) + ?> ?& ?=(%| -.yor) + ?=(%| -.p.hax) + ?=(%| -.p.yor) + =(q.p.p.hax q.p.p.yor) + == + :+ %| + %| + [(fork p.p.p.hax p.p.p.yor ~) q.p.p.hax] + ?> ?=(%& -.yor) + ?> =(p.p.hax p.p.yor) + ?: &(?=(%& -.q.p.hax) ?=(%& -.q.p.yor)) + :+ %& p.p.hax + [%& (fork p.q.p.hax p.q.p.yor ~)] + ?> &(?=(%| -.q.p.hax) ?=(%| -.q.p.yor)) + ?> =(p.q.p.hax p.q.p.yor) + =+ wal=(~(uni in q.q.p.hax) q.q.p.yor) + :+ %& p.p.hax + [%| p.q.p.hax wal] + ++ $ + ^- pony + ?- sut + %void ~ + %noun stop + [%atom *] stop + [%cell *] + ?~ q.heg here + =+ taf=$(axe (peg axe 2), sut p.sut) + ?~ taf ~ + ?: |(?=(%& -.taf) ?=(%| -.p.taf)) + taf + $(axe (peg axe 3), p.heg p.p.taf, sut q.sut) + :: + [%core *] + ?~ q.heg here + =^ zem p.heg + =+ zem=(loot u.q.heg q.r.q.sut) + ?~ zem [~ p.heg] + ?:(=(0 p.heg) [zem 0] [~ (dec p.heg)]) + ?^ zem + :+ %& + [`axe lon] + =/ zut ^- foot + ?- q.p.q.sut + %wet [%wet q.u.zem] + %dry [%dry q.u.zem] + == + [%| (peg 2 p.u.zem) [[sut zut] ~ ~]] + =+ pec=(peel way r.p.q.sut) + ?. sam.pec lose + ?: con.pec $(sut p.sut, axe (peg axe 3)) + $(sut (peek(sut p.sut) way 2), axe (peg axe 6)) + :: + [%hint *] + $(sut repo) + :: + [%face *] + ?: ?=(~ q.heg) here(sut q.sut) + =* zot p.sut + ?@ zot + ?:(=(u.q.heg zot) here(sut q.sut) lose) + =< main + |% + ++ main + ^- pony + =+ tyr=(~(get by p.zot) u.q.heg) + ?~ tyr + next + ?~ u.tyr + $(sut q.sut, lon [~ lon], p.heg +(p.heg)) + ?. =(0 p.heg) + next(p.heg (dec p.heg)) + =+ tor=(fund way u.u.tyr) + ?- -.tor + %& [%& (weld p.p.tor `vein`[~ `axe lon]) q.p.tor] + %| [%| %| p.p.tor (comb [%0 axe] q.p.tor)] + == + ++ next + |- ^- pony + ?~ q.zot + ^$(sut q.sut, lon [~ lon]) + =+ tiv=(mint(sut q.sut) %noun i.q.zot) + =+ fid=^$(sut p.tiv, lon ~, axe 1, gil ~) + ?~ fid ~ + ?: ?=([%| %& *] fid) + $(q.zot t.q.zot, p.heg p.p.fid) + =/ vat=(pair type nock) + ?- -.fid + %& (fine %& p.fid) + %| (fine %| p.p.fid) + == + [%| %| p.vat (comb (comb [%0 axe] q.tiv) q.vat)] + -- + :: + [%fork *] + =+ wiz=(turn ~(tap in p.sut) |=(a=type ^$(sut a))) + ?~ wiz ~ + |- ^- pony + ?~ t.wiz i.wiz + (twin i.wiz $(wiz t.wiz)) + :: + [%hold *] + ?: (~(has in gil) sut) + ~ + $(gil (~(put in gil) sut), sut repo) + == + -- + == + :: + ++ find + ~/ %find + |= [way=vial hyp=wing] + ^- port + ~_ (show [%c %find] %l hyp) + =- ?@ - !! + ?- -< + %& [%& p.-] + %| ?- -.p.- + %| [%| p.p.-] + %& !! + == == + (fond way hyp) + :: + ++ fund + ~/ %fund + |= [way=vial gen=hoon] + ^- port + =+ hup=~(reek ap gen) + ?~ hup + [%| (mint %noun gen)] + (find way u.hup) + :: + ++ fine + ~/ %fine + |= tor=port + ^- (pair type nock) + ?- -.tor + %| p.tor + %& =+ axe=(tend p.p.tor) + ?- -.q.p.tor + %& [`type`p.q.p.tor %0 axe] + %| [(fire ~(tap in q.q.p.tor)) [%9 p.q.p.tor %0 axe]] + == == + :: + ++ fire + |= hag=(list [p=type q=foot]) + ^- type + ?: ?=([[* [%wet ~ %1]] ~] hag) + p.i.hag + %- fork + %+ turn + hag.$ + |= [p=type q=foot] + ?. ?=([%core *] p) + ~_ (dunk %fire-type) + ~_ leaf+"expected-fork-to-be-core" + ~_ (dunk(sut p) %fork-type) + ~>(%mean.'fire-core' !!) + :- %hold + =+ dox=[%core q.q.p q.p(r.p %gold)] + ?: ?=(%dry -.q) + :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry) + ?> ?|(!vet (nest(sut q.q.p) & p.p)) + [dox p.q] + ?> ?=(%wet -.q) + :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-wet) + =. p.p (redo(sut p.p) q.q.p) + ?> ?| !vet + (~(has in rib) [sut dox p.q]) + !=(** (mull(sut p, rib (~(put in rib) sut dox p.q)) %noun dox p.q)) + == + [p p.q] + :: + ++ fish + ~/ %fish + |= axe=axis + =+ vot=*(set type) + |- ^- nock + ?- sut + %void [%1 1] + %noun [%1 0] + [%atom *] ?~ q.sut + (flip [%3 %0 axe]) + [%5 [%1 u.q.sut] [%0 axe]] + [%cell *] + %+ flan + [%3 %0 axe] + (flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3))) + :: + [%core *] ~>(%mean.'fish-core' !!) + [%face *] $(sut q.sut) + [%fork *] =+ yed=~(tap in p.sut) + |- ^- nock + ?~(yed [%1 1] (flor ^$(sut i.yed) $(yed t.yed))) + [%hint *] $(sut q.sut) + [%hold *] + ?: (~(has in vot) sut) + ~>(%mean.'fish-loop' !!) + => %=(. vot (~(put in vot) sut)) + $(sut repo) + == + :: + ++ fuse + ~/ %fuse + |= ref=type + =+ bix=*(set [type type]) + |- ^- type + ?: ?|(=(sut ref) =(%noun ref)) + sut + ?- sut + [%atom *] + ?- ref + [%atom *] =+ foc=?:((fitz p.ref p.sut) p.sut p.ref) + ?^ q.sut + ?^ q.ref + ?: =(q.sut q.ref) + [%atom foc q.sut] + %void + [%atom foc q.sut] + [%atom foc q.ref] + [%cell *] %void + * $(sut ref, ref sut) + == + [%cell *] + ?- ref + [%cell *] (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref)) + * $(sut ref, ref sut) + == + :: + [%core *] $(sut repo) + [%face *] (face p.sut $(sut q.sut)) + [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<)))) + [%hint *] (hint p.sut $(sut q.sut)) + [%hold *] + ?: (~(has in bix) [sut ref]) + ~>(%mean.'fuse-loop' !!) + $(sut repo, bix (~(put in bix) [sut ref])) + :: + %noun ref + %void %void + == + :: + ++ gain + ~/ %gain + |= gen=hoon ^- type + (chip & gen) + :: + ++ hemp + :: generate formula from foot + :: + |= [hud=poly gol=type gen=hoon] + ^- nock + ~+ + =+ %hemp-141 + ?- hud + %dry q:(mint gol gen) + %wet q:(mint(vet |) gol gen) + == + :: + ++ laze + :: produce lazy core generator for static execution + :: + |= [nym=(unit term) hud=poly dom=(map term tome)] + ~+ + ^- seminoun + =+ %hemp-141 + :: tal: map from battery axis to foot + :: + =; tal=(map @ud hoon) + :: produce lazy battery + :: + :_ ~ + :+ %lazy 1 + |= axe=@ud + ^- (unit noun) + %+ bind (~(get by tal) axe) + |= gen=hoon + %. [hud %noun gen] + hemp(sut (core sut [nym hud %gold] sut [[%lazy 1 ..^$] ~] dom)) + :: + %- ~(gas by *(map @ud hoon)) + =| yeb=(list (pair @ud hoon)) + =+ axe=1 + |^ ?- dom + ~ yeb + [* ~ ~] (chapter q.q.n.dom) + [* * ~] %= $ + dom l.dom + axe (peg axe 3) + yeb (chapter(axe (peg axe 2)) q.q.n.dom) + == + [* ~ *] %= $ + dom r.dom + axe (peg axe 3) + yeb (chapter(axe (peg axe 2)) q.q.n.dom) + == + [* * *] %= $ + dom r.dom + axe (peg axe 7) + yeb %= $ + dom l.dom + axe (peg axe 6) + yeb (chapter(axe (peg axe 2)) q.q.n.dom) + == == == + ++ chapter + |= dab=(map term hoon) + ^+ yeb + ?- dab + ~ yeb + [* ~ ~] [[axe q.n.dab] yeb] + [* * ~] %= $ + dab l.dab + axe (peg axe 3) + yeb [[(peg axe 2) q.n.dab] yeb] + == + [* ~ *] %= $ + dab r.dab + axe (peg axe 3) + yeb [[(peg axe 2) q.n.dab] yeb] + == + [* * *] %= $ + dab r.dab + axe (peg axe 7) + yeb %= $ + dab l.dab + axe (peg axe 6) + yeb [[(peg axe 2) q.n.dab] yeb] + == == == + -- + :: + ++ lose + ~/ %lose + |= gen=hoon ^- type + (chip | gen) + :: + ++ chip + ~/ %chip + |= [how=? gen=hoon] ^- type + ?: ?=([%wtts *] gen) + (cool how q.gen (play ~(example ax p.gen))) + ?: ?=([%wthx *] gen) + =+ (play %wing q.gen) + ~> %slog.[0 [%leaf "chipping"]] + ?: how + =- ~> %slog.[0 (dunk(sut +<) 'chip: gain: ref')] + ~> %slog.[0 (dunk(sut -) 'chip: gain: gain')] + - + ~(gain ar - p.gen) + ~(lose ar - p.gen) + ?: ?&(how ?=([%wtpm *] gen)) + |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) + ?: ?&(!how ?=([%wtbr *] gen)) + |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) + =+ neg=~(open ap gen) + ?:(=(neg gen) sut $(gen neg)) + :: + ++ bake + |= [dox=type hud=poly dab=(map term hoon)] + ^- * + ?: ?=(~ dab) + ~ + =+ ^= dov + :: this seems wrong but it's actually right + :: + ?- hud + %dry (mull %noun dox q.n.dab) + %wet ~ + == + ?- dab + [* ~ ~] dov + [* ~ *] [dov $(dab r.dab)] + [* * ~] [dov $(dab l.dab)] + [* * *] [dov $(dab l.dab) $(dab r.dab)] + == + :: + ++ balk + |= [dox=type hud=poly dom=(map term tome)] + ^- * + ?: ?=(~ dom) + ~ + =+ dov=(bake dox hud q.q.n.dom) + ?- dom + [* ~ ~] dov + [* ~ *] [dov $(dom r.dom)] + [* * ~] [dov $(dom l.dom)] + [* * *] [dov $(dom l.dom) $(dom r.dom)] + == + :: + ++ mile + :: mull all chapters and feet in a core + :: + |= [dox=type mel=vair nym=(unit term) hud=poly dom=(map term tome)] + ^- (pair type type) + =+ yet=(core sut [nym hud %gold] sut (laze nym hud dom) dom) + =+ hum=(core dox [nym hud %gold] dox (laze nym hud dom) dom) + =+ (balk(sut yet) hum hud dom) + [yet hum] + :: + ++ mine + :: mint all chapters and feet in a core + :: + |= [gol=type mel=vair nym=(unit term) hud=poly dom=(map term tome)] + ^- (pair type nock) + |^ + =/ log (chapters-check (core-check gol)) + =/ dog (get-tomes log) + =- :_ [%1 dez] + (core sut [nym hud mel] sut [[%full ~] dez] dom) + ^= dez + =. sut (core sut [nym hud %gold] sut (laze nym hud dom) dom) + |- ^- ?(~ ^) + ?: ?=(~ dom) + ~ + =/ dov=?(~ ^) + =/ dab=(map term hoon) q.q.n.dom + =/ dag (arms-check dab (get-arms dog p.n.dom)) + |- ^- ?(~ ^) + ?: ?=(~ dab) + ~ + =/ gog (get-arm-type log dag p.n.dab) + =+ vad=(hemp hud gog q.n.dab) + ?- dab + [* ~ ~] vad + [* ~ *] [vad $(dab r.dab)] + [* * ~] [vad $(dab l.dab)] + [* * *] [vad $(dab l.dab) $(dab r.dab)] + == + ?- dom + [* ~ ~] dov + [* ~ *] [dov $(dom r.dom)] + [* * ~] [dov $(dom l.dom)] + [* * *] [dov $(dom l.dom) $(dom r.dom)] + == + :: + :: all the below arms are used for gol checking and should have no + :: effect other than giving more specific errors + :: + :: +gol-type: all the possible types we could be expecting. + :: + +$ gol-type + $~ %noun + $@ %noun + $% [%cell p=type q=type] + [%core p=type q=coil] + [%fork p=(set gol-type)] + == + :: +core-check: check that we're looking for a core + :: + ++ core-check + |= log=type + |- ^- gol-type + ?+ log $(log repo(sut log)) + %noun (nice log &) + %void (nice %noun |) + [%atom *] (nice %noun |) + [%cell *] (nice log (nest(sut p.log) & %noun)) + [%core *] (nice log(r.p.q %gold) &) + [%fork *] + =/ tys ~(tap in p.log) + :- %fork + |- ^- (set gol-type) + ?~ tys + ~ + =/ a ^$(log i.tys) + =/ b $(tys t.tys) + (~(put in b) a) + == + :: +chapters-check: check we have the expected number of chapters + :: + ++ chapters-check + |= log=gol-type + |- ^- gol-type + ?- log + %noun (nice log &) + [%cell *] (nice log &) + [%core *] ~_ leaf+"core-number-of-chapters" + (nice log =(~(wyt by dom) ~(wyt by q.r.q.log))) + [%fork *] + =/ tys ~(tap in p.log) + |- ^- gol-type + ?~ tys + log + =/ a ^$(log i.tys) + =/ b $(tys t.tys) + log + == + :: +get-tomes: get map of tomes if exists + :: + ++ get-tomes + |= log=gol-type + ^- (unit (map term tome)) + ?- log + %noun ~ + [%cell *] ~ + [%fork *] ~ :: maybe could be more aggressive + [%core *] `q.r.q.log + == + :: +get-arms: get arms in tome + :: + ++ get-arms + |= [dog=(unit (map term tome)) nam=term] + ^- (unit (map term hoon)) + %+ bind dog + |= a=(map term tome) + ~_ leaf+"unexpcted-chapter.{(trip nam)}" + q:(~(got by a) nam) + :: +arms-check: check we have the expected number of arms + :: + ++ arms-check + |= [dab=(map term hoon) dag=(unit (map term hoon))] + ?~ dag + dag + =/ a + =/ exp ~(wyt by u.dag) + =/ hav ~(wyt by dab) + ~_ =/ expt (scow %ud exp) + =/ havt (scow %ud hav) + leaf+"core-number-of-arms.exp={expt}.hav={havt}" + ~_ =/ missing ~(tap in (~(dif in ~(key by u.dag)) ~(key by dab))) + leaf+"missing.{}" + ~_ =/ extra ~(tap in (~(dif in ~(key by dab)) ~(key by u.dag))) + leaf+"extra.{}" + ~_ =/ have ~(tap in ~(key by dab)) + leaf+"have.{}" + (nice dag =(exp hav)) + a + :: +get-arm-type: get expected type of this arm + :: + ++ get-arm-type + |= [log=gol-type dag=(unit (map term hoon)) nam=term] + ^- type + %- fall :_ %noun + %+ bind dag + |= a=(map term hoon) + =/ gen=hoon + ~_ leaf+"unexpected-arm.{(trip nam)}" + (~(got by a) nam) + (play(sut log) gen) + :: + ++ nice + |* [typ=* gud=?] + ?: gud + typ + ~_ leaf+"core-nice" + !! + -- + :: + ++ mint + ~/ %mint + |= [gol=type gen=hoon] + ^- [p=type q=nock] + ::~& %pure-mint + |^ ^- [p=type q=nock] + ?: ?&(=(%void sut) !?=([%dbug *] gen)) + ?. |(!vet ?=([%lost *] gen) ?=([%zpzp *] gen)) + ~>(%mean.'mint-vain' !!) + [%void %0 0] + ?- gen + :: + [^ *] + =+ hed=$(gen p.gen, gol %noun) + =+ tal=$(gen q.gen, gol %noun) + [(nice (cell p.hed p.tal)) (cons q.hed q.tal)] + :: + [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen) + [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen) + :: + [%cnts *] (~(mint et p.gen q.gen) gol) + :: + [%dtkt *] + =+ nef=$(gen [%kttr p.gen]) + [p.nef [%12 [%1 hoon-version p.nef] q:$(gen q.gen, gol %noun)]] + :: + [%dtls *] [(nice [%atom %$ ~]) [%4 q:$(gen p.gen, gol [%atom %$ ~])]] + [%sand *] [(nice (play gen)) [%1 q.gen]] + [%rock *] [(nice (play gen)) [%1 q.gen]] + :: + [%dttr *] + [(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]] + :: + [%dtts *] + [(nice bool) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]] + :: + [%dtwt *] [(nice bool) [%3 q:$(gen p.gen, gol %noun)]] + [%hand *] [p.gen q.gen] + [%ktbr *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %iron)) q.vat]) + :: + [%ktls *] + =+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)]) + :: + [%ktpm *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %zinc)) q.vat]) + [%ktsg *] (blow gol p.gen) + [%tune *] [(face p.gen sut) [%0 %1]] + [%ktwt *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %lead)) q.vat]) + :: + [%note *] + =+ hum=$(gen q.gen) + [(hint [sut p.gen] p.hum) q.hum] + :: + [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen)) + [%sggr *] + =+ hum=$(gen q.gen) + :: ?: &(huz !?=(%|(@ [?(%sgcn %sgls) ^]) p.gen)) + :: hum + :- p.hum + :+ %11 + ?- p.gen + @ p.gen + ^ [p.p.gen q:$(gen q.p.gen, gol %noun)] + == + q.hum + :: + [%tsgr *] + =+ fid=$(gen p.gen, gol %noun) + =+ dov=$(sut p.fid, gen q.gen) + [p.dov (comb q.fid q.dov)] + :: + [%tscm *] + $(gen q.gen, sut (busk p.gen)) + :: + [%wtcl *] + =+ nor=$(gen p.gen, gol bool) + =+ fex=(gain p.gen) + =+ wux=(lose p.gen) + =+ ^= duy + ?: =(%void fex) + ?:(=(%void wux) [%0 0] [%1 1]) + ?:(=(%void wux) [%1 0] q.nor) + =+ hiq=$(sut fex, gen q.gen) + =+ ran=$(sut wux, gen r.gen) + [(fork p.hiq p.ran ~) (cond duy q.hiq q.ran)] + :: + [%wthx *] + :- (nice bool) + =+ fid=(find %read [[%& 1] q.gen]) + ~> %mean.'mint-fragment' + ?> &(?=(%& -.fid) ?=(%& -.q.p.fid)) + (~(fish ar `type`p.q.p.fid `skin`p.gen) (tend p.p.fid)) + :: + [%fits *] + :- (nice bool) + =+ ref=(play p.gen) + =+ fid=(find %read q.gen) + ~| [%test q.gen] + |- ^- nock + ?- -.fid + %& ?- -.q.p.fid + %& (fish(sut ref) (tend p.p.fid)) + %| $(fid [%| (fine fid)]) + == + %| [%7 q.p.fid (fish(sut ref) 1)] + == + :: + [%dbug *] + ~_ (show %o p.gen) + =+ hum=$(gen q.gen) + [p.hum [%11 [%spot %1 p.gen] q.hum]] + :: + [%zpcm *] [(nice (play p.gen)) [%1 q.gen]] :: XX validate! + [%lost *] + ?: vet + ~_ (dunk(sut (play p.gen)) 'lost') + ~>(%mean.'mint-lost' !!) + [%void [%0 0]] + :: + [%zpmc *] + =+ vos=$(gol %noun, gen q.gen) + =+ ref=p:$(gol %noun, gen p.gen) + [(nice (cell ref p.vos)) (cons [%1 burp(sut p.vos)] q.vos)] + :: + [%zpgl *] + =/ typ (nice (play [%kttr p.gen])) + =/ val + =< q + %_ $ + gol %noun + gen + :^ %wtcl + :+ %cncl [%limb %levi] + :~ [%tsgr [%zpgr [%kttr p.gen]] [%$ 2]] + [%tsgr q.gen [%$ 2]] + == + [%tsgr q.gen [%$ 3]] + [%zpzp ~] + == + [typ val] + :: + [%zpts *] [(nice %noun) [%1 q:$(vet |, gen p.gen)]] + [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen)) + :: + [%zpzp ~] [%void [%0 0]] + * + =+ doz=~(open ap gen) + ?: =(doz gen) + ~_ (show [%c 'hoon'] [%q gen]) + ~>(%mean.'mint-open' !!) + $(gen doz) + == + :: + ++ nice + |= typ=type + ~_ leaf+"mint-nice" + ?> ?|(!vet (nest(sut gol) & typ)) + typ + :: + ++ grow + |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)] + ^- [p=type q=nock] + =+ dan=^$(gen ruf, gol %noun) + =+ pul=(mine gol mel nym hud dom) + [(nice p.pul) (cons q.pul q.dan)] + -- + :: + ++ moot + =+ gil=*(set type) + |- ^- ? + ?- sut + [%atom *] | + [%cell *] |($(sut p.sut) $(sut q.sut)) + [%core *] $(sut p.sut) + [%face *] $(sut q.sut) + [%fork *] (levy ~(tap in p.sut) |=(type ^$(sut +<))) + [%hint *] $(sut q.sut) + [%hold *] |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo)) + %noun | + %void & + == + :: + ++ mull + ~/ %mull + |= [gol=type dox=type gen=hoon] + |^ ^- [p=type q=type] + ?: =(%void sut) + ~>(%mean.'mull-none' !!) + ?- gen + :: + [^ *] + =+ hed=$(gen p.gen, gol %noun) + =+ tal=$(gen q.gen, gol %noun) + [(nice (cell p.hed p.tal)) (cell q.hed q.tal)] + :: + [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen) + [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen) + [%cnts *] (~(mull et p.gen q.gen) gol dox) + [%dtkt *] =+($(gen q.gen, gol %noun) $(gen [%kttr p.gen])) + [%dtls *] =+($(gen p.gen, gol [%atom %$ ~]) (beth [%atom %$ ~])) + [%sand *] (beth (play gen)) + [%rock *] (beth (play gen)) + :: + [%dttr *] + =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth %noun)) + :: + [%dtts *] + =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth bool)) + :: + [%dtwt *] =+($(gen p.gen, gol %noun) (beth bool)) :: XX =| + [%hand *] [p.gen p.gen] + [%ktbr *] + =+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) (wrap(sut q.vat) %iron)]) + :: + [%ktls *] + =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)] + =+($(gen q.gen, gol p.hif) hif) + :: + [%ktpm *] + =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)]) + :: + [%tune *] + [(face p.gen sut) (face p.gen dox)] + :: + [%ktwt *] + =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) (wrap(sut q.vat) %lead)]) + :: + [%note *] + =+ vat=$(gen q.gen) + [(hint [sut p.gen] p.vat) (hint [dox p.gen] q.vat)] + :: + [%ktsg *] $(gen p.gen) + [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen)) + [%sggr *] $(gen q.gen) + [%tsgr *] + =+ lem=$(gen p.gen, gol %noun) + $(gen q.gen, sut p.lem, dox q.lem) + :: + [%tscm *] + =/ boc (busk p.gen) + =/ nuf (busk(sut dox) p.gen) + $(gen q.gen, sut boc, dox nuf) + :: + [%wtcl *] + =+ nor=$(gen p.gen, gol bool) + =+ ^= hiq ^- [p=type q=type] + =+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)] + ?: =(%void p.fex) + :- %void + ?: =(%void q.fex) + %void + ~>(%mean.'if-z' (play(sut q.fex) q.gen)) + ?: =(%void q.fex) + ~>(%mean.'mull-bonk-b' !!) + $(sut p.fex, dox q.fex, gen q.gen) + =+ ^= ran ^- [p=type q=type] + =+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)] + ?: =(%void p.wux) + :- %void + ?: =(%void q.wux) + %void + ~>(%mean.'if-a' (play(sut q.wux) r.gen)) + ?: =(%void q.wux) + ~>(%mean.'mull-bonk-c' !!) + $(sut p.wux, dox q.wux, gen r.gen) + [(nice (fork p.hiq p.ran ~)) (fork q.hiq q.ran ~)] + :: + [%fits *] + =+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)] + =+ ^= syx :- p=(cove q:(mint %noun [%wing q.gen])) + q=(cove q:(mint(sut dox) %noun [%wing q.gen])) + =+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)] + ?. &(=(p.syx q.syx) =(p.pov q.pov)) + ~>(%mean.'mull-bonk-a' !!) + (beth bool) + :: + [%wthx *] + ~> %mean.'mull-bonk-x' + =+ :- =+ (find %read [[%& 1] q.gen]) + ?> &(?=(%& -.-) ?=(%& -.q.p.-)) + new=[type=p.q.p.- axis=(tend p.p.-)] + =+ (find(sut dox) %read [%& 1] q.gen) + ?> &(?=(%& -.-) ?=(%& -.q.p.-)) + old=[type=p.q.p.- axis=(tend p.p.-)] + ?> =(axis.old axis.new) + ?> (nest(sut type.old) & type.new) + (beth bool) + :: + [%dbug *] ~_((show %o p.gen) $(gen q.gen)) + [%zpcm *] [(nice (play p.gen)) (play(sut dox) p.gen)] + [%lost *] + ?: vet + :: ~_ (dunk(sut (play p.gen)) 'also') + ~>(%mean.'mull-skip' !!) + (beth %void) + :: + [%zpts *] (beth %noun) + :: + [%zpmc *] + =+ vos=$(gol %noun, gen q.gen) :: XX validate! + [(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)] + :: + [%zpgl *] + :: XX is this right? + (beth (play [%kttr p.gen])) + :: + [%zppt *] + =+ [(feel p.gen) (feel(sut dox) p.gen)] + ?. =(-< ->) + ~>(%mean.'mull-bonk-f' !!) + ?: -< + $(gen q.gen) + $(gen r.gen) + :: + [%zpzp *] (beth %void) + * + =+ doz=~(open ap gen) + ?: =(doz gen) + ~_ (show [%c 'hoon'] [%q gen]) + ~>(%mean.'mull-open' !!) + $(gen doz) + == + :: + ++ beth + |= typ=type + [(nice typ) typ] + :: + ++ nice + |= typ=type + :: ~_ (dunk(sut gol) 'need') + :: ~_ (dunk(sut typ) 'have') + ~_ leaf+"mull-nice" + ?> ?|(!vet (nest(sut gol) & typ)) + typ + :: + ++ grow + |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)] + :: make al + ~_ leaf+"mull-grow" + ^- [p=type q=type] + =+ dan=^$(gen ruf, gol %noun) + =+ yaz=(mile(sut p.dan) q.dan mel nym hud dom) + [(nice p.yaz) q.yaz] + -- + ++ meet |=(ref=type &((nest | ref) (nest(sut ref) | sut))) + :: :: + ++ miss :: nonintersection + |= $: :: ref: symmetric type + :: + ref=type + == + :: intersection of sut and ref is empty + :: + ^- ? + =| gil=(set (set type)) + =< dext + |% + ++ dext + ^- ? + :: + ?: =(ref sut) + (nest(sut %void) | sut) + ?- sut + %void & + %noun (nest(sut %void) | ref) + [%atom *] sint + [%cell *] sint + [%core *] sint(sut [%cell %noun %noun]) + [%fork *] %+ levy ~(tap in p.sut) + |=(type dext(sut +<)) + [%face *] dext(sut q.sut) + [%hint *] dext(sut q.sut) + [%hold *] =+ (~(gas in *(set type)) `(list type)`[sut ref ~]) + ?: (~(has in gil) -) + & + %= dext + sut repo + gil (~(put in gil) -) + == == + ++ sint + ?+ ref dext(sut ref, ref sut) + [%atom *] ?. ?=([%atom *] sut) & + ?& ?=(^ q.ref) + ?=(^ q.sut) + !=(q.ref q.sut) + == + [%cell *] ?. ?=([%cell *] sut) & + ?| dext(sut p.sut, ref p.ref) + dext(sut q.sut, ref q.ref) + == == + -- + ++ mite |=(ref=type |((nest | ref) (nest(sut ref) & sut))) + ++ nest + ~/ %nest + |= [tel=? ref=type] + =| $: seg=(set type) :: degenerate sut + reg=(set type) :: degenerate ref + gil=(set [p=type q=type]) :: assume nest + == + =< dext + ~% %nest-in ..$ ~ + |% + ++ deem + |= [mel=vair ram=vair] + ^- ? + ?. |(=(mel ram) =(%lead mel) =(%gold ram)) | + ?- mel + %lead & + %gold meet + %iron dext(sut (peek(sut ref) %rite 2), ref (peek %rite 2)) + %zinc dext(sut (peek %read 2), ref (peek(sut ref) %read 2)) + == + :: + ++ deep + |= $: dom=(map term tome) + vim=(map term tome) + == + ^- ? + ?: ?=(~ dom) =(vim ~) + ?: ?=(~ vim) | + ?& =(p.n.dom p.n.vim) + $(dom l.dom, vim l.vim) + $(dom r.dom, vim r.vim) + :: + =+ [dab hem]=[q.q.n.dom q.q.n.vim] + |- ^- ? + ?: ?=(~ dab) =(hem ~) + ?: ?=(~ hem) | + ?& =(p.n.dab p.n.hem) + $(dab l.dab, hem l.hem) + $(dab r.dab, hem r.hem) + %= dext + sut (play q.n.dab) + ref (play(sut ref) q.n.hem) + == == == + :: + ++ dext + =< $ + ~% %nest-dext + ~ + |. + ^- ? + =- ?: - & + ?. tel | + ~_ (dunk %need) + ~_ (dunk(sut ref) %have) + ~> %mean.'nest-fail' + !! + ?: =(sut ref) & + ?- sut + %void sint + %noun & + [%atom *] ?. ?=([%atom *] ref) sint + ?& (fitz p.sut p.ref) + |(?=(~ q.sut) =(q.sut q.ref)) + == + [%cell *] ?. ?=([%cell *] ref) sint + ?& dext(sut p.sut, ref p.ref, seg ~, reg ~) + dext(sut q.sut, ref q.ref, seg ~, reg ~) + == + [%core *] ?. ?=([%core *] ref) sint + ?: =(q.sut q.ref) dext(sut p.sut, ref p.ref) + ?& =(q.p.q.sut q.p.q.ref) :: same wet/dry + meet(sut q.q.sut, ref p.sut) + dext(sut q.q.ref, ref p.ref) + (deem(sut q.q.sut, ref q.q.ref) r.p.q.sut r.p.q.ref) + ?: =(%wet q.p.q.sut) =(q.r.q.sut q.r.q.ref) + ?| (~(has in gil) [sut ref]) + %. [q.r.q.sut q.r.q.ref] + %= deep + gil (~(put in gil) [sut ref]) + sut sut(p q.q.sut, r.p.q %gold) + ref ref(p q.q.ref, r.p.q %gold) + == == + == + [%face *] dext(sut q.sut) + [%fork *] ?. ?=(?([%atom *] %noun [%cell *] [%core *]) ref) sint + (lien ~(tap in p.sut) |=(type dext(tel |, sut +<))) + [%hint *] dext(sut q.sut) + [%hold *] ?: (~(has in seg) sut) | + ?: (~(has in gil) [sut ref]) & + %= dext + sut repo + seg (~(put in seg) sut) + gil (~(put in gil) [sut ref]) + == == + :: + ++ meet &(dext dext(sut ref, ref sut)) + ++ sint + ^- ? + ?- ref + %noun | + %void & + [%atom *] | + [%cell *] | + [%core *] dext(ref repo(sut ref)) + [%face *] dext(ref q.ref) + [%fork *] (levy ~(tap in p.ref) |=(type dext(ref +<))) + [%hint *] dext(ref q.ref) + [%hold *] ?: (~(has in reg) ref) & + ?: (~(has in gil) [sut ref]) & + %= dext + ref repo(sut ref) + reg (~(put in reg) ref) + gil (~(put in gil) [sut ref]) + == == + -- + :: + ++ peek + ~/ %peek + |= [way=?(%read %rite %both %free) axe=axis] + ^- type + ?: =(1 axe) + sut + =+ [now=(cap axe) lat=(mas axe)] + =+ gil=*(set type) + |- ^- type + ?- sut + [%atom *] %void + [%cell *] ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat)) + [%core *] + ?. =(3 now) %noun + =+ pec=(peel way r.p.q.sut) + =/ tow + ?: =(1 lat) 1 + (cap lat) + %= ^$ + axe lat + sut + ?: ?| =([& &] pec) + &(sam.pec =(tow 2)) + &(con.pec =(tow 3)) + == + p.sut + ~_ leaf+"payload-block" + ?. =(way %read) !! + %+ cell + ?.(sam.pec %noun ^$(sut p.sut, axe 2)) + ?.(con.pec %noun ^$(sut p.sut, axe 3)) + == + :: + [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<)))) + [%hold *] + ?: (~(has in gil) sut) + %void + $(gil (~(put in gil) sut), sut repo) + :: + %void %void + %noun %noun + * $(sut repo) + == + :: + ++ peel + |= [way=vial met=?(%gold %iron %lead %zinc)] + ^- [sam=? con=?] + ?: ?=(%gold met) [& &] + ?- way + %both [| |] + %free [& &] + %read [?=(%zinc met) |] + %rite [?=(%iron met) |] + == + :: + ++ play + ~/ %play + => .(vet |) + |= gen=hoon + ^- type + ?- gen + [^ *] (cell $(gen p.gen) $(gen q.gen)) + [%brcn *] (core sut [p.gen %dry %gold] sut *seminoun q.gen) + [%brpt *] (core sut [p.gen %wet %gold] sut *seminoun q.gen) + [%cnts *] ~(play et p.gen q.gen) + [%dtkt *] $(gen [%kttr p.gen]) + [%dtls *] [%atom %$ ~] + [%rock *] |- ^- type + ?@ q.gen [%atom p.gen `q.gen] + [%cell $(q.gen -.q.gen) $(q.gen +.q.gen)] + [%sand *] ?@ q.gen + ?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen `q.gen]) + ?: =(%f p.gen) ?>((lte q.gen 1) bool) + [%atom p.gen ~] + $(-.gen %rock) + [%tune *] (face p.gen sut) + [%dttr *] %noun + [%dtts *] bool + [%dtwt *] bool + [%hand *] p.gen + [%ktbr *] (wrap(sut $(gen p.gen)) %iron) + [%ktls *] $(gen p.gen) + [%ktpm *] (wrap(sut $(gen p.gen)) %zinc) + [%ktsg *] $(gen p.gen) + [%ktwt *] (wrap(sut $(gen p.gen)) %lead) + [%note *] (hint [sut p.gen] $(gen q.gen)) + [%sgzp *] ~_(duck(sut ^$(gen p.gen)) $(gen q.gen)) + [%sggr *] $(gen q.gen) + [%tsgr *] $(gen q.gen, sut $(gen p.gen)) + [%tscm *] $(gen q.gen, sut (busk p.gen)) + [%wtcl *] =+ [fex=(gain p.gen) wux=(lose p.gen)] + %- fork :~ + ?:(=(%void fex) %void $(sut fex, gen q.gen)) + ?:(=(%void wux) %void $(sut wux, gen r.gen)) + == + [%fits *] bool + [%wthx *] bool + [%dbug *] ~_((show %o p.gen) $(gen q.gen)) + [%zpcm *] $(gen p.gen) + [%lost *] %void + [%zpmc *] (cell $(gen p.gen) $(gen q.gen)) + [%zpgl *] (play [%kttr p.gen]) + [%zpts *] %noun + [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen)) + [%zpzp *] %void + * =+ doz=~(open ap gen) + ?: =(doz gen) + ~_ (show [%c 'hoon'] [%q gen]) + ~> %mean.'play-open' + !! + $(gen doz) + == + :: :: + ++ redo :: refurbish faces + ~/ %redo + |= $: :: ref: raw payload + :: + ref=type + == + :: :type: subject refurbished to reference namespace + :: + ^- type + :: hos: subject tool stack + :: wec: reference tool stack set + :: gil: repetition set + :: + =| hos=(list tool) + =/ wec=(set (list tool)) [~ ~ ~] + =| gil=(set (pair type type)) + =< :: errors imply subject/reference mismatch + :: + ~| %redo-match + :: reduce by subject + :: + dext + |% + :: :: + ++ dear :: resolve tool stack + :: :(unit (list tool)): unified tool stack + :: + ^- (unit (list tool)) + :: empty implies void + :: + ?~ wec `~ + :: any reference faces must be clear + :: + ?. ?=([* ~ ~] wec) + ~& [%dear-many wec] + ~ + :- ~ + :: har: single reference tool stack + :: + =/ har n.wec + :: len: lengths of [sut ref] face stacks + :: + =/ len [p q]=[(lent hos) (lent har)] + :: lip: length of sut-ref face stack overlap + :: + :: AB + :: BC + :: + :: +lip is (lent B), where +hay is forward AB + :: and +liv is forward BC (stack BA and CB). + :: + :: overlap is a weird corner case. +lip is + :: almost always 0. brute force is fine. + :: + =/ lip + =| lup=(unit @ud) + =| lip=@ud + |- ^- @ud + ?: |((gth lip p.len) (gth lip q.len)) + (fall lup 0) + :: lep: overlap candidate: suffix of subject face stack + :: + =/ lep (slag (sub p.len lip) hos) + :: lap: overlap candidate: prefix of reference face stack + :: + =/ lap (scag lip har) + :: save any match and continue + :: + $(lip +(lip), lup ?.(=(lep lap) lup `lip)) + :: ~& [har+har hos+hos len+len lip+lip] + :: produce combined face stack (forward ABC, stack CBA) + :: + (weld hos (slag lip har)) + :: :: + ++ dext :: subject traverse + :: :type: refurbished subject + :: + ^- type + :: check for trivial cases + :: + ?: ?| =(sut ref) + ?=(?(%noun %void [?(%atom %core) *]) ref) + == + done + :: ~_ (dunk 'redo: dext: sut') + :: ~_ (dunk(sut ref) 'redo: dext: ref') + ?- sut + ?(%noun %void [?(%atom %core) *]) + :: reduce reference and reassemble leaf + :: + done:(sint &) + :: + [%cell *] + :: reduce reference to match subject + :: + => (sint &) + ?> ?=([%cell *] sut) + :: leaf with possible recursive descent + :: + %= done + sut + :: clear face stacks for descent + :: + =: hos ~ + wec [~ ~ ~] + == + :: descend into cell + :: + :+ %cell + dext(sut p.sut, ref (peek(sut ref) %free 2)) + dext(sut q.sut, ref (peek(sut ref) %free 3)) + == + :: + [%face *] + :: push face on subject stack, and descend + :: + dext(hos [p.sut hos], sut q.sut) + :: + [%hint *] + :: work through hint + :: + (hint p.sut dext(sut q.sut)) + :: + [%fork *] + :: reconstruct each case in fork + :: + (fork (turn ~(tap in p.sut) |=(type dext(sut +<)))) + :: + [%hold *] + :: reduce to hard + :: + => (sint |) + ?> ?=([%hold *] sut) + ?: (~(has in fan) [p.sut q.sut]) + :: repo loop; redo depends on its own product + :: + done:(sint &) + ?: (~(has in gil) [sut ref]) + :: type recursion, stop renaming + :: + done:(sint |) + :: restore unchanged holds + :: + =+ repo + =- ?:(=(- +<) sut -) + dext(sut -, gil (~(put in gil) sut ref)) + == + :: :: + ++ done :: complete assembly + ^- type + :: :type: subject refurbished + :: + :: lov: combined face stack + :: + =/ lov + =/ lov dear + ?~ lov + :: ~_ (dunk 'redo: dear: sut') + :: ~_ (dunk(sut ref) 'redo: dear: ref') + ~& [%wec wec] + !! + (need lov) + :: recompose faces + :: + |- ^- type + ?~ lov sut + $(lov t.lov, sut (face i.lov sut)) + :: + ++ sint :: reduce by reference + |= $: :: hod: expand holds + :: + hod=? + == + :: ::.: reference with face/fork/hold reduced + :: + ^+ . + :: =- ~> %slog.[0 (dunk 'sint: sut')] + :: ~> %slog.[0 (dunk(sut ref) 'sint: ref')] + :: ~> %slog.[0 (dunk(sut =>(- ref)) 'sint: pro')] + :: - + ?+ ref . + [%hint *] $(ref q.ref) + [%face *] + :: extend all stacks in set + :: + %= $ + ref q.ref + wec (~(run in wec) |=((list tool) [p.ref +<])) + == + :: + [%fork *] + :: reconstruct all relevant cases + :: + =- :: ~> %slog.[0 (dunk 'fork: sut')] + :: ~> %slog.[0 (dunk(sut ref) 'fork: ref')] + :: ~> %slog.[0 (dunk(sut (fork ->)) 'fork: pro')] + +(wec -<, ref (fork ->)) + =/ moy ~(tap in p.ref) + |- ^- (pair (set (list tool)) (list type)) + ?~ moy [~ ~] + :: head recurse + :: + =/ mor $(moy t.moy) + :: prune reference cases outside subject + :: + ?: (miss i.moy) mor + :: unify all cases + :: + =/ dis ^$(ref i.moy) + [(~(uni in p.mor) wec.dis) [ref.dis q.mor]] + :: + [%hold *] + ?. hod . + $(ref repo(sut ref)) + == + -- + :: + ++ repo + ^- type + ?- sut + [%core *] [%cell %noun p.sut] + [%face *] q.sut + [%hint *] q.sut + [%hold *] (rest [[p.sut q.sut] ~]) + %noun (fork [%atom %$ ~] [%cell %noun %noun] ~) + * ~>(%mean.'repo-fltt' !!) + == + :: + ++ rest + ~/ %rest + |= leg=(list [p=type q=hoon]) + ^- type + ?: (lien leg |=([p=type q=hoon] (~(has in fan) [p q]))) + ~>(%mean.'rest-loop' !!) + => .(fan (~(gas in fan) leg)) + %- fork + %~ tap in + %- ~(gas in *(set type)) + (turn leg |=([p=type q=hoon] (play(sut p) q))) + :: + ++ sink + ~/ %sink + |^ ^- cord + ?- sut + %void 'void' + %noun 'noun' + [%atom *] (rap 3 'atom ' p.sut ' ' ?~(q.sut '~' u.q.sut) ~) + [%cell *] (rap 3 'cell ' (mup p.sut) ' ' (mup q.sut) ~) + [%face *] (rap 3 'face ' ?@(p.sut p.sut (mup p.sut)) ' ' (mup q.sut) ~) + [%fork *] (rap 3 'fork ' (mup p.sut) ~) + [%hint *] (rap 3 'hint ' (mup p.sut) ' ' (mup q.sut) ~) + [%hold *] (rap 3 'hold ' (mup p.sut) ' ' (mup q.sut) ~) + :: + [%core *] + %+ rap 3 + :~ 'core ' + (mup p.sut) + ' ' + ?~(p.p.q.sut '~' u.p.p.q.sut) + ' ' + q.p.q.sut + ' ' + r.p.q.sut + ' ' + (mup q.q.sut) + ' ' + (mup p.r.q.sut) + == + == + :: + ++ mup |=(* (scot %p (mug +<))) + -- + :: + ++ take + |= [vit=vein duz=$-(type type)] + ^- (pair axis type) + :- (tend vit) + =. vit (flop vit) + |- ^- type + ?~ vit (duz sut) + ?~ i.vit + |- ^- type + ?+ sut ^$(vit t.vit) + [%face *] (face p.sut ^$(vit t.vit, sut q.sut)) + [%hint *] (hint p.sut ^$(sut q.sut)) + [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<)))) + [%hold *] $(sut repo) + == + =+ vil=*(set type) + |- ^- type + ?: =(1 u.i.vit) + ^$(vit t.vit) + =+ [now lat]=(cap u.i.vit)^(mas u.i.vit) + ?- sut + %noun $(sut [%cell %noun %noun]) + %void %void + [%atom *] %void + [%cell *] ?: =(2 now) + (cell $(sut p.sut, u.i.vit lat) q.sut) + (cell p.sut $(sut q.sut, u.i.vit lat)) + [%core *] ?: =(2 now) + $(sut repo) + (core $(sut p.sut, u.i.vit lat) q.sut) + [%face *] (face p.sut $(sut q.sut)) + [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<)))) + [%hint *] (hint p.sut $(sut q.sut)) + [%hold *] ?: (~(has in vil) sut) + %void + $(sut repo, vil (~(put in vil) sut)) + == + :: + ++ tack + |= [hyp=wing mur=type] + ~_ (show [%c %tack] %l hyp) + =+ fid=(find %rite hyp) + ?> ?=(%& -.fid) + (take p.p.fid |=(type mur)) + :: + ++ tend + |= vit=vein + ^- axis + ?~(vit 1 (peg $(vit t.vit) ?~(i.vit 1 u.i.vit))) + :: + ++ toss + ~/ %toss + |= [hyp=wing mur=type men=(list [p=type q=foot])] + ^- [p=axis q=(list [p=type q=foot])] + =- [(need p.wib) q.wib] + ^= wib + |- ^- [p=(unit axis) q=(list [p=type q=foot])] + ?~ men + [*(unit axis) ~] + =+ geq=(tack(sut p.i.men) hyp mur) + =+ mox=$(men t.men) + [(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]] + :: + ++ wrap + ~/ %wrap + |= yoz=?(%lead %iron %zinc) + ~_ leaf+"wrap" + ^- type + ?+ sut sut + [%cell *] (cell $(sut p.sut) $(sut q.sut)) + [%core *] ?>(|(=(%gold r.p.q.sut) =(%lead yoz)) sut(r.p.q yoz)) + [%face *] (face p.sut $(sut q.sut)) + [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<)))) + [%hint *] (hint p.sut $(sut q.sut)) + [%hold *] $(sut repo) + == + -- +++ 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] :: + [%name p=stud q=wine] :: + == :: + -- + |_ sut=type + ++ dash + |= [mil=tape lim=char lam=tape] + ^- tape + =/ esc (~(gas in *(set @tD)) lam) + :- lim + |- ^- tape + ?~ mil [lim ~] + ?: ?| =(lim i.mil) + =('\\' i.mil) + (~(has in esc) i.mil) + == + ['\\' i.mil $(mil t.mil)] + ?: (lte ' ' i.mil) + [i.mil $(mil t.mil)] + ['\\' ~(x ne (rsh 2 i.mil)) ~(x ne (end 2 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 ~]) + :: + [%name *] + :_ gid + ?@ p.q.ham (cat 3 '#' mark.p.q.ham) + (rap 3 '#' auth.p.q.ham '+' (spat type.p.q.ham) ~) + == + -- + :: + ++ 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=;;(tank .*(vol [%9 2 %0 1])) + :^ ~ %palm + [~ ~ ~ ~] + [[%leaf '#' 't' '/' ~] cis ~] + :: + %wall + :- ~ + :+ %rose + [[' ' ~] ['<' '|' ~] ['|' '>' ~]] + |- ^- (list tank) + ?~ lum ~ + ?@ lum !! + [[%leaf (trip ;;(@ -.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 ~] + :: + [%name *] + $(q.ham q.q.ham) + == + :: + ++ 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.r.q.sut) |=(tome ~(wyt by q.+<)))) + |=([[@ a=@u] b=@u] (add a b)) + %^ cat 3 + ?-(r.p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&') + =+ gum=(mug q.r.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))] + == + :: + [%hint *] + =+ yad=$(sut q.sut) + ?. ?=(%know -.q.p.sut) yad + [p.yad [%name p.q.p.sut q.yad]] + :: + [%face *] + =+ yad=$(sut q.sut) + ?^(p.sut yad [p.yad [%face p.sut q.yad]]) + :: + [%fork *] + =+ yed=(sort ~(tap in p.sut) aor) + =- [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) + -- +++ cain sell :: $-(vase tank) +++ noah text :: $-(vase tape) +++ onan seer :: $-(vise vase) +++ levi :: $-([type type] ?) + |= [a=type b=type] + (~(nest ut a) & b) +:: +++ text :: tape pretty-print + |= vax=vase ^- tape + ~(ram re (sell vax)) +:: +++ seem |=(toy=typo `type`toy) :: promote typo +++ seer |=(vix=vise `vase`vix) :: promote vise +:: +:: +sell: pretty-print a vase to a tank using +deal. +:: +++ sell + ~/ %sell + |= vax=vase + ^- tank + ~| %sell + (~(deal us p.vax) q.vax) +:: +:: +skol: $-(type tank) using duck. +:: +++ skol + |= typ=type + ^- tank + ~(duck ut typ) +:: +++ slam :: slam a gate + |= [gat=vase sam=vase] ^- vase + =+ :- ^= typ ^- type + [%cell p.gat p.sam] + ^= gen ^- hoon + [%cnsg [%$ ~] [%$ 2] [%$ 3] ~] + =+ gun=(~(mint ut typ) %noun gen) + [p.gun (slum q.gat q.sam)] +:: +:: +slab: states whether you can access an arm in a type. +:: +:: .way: the access type ($vial): read, write, or read-and-write. +:: The fourth case of $vial, %free, is not permitted because it would +:: allow you to discover "private" information about a type, +:: information which you could not make use of in (law-abiding) hoon anyway. +:: +++ slab :: test if contains + |= [way=?(%read %rite %both) cog=@tas typ=type] + ?= [%& *] + (~(fond ut typ) way ~[cog]) +:: +++ slap + |= [vax=vase gen=hoon] ^- vase :: untyped vase .* + =+ gun=(~(mint ut p.vax) %noun gen) + [p.gun .*(q.vax q.gun)] +:: +++ slog :: deify printf + =| pri=@ :: priority level + |= a=tang ^+ same :: .= ~&(%a 1) + ?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1) +:: :: +++ mean :: crash with trace + |= a=tang + ^+ !! + ?~ a !! + ~_(i.a $(a t.a)) +:: +++ road + |* =(trap *) + ^+ $:trap + =/ res (mule trap) + ?- -.res + %& p.res + %| (mean p.res) + == +:: +++ slew :: get axis in vase + |= [axe=@ vax=vase] + =/ typ |. (~(peek ut p.vax) %free axe) + |- ^- (unit vase) + ?: =(1 axe) `[$:typ q.vax] + ?@ q.vax ~ + $(axe (mas axe), q.vax ?-((cap axe) %2 -.q.vax, %3 +.q.vax)) +:: +++ slim :: identical to seer? + |= old=vise ^- vase + old +:: +++ slit :: type of slam + |= [gat=type sam=type] + ?> (~(nest ut (~(peek ut gat) %free 6)) & sam) + (~(play ut [%cell gat sam]) [%cnsg [%$ ~] [%$ 2] [%$ 3] ~]) +:: +++ slob :: superficial arm + |= [cog=@tas typ=type] + ^- ? + ?+ typ | + [%hold *] $(typ ~(repo ut typ)) + [%hint *] $(typ ~(repo ut typ)) + [%core *] + |- ^- ? + ?~ q.r.q.typ | + ?| (~(has by q.q.n.q.r.q.typ) cog) + $(q.r.q.typ l.q.r.q.typ) + $(q.r.q.typ r.q.r.q.typ) + == + == +:: +++ sloe :: get arms in core + |= typ=type + ^- (list term) + ?+ typ ~ + [%hold *] $(typ ~(repo ut typ)) + [%hint *] $(typ ~(repo ut typ)) + [%core *] + %- zing + %+ turn ~(tap by q.r.q.typ) + |= [* b=tome] + %+ turn ~(tap by q.b) + |= [a=term *] + a + == +:: +++ slop :: cons two vases + |= [hed=vase tal=vase] + ^- vase + [[%cell p.hed p.tal] [q.hed q.tal]] +:: +++ slot :: got axis in vase + |= [axe=@ vax=vase] ^- vase + [(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])] +:: +++ slym :: slam w+o sample-type + |= [gat=vase sam=*] ^- vase + (slap gat(+<.q sam) [%limb %$]) +:: +++ sped :: reconstruct type + |= vax=vase + ^- vase + :_ q.vax + ?@ q.vax (~(fuse ut p.vax) [%atom %$ ~]) + ?@ -.q.vax + ^= typ + %- ~(play ut p.vax) + [%wtgr [%wtts [%leaf %tas -.q.vax] [%& 2]~] [%$ 1]] + (~(fuse ut p.vax) [%cell %noun %noun]) +:: +swat: deferred +slap +:: +++ swat + |= [tap=(trap vase) gen=hoon] + ^- (trap vase) + =/ gun (~(mint ut p:$:tap) %noun gen) + |. ~+ + [p.gun .*(q:$:tap q.gun)] +:: +swut: labeled and deferred +slap +++ swut + |= [tap=(trap vase) gen=hoon wut=@tas] + ^- (trap vase) + =/ gun (~(mint ut p:$:tap) %noun gen) + |. ~+ + [p.gun ~|(wut .*(q:$:tap q.gun))] +:: +:: 5d: parser ++| %parser +:: +:: +vang: set +vast params +:: +:: bug: debug mode +:: doc: doccord parsing +:: wer: where we are +:: +++ vang + |= [f=$@(? [bug=? doc=?]) wer=path] + %*(. vast bug ?@(f f bug.f), doc ?@(f & doc.f), wer wer) +:: +++ vast :: main parsing core + =+ [bug=`?`| wer=*path doc=`?`&] + |% + ++ gash %+ cook :: parse path + |= a=(list tyke) ^- tyke + ?~(a ~ (weld i.a $(a t.a))) + (more fas limp) + ++ gasp ;~ pose :: parse =path= etc. + %+ cook + |=([a=tyke b=tyke c=tyke] :(weld a b c)) + ;~ plug + (cook |=(a=(list) (turn a |=(b=* ~))) (star tis)) + (cook |=(a=hoon [[~ a] ~]) hasp) + (cook |=(a=(list) (turn a |=(b=* ~))) (star tis)) + == + (cook |=(a=(list) (turn a |=(b=* ~))) (plus tis)) + == + ++ glam ~+((glue ace)) + ++ hasp ;~ pose :: path element + (ifix [sel ser] wide) + (stag %cncl (ifix [pal par] (most ace wide))) + (stag %sand (stag %tas (cold %$ buc))) + (stag %sand (stag %t qut)) + %+ cook + |=(a=coin [%sand ?:(?=([~ %tas *] a) %tas %ta) ~(rent co a)]) + nuck:so + == + ++ limp %+ cook + |= [a=(list) b=tyke] + ?~ a b + $(a t.a, b [`[%sand %tas %$] b]) + ;~(plug (star fas) gasp) + ++ mota %+ cook + |=([a=tape b=tape] (rap 3 (weld a b))) + ;~(plug (star low) (star hig)) + ++ docs + |% + :: +apex: prefix comment. may contain batch comments. + :: + :: when a prefix doccord is parsed, it is possible that there is no +gap + :: afterward to be consumed, so we add an additional newline and + :: decrement the line number in the `hair` of the parser + :: + :: the reason for this is that the whitespace parsing under +vast seems + :: to factor more cleanly this way, at least compared to the variations + :: tried without the extra newline. this doesn't mean there isn't a + :: better factorization without it, though. + ++ apex + ?. doc (easy *whit) + %+ knee *whit |. ~+ + ;~ plug + |= tub=nail + =/ vex + %. tub + %- star + %+ cook |*([[a=* b=*] c=*] [a b c]) + ;~(pfix (punt leap) into ;~(pose larg smol)) + ?~ q.vex vex + :- p=p.vex + %- some + ?~ p.u.q.vex + [p=~ q=q.u.q.vex] + :- p=(malt p.u.q.vex) + q=`nail`[[(dec p.p.q.u.q.vex) q.p.q.u.q.vex] ['\0a' q.q.u.q.vex]] + == + :: + :: +apse: postfix comment. + :: + :: a one line comment at the end of a line (typically starting at column + :: 57) that attaches to the expression starting at the beginning of the + :: current line. does not use a $link. + ++ apse + ?. doc (easy *whiz) + %+ knee *whiz |. ~+ + ;~ pose + ;~(less ;~(plug into step en-link col ace) ;~(pfix into step line)) + :: + (easy *whiz) + == + :: + ++ leap :: whitespace w/o docs + %+ cold ~ + ;~ plug + ;~ pose + (just '\0a') + ;~(plug gah ;~(pose gah skip)) + skip + == + (star ;~(pose skip gah)) + == + :: + :: +smol: 2 aces then summary, 4 aces then paragraphs. + ++ smol + ;~ pfix + step + ;~ plug + ;~ plug + (plus en-link) + ;~ pose + (ifix [;~(plug col ace) (just '\0a')] (cook crip (plus prn))) + (ifix [(star ace) (just '\0a')] (easy *cord)) + == + == + (rant ;~(pfix step step text)) + == + == + :: + :: +larg: 4 aces then summary, 2 aces then paragraphs. + ++ larg + ;~ pfix + step step + ;~ plug + ;~ sfix + ;~ plug + ;~ pose + ;~(sfix (plus en-link) col ace) + ;~(less ace (easy *cuff)) + == + ;~(less ace (cook crip (plus prn))) + == + (just '\0a') + == + (rant ;~(pfix step teyt)) + == + == + :: + ++ rant + |* sec=rule + %- star + ;~ pfix + (ifix [into (just '\0a')] (star ace)) + (plus (ifix [into (just '\0a')] sec)) + == + :: + ++ skip :: non-doccord comment + ;~ plug + col col + ;~(less ;~(pose larg smol) ;~(plug (star prn) (just '\0a'))) + == + :: + ++ null (cold ~ (star ace)) + ++ text (pick line code) + ++ teyt (pick line ;~(pfix step code)) + ++ line ;~(less ace (cook crip (star prn))) + ++ code ;~(pfix step ;~(less ace (cook crip (star prn)))) + ++ step ;~(plug ace ace) + :: + ++ into + ;~(plug (star ace) col col) + :: + ++ en-link + |= a=nail %. a + %+ knee *link |. ~+ + %- stew + ^. stet ^. limo + :~ :- '|' ;~(pfix bar (stag %chat sym)) + :- '.' ;~(pfix dot (stag %frag sym)) + :- '+' ;~(pfix lus (stag %funk sym)) + :- '$' ;~(pfix buc (stag %plan sym)) + :- '%' ;~(pfix cen (stag %cone bisk:so)) + == + -- + :: + ++ clad :: hoon doccords + |* fel=rule + %+ cook + |= [a=whit b=hoon c=whiz] + =? b !=(c *whiz) + [%note help/`[c]~ b] + =+ docs=~(tap by bat.a) + |- + ?~ docs b + $(docs t.docs, b [%note help/i.docs b]) + (seam fel) + ++ coat :: spec doccords + |* fel=rule + %+ cook + |= [a=whit b=spec c=whiz] + =? b !=(c *whiz) + [%gist help/`[c]~ b] + =+ docs=~(tap by bat.a) + |- + ?~ docs b + $(docs t.docs, b [%gist help/i.docs b]) + (seam fel) + ++ scye :: with prefix doccords + |* fel=rule + ;~(pose ;~(plug apex:docs ;~(pfix gap fel)) ;~(plug (easy *whit) fel)) + ++ seam :: with doccords + |* fel=rule + (scye ;~(plug fel apse:docs)) + :: + ++ plex :: reparse static path + |= gen=hoon ^- (unit path) + ?: ?=([%dbug *] gen) :: unwrap %dbug + $(gen q.gen) + ?. ?=([%clsg *] gen) ~ :: require :~ hoon + %+ reel p.gen :: build using elements + |= [a=hoon b=_`(unit path)`[~ u=/]] :: starting from just / + ?~ b ~ + ?. ?=([%sand ?(%ta %tas) @] a) ~ :: /foo constants + `[q.a u.b] + :: + ++ phax + |= ruw=(list (list woof)) + =+ [yun=*(list hoon) cah=*(list @)] + =+ wod=|=([a=tape b=(list hoon)] ^+(b ?~(a b [[%mcfs %knit (flop a)] b]))) + |- ^+ yun + ?~ ruw + (flop (wod cah yun)) + ?~ i.ruw $(ruw t.ruw) + ?@ i.i.ruw + $(i.ruw t.i.ruw, cah [i.i.ruw cah]) + $(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)]) + :: + ++ posh + |= [pre=(unit tyke) pof=(unit [p=@ud q=tyke])] + ^- (unit (list hoon)) + =- ?^(- - ~&(%posh-fail -)) + =+ wom=(poof wer) + %+ biff + ?~ pre `u=wom + %+ bind (poon wom u.pre) + |= moz=(list hoon) + ?~(pof moz (weld moz (slag (lent u.pre) wom))) + |= yez=(list hoon) + ?~ pof `yez + =+ zey=(flop yez) + =+ [moz=(scag p.u.pof zey) gul=(slag p.u.pof zey)] + =+ zom=(poon (flop moz) q.u.pof) + ?~(zom ~ `(weld (flop gul) u.zom)) + :: + ++ poof :: path -> (list hoon) + |=(pax=path ^-((list hoon) (turn pax |=(a=@ta [%sand %ta a])))) + :: + :: tyke is =foo== as ~[~ `foo ~ ~] + :: interpolate '=' path components + ++ poon :: try to replace '='s + |= [pag=(list hoon) goo=tyke] :: default to pag + ^- (unit (list hoon)) :: for null goo's + ?~ goo `~ :: keep empty goo + %+ both :: otherwise head comes + ?^(i.goo i.goo ?~(pag ~ `u=i.pag)) :: from goo or pag + $(goo t.goo, pag ?~(pag ~ t.pag)) :: recurse on tails + :: + ++ poor + %+ sear posh + ;~ plug + (stag ~ gash) + ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) + == + :: + ++ porc + ;~ plug + (cook |=(a=(list) (lent a)) (star cen)) + ;~(pfix fas gash) + == + :: + ++ rump + %+ sear + |= [a=wing b=(unit hoon)] ^- (unit hoon) + ?~(b [~ %wing a] ?.(?=([@ ~] a) ~ [~ [%rock %tas i.a] u.b])) + ;~(plug rope ;~(pose (stag ~ wede) (easy ~))) + :: + ++ rood + ;~ pfix fas + (stag %clsg poor) + == + :: + ++ reed + ;~ pfix fas + (stag %clsg (more fas stem)) + == + :: + ++ stem + %+ knee *hoon |. ~+ + %+ cook + |= iota=$%([%hoon =hoon] iota) + ?@ iota [%rock %tas iota] + ?: ?=(%hoon -.iota) hoon.iota + [%clhp [%rock %tas -.iota] [%sand iota]] + |^ %- stew + ^. stet ^. limo + :~ :- 'a'^'z' ;~ pose + (spit (stag %cncl (ifix [pal par] (most ace wide)))) + (spit (ifix [sel ser] wide)) + (slot sym) + == + :- '$' (cold %$ buc) + :- '0'^'9' (slot bisk:so) + :- '-' (slot tash:so) + :- '.' ;~(pfix dot zust:so) + :- '~' (slot ;~(pfix sig ;~(pose crub:so (easy [%n ~])))) + :- '\'' (stag %t qut) + :- '[' (slip (ifix [sel ser] wide)) + :- '(' (slip (stag %cncl (ifix [pal par] (most ace wide)))) + == + :: + ++ slip |*(r=rule (stag %hoon r)) + ++ slot |*(r=rule (sear (soft iota) r)) + ++ spit + |* r=rule + %+ stag %hoon + %+ cook + |*([a=term b=*] `hoon`[%clhp [%rock %tas a] b]) + ;~((glue lus) sym r) + -- + :: + ++ rupl + %+ cook + |= [a=? b=(list hoon) c=?] + ?: a + ?: c + [%clsg [%clsg b] ~] + [%clsg b] + ?: c + [%clsg [%cltr b] ~] + [%cltr b] + ;~ plug + ;~ pose + (cold | (just '[')) + (cold & (jest '~[')) + == + :: + ;~ pose + (ifix [ace gap] (most gap tall)) + (most ace wide) + == + :: + ;~ pose + (cold & (jest ']~')) + (cold | (just ']')) + == + == + :: + :: + ++ sail :: xml template + |= in-tall-form=? =| lin=? + |% + :: + ++ apex :: product hoon + %+ cook + |= tum=(each manx:hoot marl:hoot) ^- hoon + ?- -.tum + %& [%xray p.tum] + %| [%mcts p.tum] + == + top-level + :: + ++ top-level :: entry-point + ;~(pfix mic ?:(in-tall-form tall-top wide-top)) + :: + ++ inline-embed :: brace interpolation + %+ cook |=(a=tuna:hoot a) + ;~ pose + ;~(pfix mic bracketed-elem(in-tall-form |)) + ;~(plug tuna-mode sump) + (stag %tape sump) + == + :: + ++ script-or-style :: script or style + %+ cook |=(a=marx:hoot a) + ;~ plug + ;~(pose (jest %script) (jest %style)) + wide-attrs + == + :: + ++ tuna-mode :: xml node(s) kind + ;~ pose + (cold %tape hep) + (cold %manx lus) + (cold %marl tar) + (cold %call cen) + == + :: + ++ wide-top :: wide outer top + %+ knee *(each manx:hoot marl:hoot) |. ~+ + ;~ pose + (stag %| wide-quote) + (stag %| wide-paren-elems) + (stag %& ;~(plug tag-head wide-tail)) + == + :: + ++ wide-inner-top :: wide inner top + %+ knee *(each tuna:hoot marl:hoot) |. ~+ + ;~ pose + wide-top + (stag %& ;~(plug tuna-mode wide)) + == + :: + ++ wide-attrs :: wide attributes + %+ cook |=(a=(unit mart:hoot) (fall a ~)) + %- punt + %+ ifix [pal par] + %+ more (jest ', ') + ;~((glue ace) a-mane hopefully-quote) + :: + ++ wide-tail :: wide elements + %+ cook |=(a=marl:hoot a) + ;~(pose ;~(pfix col wrapped-elems) (cold ~ mic) (easy ~)) + :: + ++ wide-elems :: wide elements + %+ cook |=(a=marl:hoot a) + %+ cook join-tops + (star ;~(pfix ace wide-inner-top)) + :: + ++ wide-paren-elems :: wide flow + %+ cook |=(a=marl:hoot a) + %+ cook join-tops + (ifix [pal par] (more ace wide-inner-top)) + :: + ::+| + :: + ++ drop-top + |= a=(each tuna:hoot marl:hoot) ^- marl:hoot + ?- -.a + %& [p.a]~ + %| p.a + == + :: + ++ join-tops + |= a=(list (each tuna:hoot marl:hoot)) ^- marl:hoot + (zing (turn a drop-top)) + :: + ::+| + :: + ++ wide-quote :: wide quote + %+ cook |=(a=marl:hoot a) + ;~ pose + ;~ less (jest '"""') + (ifix [doq doq] (cook collapse-chars quote-innards)) + == + :: + %- inde + %+ ifix [(jest '"""\0a') (jest '\0a"""')] + (cook collapse-chars quote-innards(lin |)) + == + :: + ++ quote-innards :: wide+tall flow + %+ cook |=(a=(list $@(@ tuna:hoot)) a) + %- star + ;~ pose + ;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab)) + inline-embed + ;~(less bas kel ?:(in-tall-form fail doq) prn) + ?:(lin fail ;~(less (jest '\0a"""') (just '\0a'))) + == + :: + ++ bracketed-elem :: bracketed element + %+ ifix [kel ker] + ;~(plug tag-head wide-elems) + :: + ++ wrapped-elems :: wrapped tuna + %+ cook |=(a=marl:hoot a) + ;~ pose + wide-paren-elems + (cook |=(@t `marl`[;/((trip +<))]~) qut) + (cook drop-top wide-top) + == + :: + ++ a-mane :: mane as hoon + %+ cook + |= [a=@tas b=(unit @tas)] + ?~(b a [a u.b]) + ;~ plug + mixed-case-symbol + ;~ pose + %+ stag ~ + ;~(pfix cab mixed-case-symbol) + (easy ~) + == + == + :: + ++ en-class + |= a=(list [%class p=term]) + ^- (unit [%class tape]) + ?~ a ~ + %- some + :- %class + |- + %+ welp (trip p.i.a) + ?~ t.a ~ + [' ' $(a t.a)] + :: + ++ tag-head :: tag head + %+ cook + |= [a=mane:hoot b=mart:hoot c=mart:hoot] + ^- marx:hoot + [a (weld b c)] + ;~ plug + a-mane + :: + %+ cook + |= a=(list (unit [term (list beer:hoot)])) + ^- (list [term (list beer:hoot)]) + :: discard nulls + (murn a same) + ;~ plug + (punt ;~(plug (cold %id hax) (cook trip sym))) + (cook en-class (star ;~(plug (cold %class dot) sym))) + (punt ;~(plug ;~(pose (cold %href fas) (cold %src pat)) soil)) + (easy ~) + == + :: + wide-attrs + == + :: + ++ tall-top :: tall top + %+ knee *(each manx:hoot marl:hoot) |. ~+ + ;~ pose + (stag %| ;~(pfix (plus ace) (cook collapse-chars quote-innards))) + (stag %& ;~(plug script-or-style script-style-tail)) + (stag %& tall-elem) + (stag %| wide-quote) + (stag %| ;~(pfix tis tall-tail)) + (stag %& ;~(pfix gar gap (stag [%div ~] cram))) + (stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~))) + (easy %| [;/("\0a")]~) + == + :: + ++ tall-attrs :: tall attributes + %- star + ;~ pfix ;~(plug gap tis) + ;~((glue gap) a-mane hopefully-quote) + == + :: + ++ tall-elem :: tall preface + %+ cook + |= [a=[p=mane:hoot q=mart:hoot] b=mart:hoot c=marl:hoot] + ^- manx:hoot + [[p.a (weld q.a b)] c] + ;~(plug tag-head tall-attrs tall-tail) + :: + ::REVIEW is there a better way to do this? + ++ hopefully-quote :: prefer "quote" form + %+ cook |=(a=(list beer:hoot) a) + %+ cook |=(a=hoon ?:(?=(%knit -.a) p.a [~ a]~)) + wide + :: + ++ script-style-tail :: unescaped tall tail + %+ cook |=(a=marl:hoot a) + %+ ifix [gap ;~(plug gap duz)] + %+ most gap + ;~ pfix mic + %+ cook |=(a=tape ;/(a)) + ;~ pose + ;~(pfix ace (star prn)) + (easy "\0a") + == + == + :: + ++ tall-tail :: tall tail + ?> in-tall-form + %+ cook |=(a=marl:hoot a) + ;~ pose + (cold ~ mic) + ;~(pfix col wrapped-elems(in-tall-form |)) + ;~(pfix col ace (cook collapse-chars(in-tall-form |) quote-innards)) + (ifix [gap ;~(plug gap duz)] tall-kids) + == + :: + ++ tall-kids :: child elements + %+ cook join-tops + :: look for sail first, or markdown if not + (most gap ;~(pose top-level (stag %| cram))) + :: + ++ collapse-chars :: group consec chars + |= reb=(list $@(@ tuna:hoot)) + ^- marl:hoot + =| [sim=(list @) tuz=marl:hoot] + |- ^- marl:hoot + ?~ reb + =. sim + ?. in-tall-form sim + [10 |-(?~(sim sim ?:(=(32 i.sim) $(sim t.sim) sim)))] + ?~(sim tuz [;/((flop sim)) tuz]) + ?@ i.reb + $(reb t.reb, sim [i.reb sim]) + ?~ sim [i.reb $(reb t.reb, sim ~)] + [;/((flop sim)) i.reb $(reb t.reb, sim ~)] + -- + ++ cram :: parse unmark + => |% + ++ item (pair mite marl:hoot) :: xml node generator + ++ colm @ud :: column + ++ tarp marl:hoot :: node or generator + ++ mite :: context + $? %down :: outer embed + %lunt :: unordered list + %lime :: list item + %lord :: ordered list + %poem :: verse + %bloc :: blockquote + %head :: heading + == :: + ++ trig :: line style + $: col=@ud :: start column + sty=trig-style :: style + == :: + ++ trig-style :: type of parsed line + $% $: %end :: terminator + $? %done :: end of input + %stet :: == end of markdown + %dent :: outdent + == == :: + $: %one :: leaf node + $? %rule :: --- horz rule + %fens :: ``` code fence + %expr :: ;sail expression + == == :: + [%new p=trig-new] :: open container + [%old %text] :: anything else + == :: + ++ trig-new :: start a + $? %lite :: + line item + %lint :: - line item + %head :: # heading + %bloc :: > block-quote + %poem :: [ ]{8} poem + == :: + ++ graf :: paragraph element + $% [%bold p=(list graf)] :: *bold* + [%talc p=(list graf)] :: _italics_ + [%quod p=(list graf)] :: "double quote" + [%code p=tape] :: code literal + [%text p=tape] :: text symbol + [%link p=(list graf) q=tape] :: URL + [%mage p=tape q=tape] :: image + [%expr p=tuna:hoot] :: interpolated hoon + == + -- + =< (non-empty:parse |=(nail `(like tarp)`~($ main +<))) + |% + ++ main + :: + :: state of the parsing loop. + :: + :: we maintain a construction stack for elements and a line + :: stack for lines in the current block. a blank line + :: causes the current block to be parsed and thrown in the + :: current element. when the indent column retreats, the + :: element stack rolls up. + :: + :: .verbose: debug printing enabled + :: .err: error position + :: .ind: outer and inner indent level + :: .hac: stack of items under construction + :: .cur: current item under construction + :: .par: current "paragraph" being read in + :: .[loc txt]: parsing state + :: + =/ verbose & + =| err=(unit hair) + =| ind=[out=@ud inr=@ud] + =| hac=(list item) + =/ cur=item [%down ~] + =| par=(unit (pair hair wall)) + |_ [loc=hair txt=tape] + :: + ++ $ :: resolve + ^- (like tarp) + => line + :: + :: if error position is set, produce error + ?. =(~ err) + ~& err+err + [+.err ~] + :: + :: all data was consumed + =- [loc `[- [loc txt]]] + => close-par + |- ^- tarp + :: + :: fold all the way to top + ?~ hac cur-to-tarp + $(..^$ close-item) + :: + ::+| + :: + ++ cur-indent + ?- p.cur + %down 2 + %head 0 + %lunt 0 + %lime 2 + %lord 0 + %poem 8 + %bloc 2 + == + :: + ++ back :: column retreat + |= luc=@ud + ^+ +> + ?: (gte luc inr.ind) +> + :: + :: nex: next backward step that terminates this context + =/ nex=@ud cur-indent :: REVIEW code and poem blocks are + :: handled elsewhere + ?: (gth nex (sub inr.ind luc)) + :: + :: indenting pattern violation + ~? verbose indent-pattern-violation+[p.cur nex inr.ind luc] + ..^$(inr.ind luc, err `[p.loc luc]) + =. ..^$ close-item + $(inr.ind (sub inr.ind nex)) + :: + ++ cur-to-tarp :: item to tarp + ^- tarp + ?: ?=(?(%down %head %expr) p.cur) + (flop q.cur) + =- [[- ~] (flop q.cur)]~ + ?- p.cur + %lunt %ul + %lord %ol + %lime %li + %poem %div ::REVIEW actual container element? + %bloc %blockquote + == + :: + ++ close-item ^+ . :: complete and pop + ?~ hac . + %= . + hac t.hac + cur [p.i.hac (weld cur-to-tarp q.i.hac)] + == + :: + ++ read-line :: capture raw line + =| lin=tape + |- ^+ [[lin *(unit _err)] +<.^$] :: parsed tape and halt/error + :: + :: no unterminated lines + ?~ txt + ~? verbose %unterminated-line + [[~ ``loc] +<.^$] + ?. =(`@`10 i.txt) + ?: (gth inr.ind q.loc) + ?. =(' ' i.txt) + ~? verbose expected-indent+[inr.ind loc txt] + [[~ ``loc] +<.^$] + $(txt t.txt, q.loc +(q.loc)) + :: + :: save byte and repeat + $(txt t.txt, q.loc +(q.loc), lin [i.txt lin]) + =. lin + :: + :: trim trailing spaces + |- ^- tape + ?: ?=([%' ' *] lin) + $(lin t.lin) + (flop lin) + :: + =/ eat-newline=nail [[+(p.loc) 1] t.txt] + =/ saw look(+<.$ eat-newline) + :: + ?: ?=([~ @ %end ?(%stet %dent)] saw) :: stop on == or dedent + [[lin `~] +<.^$] + [[lin ~] eat-newline] + :: + ++ look :: inspect line + ^- (unit trig) + %+ bind (wonk (look:parse loc txt)) + |= a=trig ^+ a + :: + :: treat a non-terminator as a terminator + :: if it's outdented + ?: =(%end -.sty.a) a + ?: (lth col.a out.ind) + a(sty [%end %dent]) + a + :: + ++ close-par :: make block + ^+ . + :: + :: empty block, no action + ?~ par . + :: + :: if block is verse + ?: ?=(%poem p.cur) + :: + :: add break between stanzas + =. q.cur ?~(q.cur q.cur [[[%br ~] ~] q.cur]) + =- close-item(par ~, q.cur (weld - q.cur), inr.ind (sub inr.ind 8)) + %+ turn q.u.par + |= tape ^- manx + :: + :: each line is a paragraph + :- [%p ~] + :_ ~ + ;/("{+<}\0a") + :: + :: yex: block recomposed, with newlines + =/ yex=tape + %- zing + %+ turn (flop q.u.par) + |= a=tape + (runt [(dec inr.ind) ' '] "{a}\0a") + :: + :: vex: parse of paragraph + =/ vex=(like tarp) + :: + :: either a one-line header or a paragraph + %. [p.u.par yex] + ?: ?=(%head p.cur) + (full head:parse) + (full para:parse) + :: + :: if error, propagate correctly + ?~ q.vex + ~? verbose [%close-par p.cur yex] + ..$(err `p.vex) + :: + :: finish tag if it's a header + =< ?:(?=(%head p.cur) close-item ..$) + :: + :: save good result, clear buffer + ..$(par ~, q.cur (weld p.u.q.vex q.cur)) + :: + ++ line ^+ . :: body line loop + :: + :: abort after first error + ?: !=(~ err) . + :: + :: saw: profile of this line + =/ saw look + ~? [debug=|] [%look ind=ind saw=saw txt=txt] + :: + :: if line is blank + ?~ saw + :: + :: break section + =^ a=[tape fin=(unit _err)] +<.$ read-line + ?^ fin.a + ..$(err u.fin.a) + =>(close-par line) + :: + :: line is not blank + => .(saw u.saw) + :: + :: if end of input, complete + ?: ?=(%end -.sty.saw) + ..$(q.loc col.saw) + :: + =. ind ?~(out.ind [col.saw col.saw] ind) :: init indents + :: + ?: ?| ?=(~ par) :: if after a paragraph or + ?& ?=(?(%down %lime %bloc) p.cur) :: unspaced new container + |(!=(%old -.sty.saw) (gth col.saw inr.ind)) + == == + => .(..$ close-par) + :: + :: if column has retreated, adjust stack + =. ..$ (back col.saw) + :: + =^ col-ok sty.saw + ?+ (sub col.saw inr.ind) [| sty.saw] :: columns advanced + %0 [& sty.saw] + %8 [& %new %poem] + == + ?. col-ok + ~? verbose [%columns-advanced col.saw inr.ind] + ..$(err `[p.loc col.saw]) + :: + =. inr.ind col.saw + :: + :: unless adding a matching item, close lists + =. ..$ + ?: ?| &(?=(%lunt p.cur) !?=(%lint +.sty.saw)) + &(?=(%lord p.cur) !?=(%lite +.sty.saw)) + == + close-item + ..$ + :: + =< line(par `[loc ~]) ^+ ..$ :: continue with para + ?- -.sty.saw + %one (read-one +.sty.saw) :: parse leaves + %new (open-item p.sty.saw) :: open containers + %old ..$ :: just text + == + :: + :: + ::- - - foo + :: detect bad block structure + ?. :: first line of container is legal + ?~ q.u.par & + ?- p.cur + :: + :: can't(/directly) contain text + ?(%lord %lunt) ~|(bad-leaf-container+p.cur !!) + :: + :: only one line in a header + %head | + :: + :: indented literals need to end with a blank line + %poem (gte col.saw inr.ind) + :: + :: text tarps must continue aligned + ?(%down %lunt %lime %lord %bloc) =(col.saw inr.ind) + == + ~? verbose bad-block-structure+[p.cur inr.ind col.saw] + ..$(err `[p.loc col.saw]) + :: + :: accept line and maybe continue + =^ a=[lin=tape fin=(unit _err)] +<.$ read-line + =. par par(q.u [lin.a q.u.par]) + ?^ fin.a ..$(err u.fin.a) + line + ++ parse-block :: execute parser + |= fel=$-(nail (like tarp)) ^+ +> + =/ vex=(like tarp) (fel loc txt) + ?~ q.vex + ~? verbose [%parse-block txt] + +>.$(err `p.vex) + =+ [res loc txt]=u.q.vex + %_ +>.$ + loc loc + txt txt + q.cur (weld (flop `tarp`res) q.cur) :: prepend to the stack + == + :: + ++ read-one :: read %one item + |= sty=?(%expr %rule %fens) ^+ +> + ?- sty + %expr (parse-block expr:parse) + %rule (parse-block hrul:parse) + %fens (parse-block (fens:parse inr.ind)) + == + :: + ++ open-item :: enter list/quote + |= saw=trig-new + =< +>.$:apex + |% + ++ apex ^+ . :: open container + ?- saw + %poem (push %poem) :: verse literal + %head (push %head) :: heading + %bloc (entr %bloc) :: blockquote line + %lint (lent %lunt) :: unordered list + %lite (lent %lord) :: ordered list + == + :: + ++ push :: push context + |=(mite +>(hac [cur hac], cur [+< ~])) + :: + ++ entr :: enter container + |= typ=mite + ^+ +> + :: + :: indent by 2 + =. inr.ind (add 2 inr.ind) + :: + :: "parse" marker + =. txt (slag (sub inr.ind q.loc) txt) + =. q.loc inr.ind + :: + (push typ) + :: + ++ lent :: list entry + |= ord=?(%lord %lunt) + ^+ +> + => ?:(=(ord p.cur) +>.$ (push ord)) :: push list if new + (entr %lime) + -- + -- + :: + ++ parse :: individual parsers + |% + ++ look :: classify line + %+ cook |=(a=(unit trig) a) + ;~ pfix (star ace) + %+ here :: report indent + |=([a=pint b=?(~ trig-style)] ?~(b ~ `[q.p.a b])) + ;~ pose + (cold ~ (just `@`10)) :: blank line + :: + (full (easy [%end %done])) :: end of input + (cold [%end %stet] duz) :: == end of markdown + :: + (cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler + (cold [%one %fens] ;~(plug tic tic tic)) :: ``` code fence + (cold [%one %expr] mic) :: ;sail expression + :: + (cold [%new %head] ;~(plug (star hax) ace)) :: # heading + (cold [%new %lint] ;~(plug hep ace)) :: - line item + (cold [%new %lite] ;~(plug lus ace)) :: + line item + (cold [%new %bloc] ;~(plug gar ace)) :: > block-quote + :: + (easy [%old %text]) :: anything else + == + == + :: + :: + ++ calf :: cash but for tic tic + |* tem=rule + %- star + ;~ pose + ;~(pfix bas tem) + ;~(less tem prn) + == + ++ cash :: escaped fence + |* tem=rule + %- echo + %- star + ;~ pose + whit + ;~(plug bas tem) + ;~(less tem prn) + == + :: + ++ cool :: reparse + |* $: :: fex: primary parser + :: sab: secondary parser + :: + fex=rule + sab=rule + == + |= [loc=hair txt=tape] + ^+ *sab + :: + :: vex: fenced span + =/ vex=(like tape) (fex loc txt) + ?~ q.vex vex + :: + :: hav: reparse full fenced text + =/ hav ((full sab) [loc p.u.q.vex]) + :: + :: reparsed error position is always at start + ?~ q.hav [loc ~] + :: + :: the complete type with the main product + :- p.vex + `[p.u.q.hav q.u.q.vex] + :: + ::REVIEW surely there is a less hacky "first or after space" solution + ++ easy-sol :: parse start of line + |* a=* + |= b=nail + ?: =(1 q.p.b) ((easy a) b) + (fail b) + :: + ++ echo :: hoon literal + |* sab=rule + |= [loc=hair txt=tape] + ^- (like tape) + :: + :: vex: result of parsing wide hoon + =/ vex (sab loc txt) + :: + :: use result of expression parser + ?~ q.vex vex + =- [p.vex `[- q.u.q.vex]] + :: + :: but replace payload with bytes consumed + |- ^- tape + ?: =(q.q.u.q.vex txt) ~ + ?~ txt ~ + [i.txt $(txt +.txt)] + :: + ++ non-empty + |* a=rule + |= tub=nail ^+ (a) + =/ vex (a tub) + ~! vex + ?~ q.vex vex + ?. =(tub q.u.q.vex) vex + (fail tub) + :: + :: + ++ word :: tarp parser + %+ knee *(list graf) |. ~+ + %+ cook + |= a=$%(graf [%list (list graf)]) + ^- (list graf) + ?:(?=(%list -.a) +.a [a ~]) + ;~ pose + :: + :: ordinary word + :: + %+ stag %text + ;~(plug ;~(pose low hig) (star ;~(pose nud low hig hep))) + :: + :: naked \escape + :: + (stag %text ;~(pfix bas (cook trip ;~(less ace prn)))) + :: + :: trailing \ to add
+ :: + (stag %expr (cold [[%br ~] ~] ;~(plug bas (just '\0a')))) + :: + :: *bold literal* + :: + (stag %bold (ifix [tar tar] (cool (cash tar) werk))) + :: + :: _italic literal_ + :: + (stag %talc (ifix [cab cab] (cool (cash cab) werk))) + :: + :: "quoted text" + :: + (stag %quod (ifix [doq doq] (cool (cash doq) werk))) + :: + :: `classic markdown quote` + :: + (stag %code (ifix [tic tic] (calf tic))) + :: + :: ++arm, +$arm, +*arm, ++arm:core, ... + :: + %+ stag %code + ;~ plug + lus ;~(pose lus buc tar) + low (star ;~(pose nud low hep col)) + == + :: + :: [arbitrary *content*](url) + :: + %+ stag %link + ;~ (glue (punt whit)) + (ifix [sel ser] (cool (cash ser) werk)) + (ifix [pal par] (cash par)) + == + :: + :: ![alt text](url) + :: + %+ stag %mage + ;~ pfix zap + ;~ (glue (punt whit)) + (ifix [sel ser] (cash ser)) + (ifix [pal par] (cash par)) + == + == + :: + :: #hoon + :: + %+ stag %list + ;~ plug + (stag %text ;~(pose (cold " " whit) (easy-sol ~))) + (stag %code ;~(pfix hax (echo wide))) + ;~(simu whit (easy ~)) + == + :: + :: direct hoon constant + :: + %+ stag %list + ;~ plug + (stag %text ;~(pose (cold " " whit) (easy-sol ~))) + :: + %+ stag %code + %- echo + ;~ pose + ::REVIEW just copy in 0x... parsers directly? + ;~(simu ;~(plug (just '0') alp) bisk:so) + :: + tash:so + ;~(pfix dot perd:so) + ;~(pfix sig ;~(pose twid:so (easy [%$ %n 0]))) + ;~(pfix cen ;~(pose sym buc pam bar qut nuck:so)) + == + :: + ;~(simu whit (easy ~)) + == + :: + :: whitespace + :: + (stag %text (cold " " whit)) + :: + :: {interpolated} sail + :: + (stag %expr inline-embed:(sail |)) + :: + :: just a byte + :: + (stag %text (cook trip ;~(less ace prn))) + == + :: + ++ werk (cook zing (star word)) :: indefinite tarp + :: + ++ down :: parse inline tarp + %+ knee *tarp |. ~+ + =- (cook - werk) + :: + :: collect raw tarp into xml tags + |= gaf=(list graf) + ^- tarp + =< main + |% + ++ main + ^- tarp + ?~ gaf ~ + ?. ?=(%text -.i.gaf) + (weld (item i.gaf) $(gaf t.gaf)) + :: + :: fip: accumulate text blocks + =/ fip=(list tape) [p.i.gaf]~ + |- ^- tarp + ?~ t.gaf [;/((zing (flop fip))) ~] + ?. ?=(%text -.i.t.gaf) + [;/((zing (flop fip))) ^$(gaf t.gaf)] + $(gaf t.gaf, fip :_(fip p.i.t.gaf)) + :: + ++ item + |= nex=graf + ^- tarp ::CHECK can be tuna:hoot? + ?- -.nex + %text !! :: handled separately + %expr [p.nex]~ + %bold [[%b ~] ^$(gaf p.nex)]~ + %talc [[%i ~] ^$(gaf p.nex)]~ + %code [[%code ~] ;/(p.nex) ~]~ + %quod :: + :: smart quotes + %= ^$ + gaf + :- [%text (tufa ~-~201c. ~)] + %+ weld p.nex + `(list graf)`[%text (tufa ~-~201d. ~)]~ + == + %link [[%a [%href q.nex] ~] ^$(gaf p.nex)]~ + %mage [[%img [%src q.nex] ?~(p.nex ~ [%alt p.nex]~)] ~]~ + == + -- + :: + ++ hrul :: empty besides fence + %+ cold [[%hr ~] ~]~ + ;~(plug (star ace) hep hep hep (star hep) (just '\0a')) + :: + ++ tics + ;~(plug tic tic tic (just '\0a')) + :: + ++ fens + |= col=@u ~+ + =/ ind (stun [(dec col) (dec col)] ace) + =/ ind-tics ;~(plug ind tics) + %+ cook |=(txt=tape `tarp`[[%pre ~] ;/(txt) ~]~) + :: + :: leading outdent is ok since container may + :: have already been parsed and consumed + %+ ifix [;~(plug (star ace) tics) ind-tics] + %^ stir "" |=([a=tape b=tape] "{a}\0a{b}") + ;~ pose + %+ ifix [ind (just '\0a')] + ;~(less tics (star prn)) + :: + (cold "" ;~(plug (star ace) (just '\0a'))) + == + :: + ++ para :: paragraph + %+ cook + |=(a=tarp ?~(a ~ [[%p ~] a]~)) + ;~(pfix (punt whit) down) + :: + ++ expr :: expression + => (sail &) :: tall-form + %+ ifix [(star ace) ;~(simu gap (easy))] :: look-ahead for gap + (cook drop-top top-level) :: list of tags + :: + :: + ++ whit :: whitespace + (cold ' ' (plus ;~(pose (just ' ') (just '\0a')))) + :: + ++ head :: parse heading + %+ cook + |= [haxes=tape kids=tarp] ^- tarp + =/ tag (crip 'h' <(lent haxes)>) :: e.g. ### -> %h3 + =/ id (contents-to-id kids) + [[tag [%id id]~] kids]~ + :: + ;~(pfix (star ace) ;~((glue whit) (stun [1 6] hax) down)) + :: + ++ contents-to-id :: # text into elem id + |= a=(list tuna:hoot) ^- tape + =; raw=tape + %+ turn raw + |= @tD + ^- @tD + ?: ?| &((gte +< 'a') (lte +< 'z')) + &((gte +< '0') (lte +< '9')) + == + +< + ?: &((gte +< 'A') (lte +< 'Z')) + (add 32 +<) + '-' + :: + :: collect all text in header tarp + |- ^- tape + ?~ a ~ + %+ weld + ^- tape + ?- i.a + [[%$ [%$ *] ~] ~] :: text node contents + (murn v.i.a.g.i.a |=(a=beer:hoot ?^(a ~ (some a)))) + [^ *] $(a c.i.a) :: concatenate children + [@ *] ~ :: ignore interpolation + == + $(a t.a) + -- + -- + :: + ++ scad + %+ knee *spec |. ~+ + %- stew + ^. stet ^. limo + :~ + :- '_' + ;~(pfix cab (stag %bccb wide)) + :- ',' + ;~(pfix com (stag %bcmc wide)) + :- '$' + (stag %like (most col rope)) + :- '%' + ;~ pose + ;~ pfix cen + ;~ pose + (stag %leaf (stag %tas (cold %$ buc))) + (stag %leaf (stag %f (cold & pam))) + (stag %leaf (stag %f (cold | bar))) + (stag %leaf (stag %t qut)) + (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so)) + == + == + == + :- '(' + %+ cook |=(spec +<) + %+ stag %make + %+ ifix [pal par] + ;~ plug + wide + ;~(pose ;~(pfix ace (most ace wyde)) (easy ~)) + == + :- '[' + (stag %bccl (ifix [sel ser] (most ace wyde))) + :- '*' + (cold [%base %noun] tar) + :- '/' + ;~(pfix fas (stag %loop ;~(pose (cold %$ buc) sym))) + :- '@' + ;~(pfix pat (stag %base (stag %atom mota))) + :- '?' + ;~ pose + %+ stag %bcwt + ;~(pfix wut (ifix [pal par] (most ace wyde))) + :: + (cold [%base %flag] wut) + == + :- '~' + (cold [%base %null] sig) + :- '!' + (cold [%base %void] ;~(plug zap zap)) + :- '^' + ;~ pose + (stag %like (most col rope)) + (cold [%base %cell] ket) + == + :- '=' + ;~ pfix tis + %+ sear + |= [=(unit term) =spec] + %+ bind + ~(autoname ax spec) + |= =term + =* name ?~(unit term (cat 3 u.unit (cat 3 '-' term))) + [%bcts name spec] + ;~ pose + ;~(plug (stag ~ ;~(sfix sym tis)) wyde) + (stag ~ wyde) + == + == + :- ['a' 'z'] + ;~ pose + (stag %bcts ;~(plug sym ;~(pfix tis wyde))) + (stag %like (most col rope)) + == + == + :: + ++ scat + %+ knee *hoon |. ~+ + %- stew + ^. stet ^. limo + :~ + :- ',' + ;~ pose + (stag %ktcl ;~(pfix com wyde)) + (stag %wing rope) + == + :- '!' + ;~ pose + (stag %wtzp ;~(pfix zap wide)) + (stag %zpzp (cold ~ ;~(plug zap zap))) + == + :- '_' + ;~(pfix cab (stag %ktcl (stag %bccb wide))) + :- '$' + ;~ pose + ;~ pfix buc + ;~ pose + :: XX: these are all obsolete in hoon 142 + :: + (stag %leaf (stag %tas (cold %$ buc))) + (stag %leaf (stag %t qut)) + (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so)) + == + == + rump + == + :- '%' + ;~ pfix cen + ;~ pose + (stag %clsg (sear |~([a=@ud b=tyke] (posh ~ ~ a b)) porc)) + (stag %rock (stag %tas (cold %$ buc))) + (stag %rock (stag %f (cold & pam))) + (stag %rock (stag %f (cold | bar))) + (stag %rock (stag %t qut)) + (cook (jock &) nuck:so) + (stag %clsg (sear |=(a=(list) (posh ~ ~ (lent a) ~)) (star cen))) + == + == + :- '&' + ;~ pose + (cook |=(a=wing [%cnts a ~]) rope) + (stag %wtpm ;~(pfix pam (ifix [pal par] (most ace wide)))) + ;~(plug (stag %rock (stag %f (cold & pam))) wede) + (stag %sand (stag %f (cold & pam))) + == + :- '\'' + (stag %sand (stag %t qut)) + :- '(' + (stag %cncl (ifix [pal par] (most ace wide))) + :- '*' + ;~ pose + (stag %kttr ;~(pfix tar wyde)) + (cold [%base %noun] tar) + == + :- '@' + ;~(pfix pat (stag %base (stag %atom mota))) + :- '+' + ;~ pose + (stag %dtls ;~(pfix lus (ifix [pal par] wide))) + :: + %+ cook + |= a=(list (list woof)) + :- %mcfs + [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))] + (most dog ;~(pfix lus soil)) + :: + (cook |=(a=wing [%cnts a ~]) rope) + == + :- '-' + ;~ pose + (stag %sand tash:so) + :: + %+ cook + |= a=(list (list woof)) + [%clsg (phax a)] + (most dog ;~(pfix hep soil)) + :: + (cook |=(a=wing [%cnts a ~]) rope) + == + :- '.' + ;~ pose + (cook (jock |) ;~(pfix dot perd:so)) + (cook |=(a=wing [%cnts a ~]) rope) + == + :- ['0' '9'] + %+ cook + |= [a=dime b=(unit hoon)] + ?~(b [%sand a] [[%rock a] u.b]) + ;~(plug bisk:so (punt wede)) + :- ':' + ;~ pfix col + ;~ pose + (stag %mccl (ifix [pal par] (most ace wide))) + ;~(pfix fas (stag %mcfs wide)) + == + == + :- '=' + ;~ pfix tis + ;~ pose + (stag %dtts (ifix [pal par] ;~(glam wide wide))) + :: + %+ sear + :: mainly used for +skin formation + :: + |= =spec + ^- (unit hoon) + %+ bind ~(autoname ax spec) + |=(=term `hoon`[%ktts term %kttr spec]) + wyde + == + == + :- '?' + ;~ pose + %+ stag %ktcl + (stag %bcwt ;~(pfix wut (ifix [pal par] (most ace wyde)))) + :: + (cold [%base %flag] wut) + == + :- '[' + rupl + :- '^' + ;~ pose + (stag %wing rope) + (cold [%base %cell] ket) + == + :- '`' + ;~ pfix tic + ;~ pose + %+ cook + |=([a=@ta b=hoon] [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]]) + ;~(pfix pat ;~(plug mota ;~(pfix tic wide))) + ;~ pfix tar + (stag %kthp (stag [%base %noun] ;~(pfix tic wide))) + == + (stag %kthp ;~(plug wyde ;~(pfix tic wide))) + (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tic wide)))) + (cook |=(a=hoon [[%rock %n ~] a]) wide) + == + == + :- '"' + %+ cook + |= a=(list (list woof)) + [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))] + (most dog soil) + :- ['a' 'z'] + rump + :- '|' + ;~ pose + (cook |=(a=wing [%cnts a ~]) rope) + (stag %wtbr ;~(pfix bar (ifix [pal par] (most ace wide)))) + ;~(plug (stag %rock (stag %f (cold | bar))) wede) + (stag %sand (stag %f (cold | bar))) + == + :- '~' + ;~ pose + rupl + :: + ;~ pfix sig + ;~ pose + (stag %clsg (ifix [sel ser] (most ace wide))) + :: + %+ stag %cnsg + %+ ifix + [pal par] + ;~(glam rope wide (most ace wide)) + :: + (cook (jock |) twid:so) + (stag [%bust %null] wede) + (easy [%bust %null]) + == + == + == + :- '/' + rood + :- '<' + (ifix [gal gar] (stag %tell (most ace wide))) + :- '>' + (ifix [gar gal] (stag %yell (most ace wide))) + :- '#' + ;~(pfix hax reed) + == + ++ soil + ;~ pose + ;~ less (jest '"""') + %+ ifix [doq doq] + %- star + ;~ pose + ;~(pfix bas ;~(pose bas doq kel bix:ab)) + ;~(less doq bas kel prn) + (stag ~ sump) + == + == + :: + %- iny %+ ifix + [(jest '"""\0a') (jest '\0a"""')] + %- star + ;~ pose + ;~(pfix bas ;~(pose bas kel bix:ab)) + ;~(less bas kel prn) + ;~(less (jest '\0a"""') (just `@`10)) + (stag ~ sump) + == + == + ++ sump (ifix [kel ker] (stag %cltr (most ace wide))) + ++ norm :: rune regular form + |= tol=? + |% + ++ structure + %- stew + ^. stet ^. limo + :~ :- '$' + ;~ pfix buc + %- stew + ^. stet ^. limo + :~ [':' (rune col %bccl exqs)] + ['%' (rune cen %bccn exqs)] + ['<' (rune gal %bcgl exqb)] + ['>' (rune gar %bcgr exqb)] + ['^' (rune ket %bckt exqb)] + ['~' (rune sig %bcsg exqd)] + ['|' (rune bar %bcbr exqc)] + ['&' (rune pam %bcpm exqc)] + ['@' (rune pat %bcpt exqb)] + ['_' (rune cab %bccb expa)] + ['-' (rune hep %bchp exqb)] + ['=' (rune tis %bcts exqg)] + ['?' (rune wut %bcwt exqs)] + [';' (rune mic %bcmc expa)] + ['+' (rune lus %bcls exqg)] + == + == + :- '%' + ;~ pfix cen + %- stew + ^. stet ^. limo + :~ :- '^' + %+ cook + |= [%cnkt a=hoon b=spec c=spec d=spec] + [%make a b c d ~] + (rune ket %cnkt exqy) + :: + :- '+' + %+ cook + |= [%cnls a=hoon b=spec c=spec] + [%make a b c ~] + (rune lus %cnls exqx) + :: + :- '-' + %+ cook + |= [%cnhp a=hoon b=spec] + [%make a b ~] + (rune hep %cnhp exqd) + :: + :- ':' + %+ cook + |= [%cncl a=hoon b=(list spec)] + [%make a b] + (rune col %cncl exqz) + == + == + :- '#' + ;~ pfix hax fas + %+ stag %bccl + %+ cook + |= [[i=spec t=(list spec)] e=spec] + [i (snoc t e)] + ;~ plug + %+ most ;~(less ;~(plug fas tar) fas) + %- stew + ^. stet ^. limo + :~ :- ['a' 'z'] + ;~ pose + :: /name=@aura + :: + %+ cook + |= [=term =aura] + ^- spec + :+ %bccl + [%leaf %tas aura] + :_ ~ + :+ %bcts term + ?+ aura [%base %atom aura] + %f [%base %flag] + %n [%base %null] + == + ;~(plug sym ;~(pfix tis pat mota)) + :: + :: /constant + :: + (stag %leaf (stag %tas ;~(pose sym (cold %$ buc)))) + == + :: + :: /@aura + :: + :- '@' + %+ cook + |= =aura + ^- spec + :+ %bccl + [%leaf %tas aura] + [%base %atom aura]~ + ;~(pfix pat mota) + :: + :: /? + :: + :- '?' + (cold [%bccl [%leaf %tas %f] [%base %flag] ~] wut) + :: + :: /~ + :: + :- '~' + (cold [%bccl [%leaf %tas %n] [%base %null] ~] sig) + == + :: + :: open-ended or fixed-length + :: + ;~ pose + (cold [%base %noun] ;~(plug fas tar)) + (easy %base %null) + == + == + == + == + ++ expression + %- stew + ^. stet ^. limo + :~ :- '|' + ;~ pfix bar + %- stew + ^. stet ^. limo + :~ ['_' (rune cab %brcb exqr)] + ['%' (runo cen %brcn ~ expe)] + ['@' (runo pat %brpt ~ expe)] + [':' (rune col %brcl expb)] + ['.' (rune dot %brdt expa)] + ['-' (rune hep %brhp expa)] + ['^' (rune ket %brkt expr)] + ['~' (rune sig %brsg exqc)] + ['*' (rune tar %brtr exqc)] + ['=' (rune tis %brts exqc)] + ['?' (rune wut %brwt expa)] + ['$' (rune buc %brbc exqe)] + == + == + :- '$' + ;~ pfix buc + %- stew + ^. stet ^. limo + :~ ['@' (stag %ktcl (rune pat %bcpt exqb))] + ['_' (stag %ktcl (rune cab %bccb expa))] + [':' (stag %ktcl (rune col %bccl exqs))] + ['%' (stag %ktcl (rune cen %bccn exqs))] + ['<' (stag %ktcl (rune gal %bcgl exqb))] + ['>' (stag %ktcl (rune gar %bcgr exqb))] + ['|' (stag %ktcl (rune bar %bcbr exqc))] + ['&' (stag %ktcl (rune pam %bcpm exqc))] + ['^' (stag %ktcl (rune ket %bckt exqb))] + ['~' (stag %ktcl (rune sig %bcsg exqd))] + ['-' (stag %ktcl (rune hep %bchp exqb))] + ['=' (stag %ktcl (rune tis %bcts exqg))] + ['?' (stag %ktcl (rune wut %bcwt exqs))] + ['+' (stag %ktcl (rune lus %bcls exqg))] + ['.' (rune dot %kttr exqa)] + [',' (rune com %ktcl exqa)] + == + == + :- '%' + ;~ pfix cen + %- stew + ^. stet ^. limo + :~ ['_' (rune cab %cncb exph)] + ['.' (rune dot %cndt expb)] + ['^' (rune ket %cnkt expd)] + ['+' (rune lus %cnls expc)] + ['-' (rune hep %cnhp expb)] + [':' (rune col %cncl expi)] + ['~' (rune sig %cnsg expn)] + ['*' (rune tar %cntr expm)] + ['=' (rune tis %cnts exph)] + == + == + :- ':' + ;~ pfix col + %- stew + ^. stet ^. limo + :~ ['_' (rune cab %clcb expb)] + ['^' (rune ket %clkt expd)] + ['+' (rune lus %clls expc)] + ['-' (rune hep %clhp expb)] + ['~' (rune sig %clsg exps)] + ['*' (rune tar %cltr exps)] + == + == + :- '.' + ;~ pfix dot + %- stew + ^. stet ^. limo + :~ ['+' (rune lus %dtls expa)] + ['*' (rune tar %dttr expb)] + ['=' (rune tis %dtts expb)] + ['?' (rune wut %dtwt expa)] + ['^' (rune ket %dtkt exqn)] + == + == + :- '^' + ;~ pfix ket + %- stew + ^. stet ^. limo + :~ ['|' (rune bar %ktbr expa)] + ['.' (rune dot %ktdt expb)] + ['-' (rune hep %kthp exqc)] + ['+' (rune lus %ktls expb)] + ['&' (rune pam %ktpm expa)] + ['~' (rune sig %ktsg expa)] + ['=' (rune tis %ktts expj)] + ['?' (rune wut %ktwt expa)] + ['*' (rune tar %kttr exqa)] + [':' (rune col %ktcl exqa)] + == + == + :- '~' + ;~ pfix sig + %- stew + ^. stet ^. limo + :~ ['|' (rune bar %sgbr expb)] + ['$' (rune buc %sgbc expf)] + ['_' (rune cab %sgcb expb)] + ['%' (rune cen %sgcn hind)] + ['/' (rune fas %sgfs hine)] + ['<' (rune gal %sggl hinb)] + ['>' (rune gar %sggr hinb)] + ['+' (rune lus %sgls hinc)] + ['&' (rune pam %sgpm hinf)] + ['?' (rune wut %sgwt hing)] + ['=' (rune tis %sgts expb)] + ['!' (rune zap %sgzp expb)] + == + == + :- ';' + ;~ pfix mic + %- stew + ^. stet ^. limo + :~ [':' (rune col %mccl expi)] + ['/' (rune fas %mcfs expa)] + ['<' (rune gal %mcgl expz)] + ['~' (rune sig %mcsg expi)] + [';' (rune mic %mcmc exqc)] + == + == + :- '=' + ;~ pfix tis + %- stew + ^. stet ^. limo + :~ ['|' (rune bar %tsbr exqc)] + ['.' (rune dot %tsdt expq)] + ['?' (rune wut %tswt expw)] + ['^' (rune ket %tskt expt)] + [':' (rune col %tscl expp)] + ['/' (rune fas %tsfs expo)] + [';' (rune mic %tsmc expo)] + ['<' (rune gal %tsgl expb)] + ['>' (rune gar %tsgr expb)] + ['-' (rune hep %tshp expb)] + ['*' (rune tar %tstr expg)] + [',' (rune com %tscm expb)] + ['+' (rune lus %tsls expb)] + ['~' (rune sig %tssg expi)] + == + == + :- '?' + ;~ pfix wut + %- stew + ^. stet ^. limo + :~ ['|' (rune bar %wtbr exps)] + [':' (rune col %wtcl expc)] + ['.' (rune dot %wtdt expc)] + ['<' (rune gal %wtgl expb)] + ['>' (rune gar %wtgr expb)] + ['-' ;~(pfix hep (toad txhp))] + ['^' ;~(pfix ket (toad tkkt))] + ['=' ;~(pfix tis (toad txts))] + ['#' ;~(pfix hax (toad txhx))] + ['+' ;~(pfix lus (toad txls))] + ['&' (rune pam %wtpm exps)] + ['@' ;~(pfix pat (toad tkvt))] + ['~' ;~(pfix sig (toad tksg))] + ['!' (rune zap %wtzp expa)] + == + == + :- '!' + ;~ pfix zap + %- stew + ^. stet ^. limo + :~ [':' ;~(pfix col (toad expy))] + ['.' ;~(pfix dot (toad |.(loaf(bug |))))] + [',' (rune com %zpcm expb)] + [';' (rune mic %zpmc expb)] + ['>' (rune gar %zpgr expa)] + ['<' (rune gal %zpgl exqc)] + ['@' (rune pat %zppt expx)] + ['=' (rune tis %zpts expa)] + ['?' (rune wut %zpwt hinh)] + == + == + == + :: + ++ boog !: + %+ knee [p=*whit q=*term r=*help s=*hoon] + |.(~+((scye ;~(pose bola boba)))) + ++ bola :: ++ arms + %+ knee [q=*term r=*help s=*hoon] |. ~+ + %+ cook + |= [q=term r=whiz s=hoon] + ?: =(r *whiz) + [q *help s] + [q [[%funk q]~ [r]~] s] + ;~ pfix (jest '++') + ;~ plug + ;~(pfix gap ;~(pose (cold %$ buc) sym)) + apse:docs + ;~(pfix jump loaf) + == + == + ::TODO consider special casing $% + ++ boba :: +$ arms + %+ knee [q=*term r=*help s=*hoon] |. ~+ + %+ cook + |= [q=term r=whiz s=spec] + ?: =(r *whiz) + [q *help [%ktcl %name q s]] + [q [[%plan q]~ [r]~] [%ktcl %name q s]] + ;~ pfix (jest '+$') + ;~ plug + ;~(pfix gap sym) + apse:docs + ;~(pfix jump loan) + == + == + :: + :: parses a or [a b c] or a b c == + ++ lynx + =/ wid (ifix [sel ser] (most ace sym)) + =/ tal + ;~ sfix + (most gap sym) + ;~(plug gap duz) + == + =/ one + %- cook :_ sym + |= a=term + `(list term)`~[a] + %- cook + :_ ;~(pose (runq wid tal) one) + :: lestify + |= a=(list term) + ?~(a !! a) + :: + ++ whap !: :: chapter + %+ cook + |= a=(list (qual whit term help hoon)) + :: separate $helps into their own list to be passed to +glow + =/ [duds=(list help) nude=(list (pair term hoon))] + %+ roll a + |= $: $= bog + (qual whit term help hoon) + :: + $= gob + [duds=(list help) nude=(list (pair term hoon))] + == + =/ [unt=(list help) tag=(list help)] + %+ skid ~(tap by bat.p.bog) |=(=help =(~ cuff.help)) + :- ?: =(*help r.bog) + (weld tag duds.gob) + [r.bog (weld tag duds.gob)] + |- + ?~ unt [[q.bog s.bog] nude.gob] + =. s.bog [%note help/i.unt s.bog] + $(unt t.unt) + :: + %+ glow duds + |- ^- (map term hoon) + ?~ nude ~ + =+ $(nude t.nude) + %+ ~(put by -) + p.i.nude + ?: (~(has by -) p.i.nude) + [%eror (weld "duplicate arm: +" (trip p.i.nude))] + q.i.nude + :: + (most mush boog) + :: + :: +glow: moves batch comments to the correct arm + ++ glow + |= [duds=(list help) nude=(map term hoon)] + ^- (map term hoon) + |- + ?~ duds nude + :: if there is no link, its not part of a batch comment + ?~ cuff.i.duds + :: this shouldn't happen yet until we look for cuffs of length >1 + :: but we need to prove that cuff is nonempty anyways + $(duds t.duds) + :: + ::TODO: look past the first link. this probably requires + ::a major rethink on how batch comments work + =/ nom=(unit term) + ?+ i.cuff.i.duds ~ + :: we only support ++ and +$ batch comments right now + :: + ?([%funk *] [%plan *]) + `p.i.cuff.i.duds + == + %= $ + duds t.duds + nude ?~ nom nude + ?. (~(has by nude) u.nom) + :: ~> %slog.[0 leaf+"glow: unmatched link"] + nude + (~(jab by nude) u.nom |=(a=hoon [%note help+i.duds a])) + == + :: + ++ whip :: chapter declare + %+ cook + |= [[a=whit b=term c=whiz] d=(map term hoon)] + ^- [whit (pair term (map term hoon))] + ?. =(*whit a) + [a b d] + ?: =(*whiz c) + [*whit b d] + [%*(. *whit bat (malt [[%chat b]~ [c]~]~)) b d] + ;~(plug (seam ;~(pfix (jest '+|') gap cen sym)) whap) + :: + ++ wasp :: $brcb aliases + ;~ pose + %+ ifix + [;~(plug lus tar muck) muck] + (most muck ;~(gunk sym loll)) + :: + (easy ~) + == + :: + ++ wisp !: :: core tail + ?. tol fail + %+ cook + |= a=(list [wit=whit wap=(pair term (map term hoon))]) + ^- (map term tome) + =< p + |- ^- (pair (map term tome) (map term hoon)) + ?~ a [~ ~] + =/ mor $(a t.a) + =. q.wap.i.a + %- ~(urn by q.wap.i.a) + |= b=(pair term hoon) ^+ +.b + :: tests for duplicate arms between two chapters + ?. (~(has by q.mor) p.b) +.b + [%eror (weld "duplicate arm: +" (trip p.b))] + :_ (~(uni by q.mor) q.wap.i.a) + %+ ~(put by p.mor) + p.wap.i.a + :- %- ~(get by bat.wit.i.a) + ?: (~(has by bat.wit.i.a) [%chat p.wap.i.a]~) + [%chat p.wap.i.a]~ + ~ + ?. (~(has by p.mor) p.wap.i.a) + q.wap.i.a + [[%$ [%eror (weld "duplicate chapter: |" (trip p.wap.i.a))]] ~ ~] + :: + ::TODO: allow cores with unnamed chapter as well as named chapters? + ;~ pose + dun + ;~ sfix + ;~ pose + (most mush whip) + ;~(plug (stag *whit (stag %$ whap)) (easy ~)) + == + gap + dun + == + == + :: + ::TODO: check parser performance + ++ toad :: untrap parser expr + |* har=_expa + =+ dur=(ifix [pal par] $:har(tol |)) + ?. tol + dur + ;~(pose ;~(pfix jump $:har(tol &)) ;~(pfix gap $:har(tol &)) dur) + :: + ++ rune :: build rune + |* [dif=rule tuq=* har=_expa] + ;~(pfix dif (stag tuq (toad har))) + :: + ++ runo :: rune plus + |* [dif=rule hil=* tuq=* har=_expa] + ;~(pfix dif (stag hil (stag tuq (toad har)))) + :: + ++ runq :: wide or tall if tol + |* [wid=rule tal=rule] :: else wide + ?. tol + wid + ;~(pose wid tal) + :: + ++ butt |* zor=rule :: closing == if tall + ?:(tol ;~(sfix zor ;~(plug gap duz)) zor) + ++ ulva |* zor=rule :: closing -- and tall + ?.(tol fail ;~(sfix zor ;~(plug gap dun))) + ++ glop ~+((glue mash)) :: separated by space + ++ gunk ~+((glue muck)) :: separated list + ++ goop ~+((glue mush)) :: separator list & docs + ++ hank (most mush loaf) :: gapped hoons + ++ hunk (most mush loan) :: gapped specs + ++ jump ;~(pose leap:docs gap) :: gap before docs + ++ loaf ?:(tol tall wide) :: hoon + ++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs + ++ loan ?:(tol till wyde) :: spec + ++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin + ++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name + ++ mash ?:(tol gap ;~(plug com ace)) :: list separator + ++ muss ?:(tol jump ;~(plug com ace)) :: list w/ doccords + ++ muck ?:(tol gap ace) :: general separator + ++ mush ?:(tol jump ace) :: separator w/ docs + ++ teak %+ knee *tiki |. ~+ :: wing or hoon + =+ ^= gub + |= [a=term b=$%([%& p=wing] [%| p=hoon])] + ^- tiki + ?-(-.b %& [%& [~ a] p.b], %| [%| [~ a] p.b]) + =+ ^= wyp + ;~ pose + %+ cook gub + ;~ plug + sym + ;~(pfix tis ;~(pose (stag %& rope) (stag %| wide))) + == + :: + (stag %& (stag ~ rope)) + (stag %| (stag ~ wide)) + == + ?. tol wyp + ;~ pose + wyp + :: + ;~ pfix + ;~(plug ket tis gap) + %+ cook gub + ;~ plug + sym + ;~(pfix gap ;~(pose (stag %& rope) (stag %| tall))) + == + == + :: + (stag %| (stag ~ tall)) + == + ++ rack (most muss ;~(goop loaf loaf)) :: list [hoon hoon] + ++ ruck (most muss ;~(goop loan loaf)) :: list [spec hoon] + ++ rick (most mash ;~(goop rope loaf)) :: list [wing hoon] + :: hoon contents + :: + ++ expa |.(loaf) :: one hoon + ++ expb |.(;~(goop loaf loaf)) :: two hoons + ++ expc |.(;~(goop loaf loaf loaf)) :: three hoons + ++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons + ++ expe |.(wisp) :: core tail + ++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon + ++ expg |.(;~(gunk lomp loll loaf)) :: term/spec, two hoons + ++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s + ++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons + ++ expj |.(;~(goop lore loaf)) :: skin and hoon + :: ++ expk |.(;~(gunk loaf ;~(plug loaf (easy ~)))):: list of two hoons + :: ++ expl |.(;~(gunk sym loaf loaf)) :: term, two hoons + ++ expm |.((butt ;~(gunk rope loaf rick))) :: several [spec hoon]s + ++ expn |. ;~ gunk rope loaf :: wing, hoon, + ;~(plug loaf (easy ~)) :: list of one hoon + == :: + ++ expo |.(;~(goop wise loaf loaf)) :: =; + ++ expp |.(;~(goop (butt rick) loaf)) :: [wing hoon]s, hoon + ++ expq |.(;~(goop rope loaf loaf)) :: wing and two hoons + ++ expr |.(;~(goop loaf wisp)) :: hoon and core tail + ++ exps |.((butt hank)) :: closed gapped hoons + ++ expt |.(;~(gunk wise rope loaf loaf)) :: =^ + ++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, hoon, hoons + :: ++ expv |.((butt rick)) :: just changes + ++ expw |.(;~(goop rope loaf loaf loaf)) :: wing and three hoons + ++ expx |.(;~(goop ropa loaf loaf)) :: wings and two hoons + ++ expy |.(loaf(bug &)) :: hoon with tracing + ++ expz |.(;~(goop loan loaf loaf loaf)) :: spec and three hoons + :: spec contents + :: + ++ exqa |.(loan) :: one spec + ++ exqb |.(;~(goop loan loan)) :: two specs + ++ exqc |.(;~(goop loan loaf)) :: spec then hoon + ++ exqd |.(;~(goop loaf loan)) :: hoon then spec + ++ exqe |.(;~(goop lynx loan)) :: list of names then spec + ++ exqs |.((butt hunk)) :: closed gapped specs + ++ exqg |.(;~(goop sym loan)) :: term and spec + ::++ exqk |.(;~(goop loaf ;~(plug loan (easy ~)))):: hoon with one spec + ++ exqn |.(;~(gunk loan (stag %cltr (butt hank)))):: autoconsed hoons + ++ exqr |.(;~(gunk loan ;~(plug wasp wisp))) :: spec/aliases?/tail + ::++ exqw |.(;~(goop loaf loan)) :: hoon and spec + ++ exqx |.(;~(goop loaf loan loan)) :: hoon, two specs + ++ exqy |.(;~(goop loaf loan loan loan)) :: hoon, three specs + ++ exqz |.(;~(goop loaf (butt hunk))) :: hoon, n specs + :: + :: tiki expansion for %wt runes + :: + ++ txhp |. %+ cook |= [a=tiki b=(list (pair spec hoon))] + (~(wthp ah a) b) + (butt ;~(gunk teak ruck)) + ++ tkkt |. %+ cook |= [a=tiki b=hoon c=hoon] + (~(wtkt ah a) b c) + ;~(gunk teak loaf loaf) + ++ txls |. %+ cook |= [a=tiki b=hoon c=(list (pair spec hoon))] + (~(wtls ah a) b c) + (butt ;~(gunk teak loaf ruck)) + ++ tkvt |. %+ cook |= [a=tiki b=hoon c=hoon] + (~(wtpt ah a) b c) + ;~(gunk teak loaf loaf) + ++ tksg |. %+ cook |= [a=tiki b=hoon c=hoon] + (~(wtsg ah a) b c) + ;~(gunk teak loaf loaf) + ++ txts |. %+ cook |= [a=spec b=tiki] + (~(wtts ah b) a) + ;~(gunk loan teak) + ++ txhx |. %+ cook |= [a=skin b=tiki] + (~(wthx ah b) a) + ;~(gunk lore teak) + :: + :: hint syntax + :: + ++ hinb |.(;~(goop bont loaf)) :: hint and hoon + ++ hinc |. :: optional =en, hoon + ;~(pose ;~(goop bony loaf) (stag ~ loaf)) :: + ++ hind |.(;~(gunk bonk loaf ;~(goop bonz loaf))) :: jet hoon "bon"s hoon + ++ hine |.(;~(goop bonk loaf)) :: jet-hint and hoon + ++ hinf |. :: 0-3 >s, two hoons + ;~ pose + ;~(goop (cook lent (stun [1 3] gar)) loaf loaf) + (stag 0 ;~(goop loaf loaf)) + == + ++ hing |. :: 0-3 >s, three hoons + ;~ pose + ;~(goop (cook lent (stun [1 3] gar)) loaf loaf loaf) + (stag 0 ;~(goop loaf loaf loaf)) + == + ++ bonk :: jet signature + ;~ pfix cen + ;~ pose + ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot ;~(pfix dot dem))))) + ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot dem)))) + ;~(plug sym ;~(pfix dot dem)) + sym + == + == + ++ hinh |. :: 1/2 numbers, hoon + ;~ goop + ;~ pose + dem + (ifix [sel ser] ;~(plug dem ;~(pfix ace dem))) + == + loaf + == + ++ bont ;~ (bend) :: term, optional hoon + ;~(pfix cen sym) + ;~(pfix dot ;~(pose wide ;~(pfix muck loaf))) + == + ++ bony (cook |=(a=(list) (lent a)) (plus tis)) :: base 1 =en count + ++ bonz :: term-labelled hoons + ;~ pose + (cold ~ sig) + %+ ifix + ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pal par]) + (more mash ;~(gunk ;~(pfix cen sym) loaf)) + == + -- + :: + ++ lang :: lung sample + $: ros=hoon + $= vil + $% [%tis p=hoon] + [%col p=hoon] + [%ket p=hoon] + [%lit p=(list (pair wing hoon))] + == + == + :: + ++ lung + ~+ + %- bend + |: $:lang + ^- (unit hoon) + ?- -.vil + %col ?:(=([%base %flag] ros) ~ [~ %tsgl ros p.vil]) + %lit (bind ~(reek ap ros) |=(hyp=wing [%cnts hyp p.vil])) + %ket [~ ros p.vil] + %tis =+ rud=~(flay ap ros) + ?~(rud ~ `[%ktts u.rud p.vil]) + == + :: + ++ long + %+ knee *hoon |. ~+ + ;~ lung + scat + ;~ pose + ;~(plug (cold %tis tis) wide) + ;~(plug (cold %col col) wide) + ;~(plug (cold %ket ket) wide) + ;~ plug + (easy %lit) + (ifix [pal par] lobo) + == + == + == + :: + ++ lobo (most ;~(plug com ace) ;~(glam rope wide)) + ++ loon (most ;~(plug com ace) ;~(glam wide wide)) + ++ lute :: tall [] noun + ~+ + %+ cook |=(hoon +<) + %+ stag %cltr + %+ ifix + [;~(plug sel gap) ;~(plug gap ser)] + (most gap tall) + :: + ++ ropa (most col rope) + ++ rope :: wing form + %+ knee *wing + |. ~+ + %+ (slug |=([a=limb b=wing] [a b])) + dot + ;~ pose + (cold [%| 0 ~] com) + %+ cook + |=([a=(list) b=term] ?~(a b [%| (lent a) `b])) + ;~(plug (star ket) ;~(pose sym (cold %$ buc))) + :: + %+ cook + |=(a=axis [%& a]) + ;~ pose + ;~(pfix lus dim:ag) + ;~(pfix pam (cook |=(a=@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag)) + ;~(pfix bar (cook |=(a=@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag)) + ven + (cold 1 dot) + == + == + :: + ++ wise + ;~ pose + ;~ pfix tis + %+ sear + |= =spec + ^- (unit skin) + %+ bind ~(autoname ax spec) + |= =term + [%name term %spec spec %base %noun] + wyde + == + :: + %+ cook + |= [=term =(unit spec)] + ^- skin + ?~ unit + term + [%name term %spec u.unit %base %noun] + ;~ plug sym + (punt ;~(pfix ;~(pose fas tis) wyde)) + == + :: + %+ cook + |= =spec + ^- skin + [%spec spec %base %noun] + wyde + == + :: + ++ tall :: full tall form + %+ knee *hoon + |.(~+((wart (clad ;~(pose expression:(norm &) long lute apex:(sail &)))))) + ++ till :: mold tall form + %+ knee *spec + |.(~+((wert (coat ;~(pose structure:(norm &) scad))))) + ++ wede :: wide bulb + :: XX: lus deprecated + :: + ;~(pfix ;~(pose lus fas) wide) + ++ wide :: full wide form + %+ knee *hoon + |.(~+((wart ;~(pose expression:(norm |) long apex:(sail |))))) + ++ wyde :: mold wide form + %+ knee *spec + |.(~+((wert ;~(pose structure:(norm |) scad)))) + ++ wart + |* zor=rule + %+ here + |= [a=pint b=hoon] + ?:(bug [%dbug [wer a] b] b) + zor + ++ wert + |* zor=rule + %+ here + |= [a=pint b=spec] + ?:(bug [%dbug [wer a] b] b) + zor + -- +:: +++ vest + ~/ %vest + |= tub=nail + ^- (like hoon) + %. tub + %- full + (ifix [gay gay] tall:vast) +:: +++ vice + |= txt=@ta + ^- hoon + (rash txt wide:vast) +:: +++ make :: compile cord to nock + |= txt=@ + q:(~(mint ut %noun) %noun (ream txt)) +:: +++ rain :: parse with % path + |= [bon=path txt=@] + ^- hoon + =+ vaz=vast + ~| bon + (scan (trip txt) (full (ifix [gay gay] tall:vaz(wer bon)))) +:: +++ ream :: parse cord to hoon + |= txt=@ + ^- hoon + (rash txt vest) +:: +++ reck :: parse hoon file + |= bon=path + (rain bon .^(@t %cx (weld bon `path`[%hoon ~]))) +:: +++ ride :: end-to-end compiler + |= [typ=type txt=@] + ^- (pair type nock) + ~> %slog.[0 leaf/"ride: parsing"] + =/ gen (ream txt) + ~> %slog.[0 leaf/"ride: compiling"] + ~< %slog.[0 leaf/"ride: compiled"] + (~(mint ut typ) %noun gen) +:: +:: 5e: molds and mold builders ++| %molds-and-mold-builders +:: ++$ mane $@(@tas [@tas @tas]) :: XML name+space ++$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node ++$ marl (list manx) :: XML node list ++$ mars [t=[n=%$ a=[i=[n=%$ v=tape] t=~]] c=~] :: XML cdata ++$ mart (list [n=mane v=tape]) :: XML attributes ++$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag ++$ mite (list @ta) :: mime type ++$ pass @ :: public key ++$ ring @ :: private key ++$ ship @p :: network identity ++$ shop (each ship (list @ta)) :: urbit/dns identity ++$ spur path :: ship desk case spur ++$ time @da :: galactic time +:: +:: 5f: profiling support (XX move) ++| %profiling-support +:: +++ pi-heck + |= [nam=@tas day=doss] + ^- doss + =+ lam=(~(get by hit.day) nam) + day(hit (~(put by hit.day) nam ?~(lam 1 +(u.lam)))) +:: +++ pi-noon :: sample trace + |= [mot=term paz=(list path) day=doss] + =| lax=(unit path) + |- ^- doss + ?~ paz day(mon (pi-mope mot mon.day)) + %= $ + paz t.paz + lax `i.paz + cut.day + %+ ~(put by cut.day) i.paz + ^- hump + =+ nax=`(unit path)`?~(t.paz ~ `i.t.paz) + =+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~])) + :+ (pi-mope mot mon.hup) + ?~ lax out.hup + =+ hag=(~(get by out.hup) u.lax) + (~(put by out.hup) u.lax ?~(hag 1 +(u.hag))) + ?~ nax inn.hup + =+ hag=(~(get by inn.hup) u.nax) + (~(put by inn.hup) u.nax ?~(hag 1 +(u.hag))) + == +++ pi-mope :: add sample + |= [mot=term mon=moan] + ?+ mot mon + %fun mon(fun +(fun.mon)) + %noc mon(noc +(noc.mon)) + %glu mon(glu +(glu.mon)) + %mal mon(mal +(mal.mon)) + %far mon(far +(far.mon)) + %coy mon(coy +(coy.mon)) + %euq mon(euq +(euq.mon)) + == +++ pi-moth :: count sample + |= mon=moan ^- @ud + :(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon) +:: +++ pi-mumm :: print sample + |= mon=moan ^- tape + =+ tot=(pi-moth mon) + ;: welp + ^- tape + ?: =(0 noc.mon) ~ + (welp (scow %ud (div (mul 100 noc.mon) tot)) "n ") + :: + ^- tape + ?: =(0 fun.mon) ~ + (welp (scow %ud (div (mul 100 fun.mon) tot)) "c ") + :: + ^- tape + ?: =(0 glu.mon) ~ + (welp (scow %ud (div (mul 100 glu.mon) tot)) "g ") + :: + ^- tape + ?: =(0 mal.mon) ~ + (welp (scow %ud (div (mul 100 mal.mon) tot)) "m ") + :: + ^- tape + ?: =(0 far.mon) ~ + (welp (scow %ud (div (mul 100 far.mon) tot)) "f ") + :: + ^- tape + ?: =(0 coy.mon) ~ + (welp (scow %ud (div (mul 100 coy.mon) tot)) "y ") + :: + ^- tape + ?: =(0 euq.mon) ~ + (welp (scow %ud (div (mul 100 euq.mon) tot)) "e ") + == +:: +++ pi-tell :: produce dump + |= day=doss + ^- (list tape) + ?: =(day *doss) ~ + =+ tot=(pi-moth mon.day) + ;: welp + [(welp "events: " (pi-mumm mon.day)) ~] + :: + %+ turn + %+ sort ~(tap by hit.day) + |= [a=[* @] b=[* @]] + (lth +.a +.b) + |= [nam=term num=@ud] + :(welp (trip nam) ": " (scow %ud num)) + ["" ~] + :: + %- zing + ^- (list (list tape)) + %+ turn + %+ sort ~(tap by cut.day) + |= [one=(pair path hump) two=(pair path hump)] + (gth (pi-moth mon.q.one) (pi-moth mon.q.two)) + |= [pax=path hup=hump] + =+ ott=(pi-moth mon.hup) + ;: welp + [(welp "label: " (spud pax)) ~] + [(welp "price: " (scow %ud (div (mul 100 ott) tot))) ~] + [(welp "shape: " (pi-mumm mon.hup)) ~] + :: + ?: =(~ out.hup) ~ + :- "into:" + %+ turn + %+ sort ~(tap by out.hup) + |=([[* a=@ud] [* b=@ud]] (gth a b)) + |= [pax=path num=@ud] + ^- tape + :(welp " " (spud pax) ": " (scow %ud num)) + :: + ?: =(~ inn.hup) ~ + :- "from:" + %+ turn + %+ sort ~(tap by inn.hup) + |=([[* a=@ud] [* b=@ud]] (gth a b)) + |= [pax=path num=@ud] + ^- tape + :(welp " " (spud pax) ": " (scow %ud num)) + :: + ["" ~] + ~ + == + == +-- diff --git a/hoon/codegen/lib/line.hoon b/hoon/codegen/lib/line.hoon index c0cf9bd0..b0732135 100644 --- a/hoon/codegen/lib/line.hoon +++ b/hoon/codegen/lib/line.hoon @@ -1,1035 +1,1545 @@ -/- *sock -/- *gene +/- gene +|. +=> $:gene +:: XX +:: - generate ipb tests at 0/10 sites (done) +:: - make copy pessimize %this/%both case (not %both/%this) (done) +:: - do not ipb at mean entry/exit (done) +:: - no crash-immediate instructions, they could incorrectly skip over +:: other crashes (done) +:: - we don't actually need to track sick registers (done) +!: +=* sack +3 +=* moan moan.sack +=* cole cole.sack +=| =hill +=| rots=shed +=> |% -++ thy :: generation and interpretation - |_ burg=town - +* this . - ++ till - |= =farm - ^- [(list barn) _this] - =/ work (flop (skip wood.farm ~(has by land.burg))) - :- work - |- ^- _this :: work loop - ?~ work this - =+ ~| %next-miss (~(got by yard.farm) i.work) - =/ dock [lamb=lamb.burg lake=*lake] - =| flow=line - =/ axle=@ 1 - =/ fawn does - |^ - =^ [lout=plow tern=berm] dock rive - =^ greg=@ dock (vert lout tern) - %= ^$ - work t.work - lamb.burg lamb.dock - land.burg - %+ ~(put by land.burg) i.work - :_ says - [lake.dock (cite lout) greg] - == - ++ rive :: linearize nock - ^- [[hat=plow her=berm] dock=_dock] - ?- -.fawn - %par - =^ [one=plow two=plow her=berm] dock twin - =^ [bat=plow bit=berm] dock - rive(fawn +>.fawn, axle (peg axle 3), flow [%moat her two]) - =^ [hat=plow hit=berm] dock - rive(fawn +<.fawn, axle (peg axle 2), flow [%moat bit one]) - (copy hat bat hit) - :: - %zer - ?- -.flow - %moat - =/ slow (take +<.fawn what.flow +>.fawn) - ?~ slow - fail - :_ dock - [u.slow wher.flow] - :: - %rift - =^ miff dock wean - =/ slow (take +<.fawn [%tine miff] +>.fawn) - ?~ slow - fail - =^ her dock (mend %miff ~ %brn miff [troo fals]:flow) - :_ dock - [u.slow her] - :: - %pond - =^ tend dock wean - =/ slow (take +<.fawn [%tine tend] +>.fawn) - ?~ slow - fail - =^ her dock (mend %tend ~ %don tend) - :_ dock - [u.slow her] - == - :: - %one - (bang +.fawn) - :: - %two - ?- -.flow - %moat - =^ flaw dock (peel what.flow wher.flow) - (tool `flaw +.fawn) - :: - %rift - =^ muse dock wean - =^ skit dock (mend %skit ~ [%brn muse [troo fals]:flow]) - (tool `[muse skit] +.fawn) - :: - %pond - (tool ~ +.fawn) - == - :: - %thr - ?- -.flow - %moat - ?- -.what.flow - %fork fail - %disc rive(fawn +.fawn, axle (peg axle 3)) - %tine - =^ pear dock (mend %pear [%imm 0 +.what.flow]~ [%hop wher.flow] - =^ bock dock (mend %bock [%imm 1 +.what.flow]~ [%hop wher.flow] - =^ noon dock wean - =^ keck dock (mend %keck ~ %clq noon pear bock) - rive(fawn +.fawn, axle (peg axle 3), flow [%moat keck %tine noon]) - == - :: - %rift - =^ noon dock wean - =^ keck dock (mend %keck ~ %cloq noon [troo fals]:flow) - rive(fawn +.fawn, axle (peg axle 3), flow [%moat keck %tine noon]) - :: - %pond - =^ tend dock wean - =^ pear dock (mend %pear [%imm 0 tend]~ %don tend) - =^ bock dock (mend %bock [%imm 1 tend]~ %don tend) - =^ noon dock wean - =^ keck dock (mend %keck ~ %clq noon pear bock) - rive(fawn +.fawn, axle (peg axle 3), flow [%moat keck %tine noon]) - == - :: - %fou - ?- -.flow - %moat - ?- what.flow - %fork fail - %disc - ?: +>.fawn - rive(fawn +<.fawn, axle (peg axle 3)) - =^ left dock wean - =^ meal dock wean - =^ dink dock (mend %dink [[%inc meal left]]~ %hop wher.flow) - rive(fawn +<.fawn, axle (peg axle 3), flow [%moat dink %tine meal]) - :: - %tine - =^ meal dock wean - =^ rink dock - ?: +>.fawn - (mend %rink [[%unc meal +.what.flow]]~ %hop wher.flow) - (mend %rink [[%inc meal +.what.flow]]~ %hop wher.flow) - rive(fawn +<.fawn, axle (peg axle 3), flow [%moat rink %tine meal]) - == - :: - %rift - =^ iffy dock wean - =^ miff dock wean - =^ kink dock - ?: +>.fawn - (mend %kink [[%unc miff iffy]]~ %brn iffy [troo fals]:flow) - (mend %kink [[%inc miff iffy]]~ %brn iffy [troo fals]:flow) - rive(fawn +<.fawn, axle (peg axle 3), flow [%moat kink %tine miff]) - :: - %pond - =^ pend dock wean - =^ spin dock wean - =^ pink dock - ?: +>.fawn - (mend %pink [[%unc spin pend]] %don pend) - (mend %pink [[%inc spin pend]] %don pend) - rive(fawn +<.fawn, axle (peg axle 3), flow [%moat pink %tin spin]) - == +:: work +:: +:: new: set of bells in moan, not in hill (require codegen) +:: old: set of bells in hill, not in moan (should be dropped from hill) +++ peck + =| miel=(list bell) + =/ foam ~(tap by moan) + |- ^- [new=(set bell) old=(set bell)] + ?^ foam + ?^ q.i.foam + $(q.i.foam t.q.i.foam, miel [[soot.i.q.i.foam p.i.foam] miel]) + $(foam t.foam) + =/ jell ~(key by hill) + =/ mell (~(gas in *(set bell)) miel) + [(~(dif in mell) jell) (~(dif in jell) mell)] :: want mif-in +:: +:: new bells +++ noob + ^- (set bell) + =/ new new:peck + new +:: +:: bells to drop +++ dead + ^- (set bell) + old:peck +:: +:: look up analysis +:: +:: look up an arm in the moan face of the sack core +++ puck + |= =bell + ^- (unit hone) + =/ hose (~(get ja moan) form.bell) + |- ^- (unit hone) + ?^ hose + ?: =(text.bell soot.i.hose) `i.hose + $(hose t.hose) + ~ +:: worklist +:: +:: sort all of the un-linearized arms in `moan` topologically by the +:: reverse call DAG (so terminal arms come first). This ensures that we +:: only have to "redo" recursive callsites. +++ work + ^- (list bell) + =/ news noob + ?: =(~ news) ~ + =/ sire=(jug bell bell) + %- ~(rep in news) + |= [b=bell sire=(jug bell bell)] + =/ hues (puck b) + ?< ?=(~ hues) + =/ team (~(gas in *(set bell)) ~(val by ices.norm.u.hues)) + =. team (~(dif in team) loop.norm.u.hues) + =. team (~(int in team) news) + %- ~(rep in team) + |: [k=*bell s=sire] + (~(put ju s) k b) + =< tack.s + %- ~(rep in news) + |= [v=bell s=[done=(set bell) tack=(list bell)]] + =* dfs $ + ^- _s + ?: (~(has in done.s) v) s + =. done.s (~(put in done.s) v) + =/ e=(set bell) (~(get ju sire) v) + =. e (~(dif in e) done.s) + =. s + %- ~(rep in e) + |: [n=*bell s=s] + ^- _s + dfs(v n, s s) + s(tack [v tack.s]) +:: +:: internal state +:: +:: redo: arms called without knowing registerization +:: will: code table +:: sans: next SSA register +:: sick: registers which should be checked for crashing at next mean +:: boundary ++$ gen [redo=(list bile) will=(map bile blob) sans=@uvre] +:: codegen +:: +:: door containing core codegen operations +++ jean + =/ fax 1 + =/ =goal [%done ~] + |_ [=bell =gen like=(map bell need)] + :: codegen loop + :: + :: traverse nomm RLN and emit linearized code + ++ cuts + =+ =/ huns (puck bell) + ?> ?=(^ huns) + norm.u.huns + |- ^- [next _gen] + ?- -.nomm + %par + ?- -.goal + %done + =^ last gen rain + =^ loch gen (emit %loch ~ ~ %don last) + $(goal [%next [%this last] loch]) + :: + %pick + (mine sass.goal zero.goal) + :: + %next + =^ [bill=bile left=need rite=need] gen (lyse goal) + =^ tale gen + $(nomm rite.nomm, goal [%next rite bill], fax (peg fax 3)) + =^ hale gen + $(nomm left.nomm, goal [%next left then.tale], fax (peg fax 2)) + (copy hale what.tale) + == + :: + %not + ?: =(0 here.nomm) bomb + ?- -.goal + %done + =^ last gen rain + =^ dear gen (emit %dear ~ ~ %don last) + $(goal [%next [%this last] dear]) + :: + %pick + =^ cove gen rain + =^ cozy gen (emit %cozy ~ ~ %brn cove [zero once]:goal) + $(goal [%next [%this cove] cozy]) + :: + %next + (from here.nomm goal) + == + :: + %one + ?- -.goal + %done + =^ last gen rain + =^ rime gen (emit %rime ~ [%imm moan.nomm last]~ %don last) + [[%next [%none ~] rime] gen] + :: + %pick + ?: =(0 moan.nomm) + [[%next [%none ~] zero.goal] gen] + ?: =(1 moan.nomm) + [[%next [%none ~] once.goal] gen] + (mine sass.goal zero.goal) + :: + %next + =^ bill gen (mede then.goal moan.nomm what.goal) + [[%next [%none ~] bill] gen] + == + :: + %two + ?: ?=(%pick -.goal) + =^ flip gen rain + =^ bird gen (emit %bird ~ ~ %brn flip [zero once]:goal) + $(goal [%next [%this flip] bird]) + =/ bull (~(get by ices) rail.nomm) + ?~ bull + ?- -.goal + %done + =^ s gen rain + =^ f gen rain + =^ tide gen (emit %tide ~ ~ %lnt s f) + =^ corn gen $(nomm corn.nomm, fax (peg fax 7), goal [%next [%this f] tide]) + =^ cost gen $(nomm cost.nomm, fax (peg fax 6), goal [%next [%this s] then.corn]) + (copy cost what.corn) :: - %fiv - ?- -.flow - %moat - ?- -.what.flow - %fork fail - %disc - =^ [hit=plow his=berm] dock - rive(fawn +<.fawn, axle (peg axle 6)) - =^ [hit=plow his=berm] dock - rive(fawn +>.fawn, axle (peg axle 7), flow [%moat his %disc ~) - (copy hit hot hog) - :: - %tine - =^ root dock - (mend %root [[%imm 0 +.what.flow]]~ %hop wher.flow) - =^ salt dock - (mend %salt [[%imm 0 +.what.flow]]~ %hop wher.flow) - =^ load dock wean - =^ toad dock wean - =^ qual dock - (mend %qual ~ %eqq load toad root salt) - =^ [hit=plow his=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat qual %tine load] - == - =^ [hot=plow hog=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat his %tine toad] - == - (copy hit hot hog) - == - :: - %rift - =^ load dock wean - =^ toad dock wean - =^ rail dock (mend %rail ~ %eqq load toad [troo fals]:flow) - =^ [hit=plow his=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat rail %tine load] - == - =^ [hot=plow hog=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat his %tine toad] - == - (copy hit hot hog) - :: - %pond - =^ bean dock wean - =^ root dock (mend %root [[%imm 0 bean]]~ %don bean) - =^ salt dock (mend %salt [[%imm 1 bean]]~ %don bean) - =^ load dock wean - =^ toad dock wean - =^ fall dock (mend %fall ~ %eqq load toad root salt) - =^ [hit=plow his=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat fall %tine load] + %next + =^ [post=bile salt=@uvre] gen (kerf %post goal) + =^ s gen rain + =^ f gen rain + =^ dine gen (emit %dine ~ ~ %lnk s f salt post) + =^ corn gen $(nomm corn.nomm, fax (peg fax 7), goal [%next [%this f] dine]) + =^ cost gen $(nomm cost.nomm, fax (peg fax 6), goal [%next [%this s] then.corn]) + (copy cost what.corn) + == + =/ hope (~(get by call.cole) u.bull) + =^ a gen (args u.bull) + ?- -.goal + %done + =^ [dire=bile seed=need] gen + ?~ hope + =^ dike gen (emit %dike ~ ~ %jmp u.bull v.a) + =? redo.gen r.a [dike redo.gen] + [[dike n.a] gen] + =^ s gen rain + ~! u.hope + =^ dial gen (emit %dial ~ ~ %jmf u.bull v.a s u.hope) + =? redo.gen r.a [dial redo.gen] + =^ nest gen (copy [%next n.a dial] [%this s]) + [[then.nest what.nest] gen] + =^ corn gen $(nomm corn.nomm, fax (peg fax 7), goal [%next [%none ~] dire]) + =^ cost gen $(nomm cost.nomm, fax (peg fax 6), goal [%next seed then.corn]) + (copy cost what.corn) + :: + %next + =^ [post=bile salt=@uvre] gen (kerf %post goal) + =^ [dire=bile seed=need] gen + ?~ hope + =^ dine gen (emit %dine ~ ~ %cal u.bull v.a salt post) + =? redo.gen r.a [dine redo.gen] + [[dine n.a] gen] + =^ s gen rain + =^ dime gen (emit %dime ~ ~ %caf u.bull v.a salt post s u.hope) + =? redo.gen r.a [dime redo.gen] + =^ nest gen (copy [%next n.a dime] [%this s]) + [[then.nest what.nest] gen] + =^ corn gen $(nomm corn.nomm, fax (peg fax 7), goal [%next [%none ~] dire]) + =^ cost gen $(nomm cost.nomm, fax (peg fax 6), goal [%next seed then.corn]) + (copy cost what.corn) + == + :: + %the + ?- -.goal + %done + =^ last gen rain + =^ hasp gen rain + =^ barf gen rain + =^ tear gen (emit %tear ~ [%imm 0 last]~ %don last) + =^ fear gen (emit %fear ~ [%imm 1 hasp]~ %don hasp) + $(goal [%pick barf tear fear]) + :: + %next + ?: ?=(%both -.what.goal) (mine sass.what.goal then.goal) + ?: ?=(%none -.what.goal) + =^ barf gen rain + $(goal [%pick barf then.goal then.goal]) + =^ tare gen rain + =/ tile (vial %tile) + =^ fare gen rain + =/ file (vial %file) + =^ thin gen + %: emit + %thin + %: ~(put by *(map @uvre (map bile @uvre))) + sass.what.goal + (~(gas by *(map bile @uvre)) ~[[tile tare] [file fare]]) == - =^ [hot=plow hog=berm] dock - %= rive - fawn +>.fawn - axle (peg axle 7) - flow [%moat his %tine toad] + ~ + %hop then.goal + == + =^ tear gen (come tile thin) + =^ fear gen (come file thin) + =^ celt gen (emit %celt ~ [%imm 0 tare]~ %hop tear) + =^ felt gen (emit %felt ~ [%imm 1 fare]~ %hop fear) + =^ barf gen rain + $(goal [%pick barf celt felt]) + :: + %pick + =^ coat gen rain + =^ pith gen (emit %pith ~ ~ %clq coat [zero once]:goal) + $(nomm pell.nomm, goal [%next [%this coat] pith], fax (peg fax 3)) + == + :: + %for + ?- -.goal + %done + =^ rink gen rain + =^ pink gen rain + =^ tike gen (emit %tike ~ [%inc pink rink]~ %don rink) + $(nomm mall.nomm, goal [%next [%this pink] tike], fax (peg fax 3)) + :: + %pick + =^ rink gen rain + =^ pink gen rain + =^ pike gen + (emit %pike ~ [%inc pink rink]~ %brn rink [zero once]:goal) + $(nomm mall.nomm, goal [%next [%this pink] pike], fax (peg fax 3)) + :: + %next + ?: ?=(%both -.what.goal) (mine sass.what.goal then.goal) + =^ rink gen + ?: ?=(%none -.what.goal) + rain + [sass.what.goal gen] + =^ pink gen rain + =^ bike gen + (emit %bike ~ [%inc pink rink]~ %hop then.goal) + $(nomm mall.nomm, goal [%next [%this pink] bike], fax (peg fax 3)) + == + :: + %ivy + ?- -.goal + %done + =^ last gen rain + =^ hasp gen rain + =^ reek gen (emit %reek ~ [%imm 0 last]~ %don last) + =^ riff gen (emit %riff ~ [%imm 1 hasp]~ %don hasp) + =^ crap gen rain + $(goal [%pick crap reek riff]) + :: + %next + ?: ?=(%both -.what.goal) (mine sass.what.goal then.goal) + ?: ?=(%none -.what.goal) + =^ than gen $(nomm that.nomm, fax (peg fax 7)) + =^ thin gen + $(nomm this.nomm, fax (peg fax 6), then.goal then.than) + (copy thin what.than) + =^ tare gen rain + =/ till (vial %till) + =^ fare gen rain + =/ fill (vial %fill) + =^ ward gen + %: emit + %ward + %: ~(put by *(map @uvre (map bile @uvre))) + sass.what.goal + (~(gas by *(map bile @uvre)) ~[[till tare] [fill fare]]) == - (copy hit hot hog) + ~ + %hop + then.goal == + =^ weir gen (come till ward) + =^ mere gen (come fill ward) + =^ ware gen (emit %ware ~ [%imm 0 tare]~ %hop weir) + =^ mare gen (emit %mare ~ [%imm 1 fare]~ %hop mere) + =^ crap gen rain + $(goal [%pick crap ware mare]) + :: + %pick + =^ tire gen rain + =^ tear gen rain + =^ pare gen (emit %pare ~ ~ %eqq tire tear [zero once]:goal) + =^ than gen + $(nomm that.nomm, goal [%next [%this tear] pare], fax (peg fax 7)) + =^ thin gen + $(nomm this.nomm, goal [%next [%this tire] then.than], fax (peg fax 6)) + (copy thin what.than) + == + :: + %six + ?: ?=(%next -.goal) + =^ [teal=next feel=next] gen (phil goal) + =^ fest gen + $(nomm else.nomm, fax (peg fax 15), goal feel) + =^ zest gen + $(nomm then.nomm, fax (peg fax 14), goal teal) + =^ [bead=need tile=bile file=bile] gen (sect zest fest) + =^ lead gen rain + =^ cond gen + $(nomm what.nomm, fax (peg fax 6), goal [%pick lead tile file]) + (copy cond bead) + =^ fest gen + $(nomm else.nomm, fax (peg fax 15)) + =^ zest gen + $(nomm then.nomm, fax (peg fax 14)) + =^ [bead=need tile=bile file=bile] gen (sect zest fest) + =^ barf gen rain + =^ tool gen (emit %tool ~ [%ipb ~[barf]]~ %hop tile) + =^ cond gen + $(nomm what.nomm, fax (peg fax 6), goal [%pick barf tool file]) + (copy cond bead) + :: + %eve + =^ thin gen $(nomm then.nomm, fax (peg fax 7)) + $(nomm once.nomm, goal thin, fax (peg fax 6)) + :: + %ten + ?- -.goal + %done + =^ last gen rain + =^ dead gen (emit %dead ~ ~ %don last) + $(goal [%next [%this last] dead]) + :: + %pick + ?. =(here.nomm 1) (mine sass.goal zero.goal) + =^ flip gen rain + =^ deep gen (emit %deep ~ ~ %brn flip [zero once]:goal) + $(goal [%next [%this flip] deep]) + :: + %next + =^ [twig=need tree=need then=bile] gen (into here.nomm goal) + =^ nest gen + $(nomm tree.nomm, fax (peg fax 15), goal [%next tree then]) + =^ eggs gen + $(nomm twig.nomm, fax (peg fax 14), goal [%next twig then.nest]) + (copy eggs what.nest) + == + :: + %sip + ?+ hint.nomm $(nomm then.nomm, fax (peg fax 7)) + %bout + ?- -.goal + %done + =^ last gen rain + =^ dime gen (emit %dime ~ ~ %don last) + $(goal [%next [%this last] dime]) :: - %six - =^ [hut=plow hum=berm] dock rive(fawn +>-.fawn, axle (peg axle 14)) - =^ [hat=plow ham=berm] dock rive(fawn +>+.fawn, axle (peg axle 15)) - =^ [mat=plow troo=berm fals=berm] dock (tamp hut hum hat ham) - =^ [hot=plow hog=berm] dock - rive(fawn +<.fawn, axle (peg axle 6), flow [%rift troo fals]) - (copy hot mat hog) + %pick + =^ tome gen (emit %tome ~ [%tom ~]~ %hop zero.goal) + =^ foam gen (emit %foam ~ [%tom ~]~ %hop once.goal) + =^ race gen + $(nomm then.nomm, fax (peg fax 7), goal [%pick sass.goal tome foam]) + =^ tick gen (emit %tick ~ [%tim ~]~ %hop then.race) + [race(then tick) gen] :: - %sev - =^ [hit=plow his=berm] dock rive(fawn +>.fawn, axle (peg axle 7)) - rive(fawn +<.fawn, axle (peg axle 6), flow [%moat his hit]) + %next + =^ stop gen (emit %stop ~ [%tom ~]~ %hop then.goal) + =^ race gen + $(nomm then.nomm, fax (peg fax 7), then.goal stop) + =^ goes gen (emit %goes ~ [%tim ~]~ %hop then.race) + [race(then goes) gen] + == + :: + %meme + =^ raft gen $(nomm then.nomm, fax (peg fax 7)) + =^ meme gen (emit %meme ~ [%mem ~]~ %hop then.raft) + [raft(then meme) gen] + == + :: + %tip + ?+ hint.nomm + =^ thin gen $(nomm then.nomm, fax (peg fax 7)) + =^ fake gen + $(nomm vice.nomm, fax (peg fax 13), goal [%next [%none ~] then.thin]) + (copy fake what.thin) + :: + ?(%hunk %hand %lose %mean %spot) + =^ mane gen rain + ?- -.goal + %done + =^ real gen $(nomm then.nomm, fax (peg fax 7)) + =^ dint gen + (emit %dint ~ [%men hint.nomm mane]~ %hop then.real) + =^ fake gen + $(nomm vice.nomm, fax (peg fax 14), goal [%next [%this mane] dint]) + (copy fake what.real) :: - %ten - ?- -.flow - %moat - =^ [out=plow inn=plow tub=berm] dock (tear +<-.fawn what.flow +>+.fawn wher.flow) - =^ [hat=plow him=berm] dock rive(fawn +<+.fawn, axle (peg axle 13), flow [%moat tub inn]) - =^ [hut=plow mud=berm] dock rive(fawn +>-.fawn, axle (peg axle 14), flow [%moat him out]) - (copy hat hut mud) - :: - %rift - :: this is a weird case. It only works with axis 1. - :: Otherwise it crashes. - :: The only use of axis 1 edit is to discard the outer - :: result. - ?. =(1 +<-.fawn) fail - =^ hide dock wean - =^ mood dock (mend %mood ~ %brn hide [troo fals]:flow) - =^ [hat=plow him=berm] dock - rive(fawn +<+.fawn, axle (peg axle 13), flow [%moat mood %tine hide]) - =^ [hut=plow mud=berm] dock - rive(fawn +>-.fawn, axle (peg axle 14), flow [%moat him [%disc ~]]) - (copy hat hut mud) - :: - %pond - =^ dire dock wean - =^ eden dock (mend %eden ~ [%don dire]) - =^ [out=plow inn=plow tub=berm] dock (tear +<-.fawn [%tine dire] +>+.fawn eden) - =^ [hat=plow him=berm] dock rive(fawn +<+.fawn, axle (peg axle 13), flow [%moat tub inn]) - =^ [hut=plow mud=berm] dock rive(fawn +>-.fawn, axle (peg axle 14), flow [%moat him out]) - (copy hat hut mud) - == + %pick + =^ tame gen (emit %tame ~ [%man ~]~ %hop zero.goal) + =^ fame gen (emit %fame ~ [%man ~]~ %hop once.goal) + =^ real gen + $(nomm then.nomm, fax (peg fax 7), goal [%pick sass.goal tame fame]) + =^ dint gen + (emit %dint ~ [%men hint.nomm mane]~ %hop then.real) + =^ fake gen + $(nomm vice.nomm, fax (peg fax 13), goal [%next [%this mane] dint]) + (copy fake what.real) :: - %els - =^ [hat=plow him=berm] dock rive(fawn +>.fawn, axle (peg axle 7)) - =^ pint dock wean - =^ tint dockk (mend %tint [[%imm +<.fawn pint]]~ %hnt pint him) - :_ dock - [hat tint] + %next + =^ rugs gen (emit %rugs ~ [%man ~]~ %hop then.goal) + =^ real gen + $(nomm then.nomm, fax (peg fax 7), then.goal rugs) + =^ dint gen + (emit %dint ~ [%men hint.nomm mane]~ %hop then.real) + =^ fake gen + $(nomm vice.nomm, fax (peg fax 13), goal [%next [%this mane] dint]) + (copy fake what.real) + == + :: + ?(%live %slog) + =^ clue gen rain + =^ real gen $(nomm then.nomm, fax (peg fax 7)) + =^ wave gen + ?: ?=(%live hint.nomm) + (emit %live ~ [%hit clue]~ %hop then.real) + (emit %slog ~ [%slg clue]~ %hop then.real) + =^ fake gen + $(nomm vice.nomm, fax (peg fax 13), goal [%next [%this clue] wave]) + (copy fake what.real) + :: + %memo + =/ fork (~(got by fizz) hare.nomm) + =^ funk gen rain + =^ sunk gen rain + =^ gunk gen rain + =/ body=(list pole) ~[[%imm 0 gunk] [%imm fork funk]] + ?- -.goal + %done + =^ salt gen rain + =^ mode gen (emit %mode ~ ~ %don salt) + $(goal [%next [%this salt] mode]) :: - %eld - =^ [hat=plow him=berm] dock rive(fawn +>-.fawn, axle (peg axle 7)) - =^ pint dock wean - =^ dint dock wean - =^ aint dock wean - =^ tint dock - %: mend - %tint - [[%imm +<-.fawn pint] [%con pint dint aint]]~ - [%hnt aint him] - == - =^ [hit=plow his=berm] dock rive(fawn +<+.fawn, axle (peg axle 13), flow [%moat tint %tine dint]) - (copy hit hat his) + %pick + =^ mere gen rain + =^ chit gen (emit %chit ~ ~ %brn mere zero.goal once.goal) + =^ loot gen rain + =^ root gen rain + =^ loam gen (emit %loam ~ ~[[%imm 0 loot] [%mew gunk sunk funk loot]] %hop zero.goal) + =^ rome gen (emit %rome ~ ~[[%imm 1 root] [%mew gunk sunk funk root]] %hop once.goal) + =^ moog gen $(nomm then.nomm, fax (peg fax 7), zero.goal loam, once.goal rome) + =^ cast gen (emit %cast ~ body %mer gunk sunk funk mere chit then.moog) + =^ fake gen $(nomm vice.nomm, fax (peg fax 13), goal [%next [%none ~] cast]) + =^ fear gen (copy fake what.moog) + (copy fear [%this sunk]) :: - %twe - ?- -.flow - %moat - =^ [use=@ her=berm] dock (peel what.flow wher.flow) - =^ fens dock wean - =^ phat dock wean - =^ cope dock (mend %cope ~ %spy fens phat use her) - =^ [ham=plow pan=berm] dock - %= rive - fawn +>.fawn - axle (peg axle 7) - flow [%moat cope %tine phat] - == - =^ [hen=plow pen=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat pan %tine fens] - == - (copy ham hen pen) - :: - %pond - =^ sped dock wean - =^ sear dock (mend %sear ~ %don sped) - =^ fens dock wean - =^ phat dock wean - =^ cope dock (mend %cope ~ %spy fens phat sped sear) - =^ [ham=plow pan=berm] dock - %= rive - fawn +>.fawn - axle (peg axle 7) - flow [%moat cope %tine phat] - == - =^ [hen=plow pen=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat pan %tine fens] - == - (copy ham hen pen) + %next + =^ [chit=next miss=next] gen (phil goal) + =^ [chin=bile mere=@uvre] gen (kerf %chin chit) + =^ [misc=bile salt=@uvre] gen (kerf %salt miss) + =^ meow gen (emit %meow ~ [%mew gunk sunk funk salt]~ %hop misc) + =^ real gen $(nomm then.nomm, fax (peg fax 7), goal [%next [%this salt] meow]) + =^ cake gen (emit %cake ~ body %mer gunk sunk funk mere chin misc) + =^ fake gen $(nomm vice.nomm, fax (peg fax 13), goal [%next [%none ~] cake]) + =^ cope gen (copy fake what.real) + (copy cope [%this sunk]) + == + :: + %bout ~| %todo !! + == + :: + %elf + ?- -.goal + %done + =^ last gen rain + =^ deft gen (emit %deft ~ ~ %don last) + $(goal [%next [%this last] deft]) + :: + %pick + =^ flip gen rain + =^ heft gen (emit %heft ~ ~ %brn flip [zero once]:goal) + $(goal [%next [%this flip] heft]) + :: + %next + =^ [weft=bile good=@uvre] gen (kerf %weft goal) + =^ home gen rain + =^ path gen rain + =^ show gen (emit %show ~ ~ %spy home path good weft) + =^ trot gen + $(nomm walk.nomm, fax (peg fax 7), goal [%next [%this path] show]) + =^ paid gen + $(nomm rent.nomm, fax (peg fax 6), goal [%next [%this home] then.trot]) + (copy paid what.trot) + == + == + :: + :: redo callsite registerization + :: + :: given recursion, we may not know the registerization for an arm + :: when we generate a direct call to it. Thus, once we have generated + :: code for all arms in the call tree and know their + :: registerizations, we return to callsites and generate + :: properly-registerized calls, without changing the registerization + :: of the calling arm. + ++ redo + |= =bile + ^- _gen + =. fax axe.bile + =/ blob (~(got by will.gen) bile) + ?+ -.bend.blob ~| %redo-cant !! + %cal + ?> ?=(^ v.bend.blob) + ?> ?=(~ t.v.bend.blob) + ?> (~(has by like) a.bend.blob) + =^ urge gen (args a.bend.blob) + =^ reed gen (emit %reed ~ ~ bend.blob(v v.urge)) + =^ [rush=_bile i=@uvre] gen (kerf %rush [%next n.urge reed]) + =. will.gen (~(del by will.gen) bile) + (emir bile ~ [%mov i.v.bend.blob i]~ %hop rush) + :: + %caf + ?> ?=(^ v.bend.blob) + ?> ?=(~ t.v.bend.blob) + ?> (~(has by like) a.bend.blob) + =^ urge gen (args a.bend.blob) + =^ reed gen (emit %reed ~ ~ bend.blob(v v.urge)) + =^ [rush=_bile i=@uvre] gen (kerf %rush [%next n.urge reed]) + =. will.gen (~(del by will.gen) bile) + (emir bile ~ [%mov i.v.bend.blob i]~ %hop rush) + :: + %jmp + ?> ?=(^ v.bend.blob) + ?> ?=(~ t.v.bend.blob) + ?> (~(has by like) a.bend.blob) + =^ urge gen (args a.bend.blob) + =^ reed gen (emit %reed ~ ~ bend.blob(v v.urge)) + =^ [rush=_bile i=@uvre] gen (kerf %rush [%next n.urge reed]) + =. will.gen (~(del by will.gen) bile) + (emir bile ~ [%mov i.v.bend.blob i]~ %hop rush) + :: + %jmf + ?> ?=(^ v.bend.blob) + ?> ?=(~ t.v.bend.blob) + ?> (~(has by like) a.bend.blob) + =^ urge gen (args a.bend.blob) + =^ reed gen (emit %reed ~ ~ bend.blob(v v.urge)) + =^ [rush=_bile i=@uvre] gen (kerf %rush [%next n.urge reed]) + =. will.gen (~(del by will.gen) bile) + (emir bile ~ [%mov i.v.bend.blob i]~ %hop rush) + == + :: split register to need + :: + :: given a destination, generate code which splits a noun in one + :: register to the registers described by the $need, and return the + :: one register and a label for the splitting code + ++ kerf + |= [thus=@tas =next] + ^- [[bile @uvre] _gen] + =^ ir gen (kern ~ what.next) + ?~ pose.ir + [[then.next out.ir] gen] + =^ thin gen (emit thus ~ (flop pose.ir) %hop then.next) + [[thin out.ir] gen] + :: split register to need (instruction list) + :: + :: like +kerf but return (reversed) instruction list instead of emitting basic block + ++ kern + |= [pose=(list pole) =need] + ^- [[pose=(list pole) out=@uvre] _gen] + =/ tack=(list _need) ~[need] + =/ ui (sass need) + ?~ ui + =^ crap gen rain + [[~ crap] gen] + |- ^- [[pose=(list pole) out=@uvre] _gen] + ?~ tack + [[pose u.ui] gen] + =* n i.tack + ?: ?=(%both -.n) + =/ lure (sass left.n) + =/ rule (sass rite.n) + =? pose ?=(^ lure) + [[%hed sass.n u.lure] pose] + =? pose ?=(^ rule) + [[%tal sass.n u.rule] pose] + $(tack [left.n rite.n t.tack]) + $(tack t.tack) + :: emit basic block + :: + :: given a fixed label and a basic block, + :: add the basic block to the code table + ++ emit + |= [thus=@tas =blob] + ^- [bile _gen] + =/ bill [%bile fax thus bell] + [bill (emir bill blob)] + :: emit basic block (raw label) + :: + :: given a raw bile and a basic block, add the basic block to the code + :: tabel at that label. + ++ emir + |= [=bile =blob] + ^- _gen + gen(will (~(put by will.gen) bile blob)) + :: + :: generate a register + :: + :: return the current next SSA register and increment the next SSA + :: register in the codegen state + ++ rain + ^- [@uvre _gen] + [sans.gen gen(sans .+(sans.gen))] + :: + :: split need + :: + :: split a need into two, generating cons instruction if necessary + ++ lyse + |= =next + ^- [[bile need need] _gen] + ?- -.what.next + %both :: discards sick flag which is OK since we know we will fulfill the need + [[then.next left.what.next rite.what.next] gen] + :: + %none + [[then.next [%none ~] %none ~] gen] + :: + %this + =^ l gen rain + =^ r gen rain + =^ lizz gen (emit %lyse ~ [%con l r sass.what.next]~ %hop then.next) + [[lizz [%this l] [%this r]] gen] + == + :: + :: outermost register + :: + :: get the outermost register of a need (or ~ if the need is %none): + :: used for noun-splitting code + ++ sass + |= =need + ^- (unit @uvre) + ?- -.need + %both `sass.need + %this `sass.need + %none ~ + == + :: intersect needs + :: + :: match needs from branching control flow, generating noun-splitting + :: code for each branch as necessary + :: + :: this generates the maximally common split of registers between + :: both branches. If one branch expects a cell at an axis but the other does + :: not, then we must expect that axis in a register so we do not + :: crash when the more permissive branch would be taken + ++ sect + |= [zero=next once=next] + =| lose=(list pole) + =| rose=(list pole) + =/ tack=(list (each r=@uvre [z=need o=need])) [%| what.zero what.once]~ + =| salt=(list need) + |- ^- [[need bile bile] _gen] + ?~ tack + ?> ?=(^ salt) + ?> ?=(~ t.salt) + =^ loan gen (emit %loan ~ (flop lose) %hop then.zero) + =^ roan gen (emit %roan ~ (flop rose) %hop then.once) + [[i.salt loan roan] gen] + ?- -.i.tack + %& + ?> ?=(^ salt) + ?> ?=(^ t.salt) + $(tack t.tack, salt [[%both p.i.tack i.t.salt i.salt] t.t.salt]) + :: + %| + ?: ?=(%none -.z.p.i.tack) + :: z side has no requirements + :: so we should do no splitting outside conditional + ?: ?=(%none -.o.p.i.tack) + $(tack t.tack, salt [[%none ~] salt]) + =^ rr gen (kern rose o.p.i.tack) + =. rose pose.rr + $(tack t.tack, salt [[%this out.rr] salt]) + ?: ?=(%none -.o.p.i.tack) + :: o side has no requirements + :: so we should do no splitting outside conditional + =^ lr gen (kern lose z.p.i.tack) + =. lose pose.lr + $(tack t.tack, salt [[%this out.lr] salt]) + ?: ?=(%both -.z.p.i.tack) + :: z side splits + ?: ?=(%both -.o.p.i.tack) + :: both sides split, recursively build need + %= $ + tack + :* [%| left.z.p.i.tack left.o.p.i.tack] + [%| rite.z.p.i.tack rite.o.p.i.tack] + [%& sass.z.p.i.tack] + t.tack + == :: - %rift - =^ sift dock wean - =^ bars dock (mend %bars ~ %brn sift [troo fals]:flow) - =^ fens dock wean - =^ phat dock wean - =^ cope dock (mend %cope ~ %spy fens phat sift bars) - =^ [ham=plow pan=berm] dock - %= rive - fawn +>.fawn - axle (peg axle 7) - flow [%moat cope %tine phat] - == - =^ [hen=plow pen=berm] dock - %= rive - fawn +<.fawn - axle (peg axle 6) - flow [%moat pan %tine fens] - == - (copy ham hen pen) + rose [[%mov sass.z.p.i.tack sass.o.p.i.tack] rose] == + :: z side splits, o side this + =^ lr gen (kern ~ z.p.i.tack) + =. lose [[%mov sass.o.p.i.tack out.lr] lose] + =. lose (weld pose.lr lose) + $(tack t.tack, salt [o.p.i.tack salt]) + ?: ?=(%both -.o.p.i.tack) + :: z side this, o side splits + =^ rr gen (kern ~ o.p.i.tack) + =. rose [[%mov sass.z.p.i.tack out.rr] rose] + =. rose (weld pose.rr rose) + $(tack t.tack, salt [z.p.i.tack salt]) + :: both sides this + =. rose [[%mov sass.z.p.i.tack sass.o.p.i.tack] rose] + $(tack t.tack, salt [z.p.i.tack salt]) + == + :: + :: union needs + :: + :: generate a need split as far as either input need is split, + :: generating cons code for less-split need. This is used when two + :: sequential subformulas read from the same subject + :: + :: for correctness in crash handling it is vital that the needs are + :: ordered by the evaluation order of the computations, so that the + :: first need is from the first computation and the second need from + :: the second. + ++ copy + |= [feed=next seed=need] + =| pose=(list pole) + =/ tack=(list (each @uvre [l=need r=need])) [%| what.feed seed]~ + =| rack=(list need) + |- ^- [next _gen] + ?~ tack + ?> ?=(^ rack) + ?> ?=(~ t.rack) + =^ cody gen (emit %copy ~ pose %hop then.feed) + [[%next i.rack cody] gen] + ?: ?=(%& -.i.tack) + ?> ?=(^ rack) + ?> ?=(^ t.rack) + $(rack [[%both p.i.tack i.t.rack i.rack] t.t.rack], tack t.tack) + ?: ?=(%none -.l.p.i.tack) $(rack [r.p.i.tack rack], tack t.tack) + ?: ?=(%none -.r.p.i.tack) $(rack [l.p.i.tack rack], tack t.tack) + ?: ?=(%this -.l.p.i.tack) + ?: ?=(%this -.r.p.i.tack) + :: both this + =? pose ?! .= sass.l.p.i.tack sass.r.p.i.tack + [[%mov sass.l.p.i.tack sass.r.p.i.tack] pose] + $(rack [l.p.i.tack rack], tack t.tack) + :: left this, right both + :: + :: this case must be handled this way in case the code that needs + :: l.p.i.tack will crash explicitly in some way. + =^ rr gen (kern ~ r.p.i.tack) + =. pose (weld (flop pose.rr) pose) + =? pose ?!(=(sass.l.p.i.tack out.rr)) + [[%mov sass.l.p.i.tack out.rr] pose] + $(tack t.tack, rack [[%this sass.l.p.i.tack] rack]) + ?: ?=(%both -.r.p.i.tack) + :: both both + %= $ + pose [[%mov sass.l.p.i.tack sass.r.p.i.tack] pose] + tack + :* [%| left.l.p.i.tack left.r.p.i.tack] + [%| rite.l.p.i.tack rite.r.p.i.tack] + [%& sass.l.p.i.tack] + t.tack == - ++ tool :: codegen for calls - |= [flaw=(unit [rut=@ rot=berm]) sums=nomm form=nomm sunk=sock fork=(unit *) safe=?] - ^- [[plow berm] _dock] - ?~ fork - =^ lash dock wean - =^ frog dock wean - =^ coil dock - ?~ flaw - (mend %coil ~ [%lnt frog lash]) - (mend %coil ~ [%lnk frog lash u.flaw]) - =^ [bow=plow urn=berm] dock - rive(fawn sums, axle (peg axle 6), flow [%moat coil %tine lash]) - =^ [fog=plow sog=berm] dock - rive(fawn form, axle (peg axle 7), flow [%moat urn %tine frog]) - (copy fog bow sog) - =/ bale=barn [sunk u.fork] - =/ bore (~(get by land.burg) bale) - ?~ bore :: no registerization info yet - =^ lash dock wean - =^ dote dock - ?~ flaw - (mend %dote ~ [%eye bale lash]) - (mend %dote ~ [%bec bale lash rut.u.flaw rot.u.flaw]) - =^ [bow=plow urn=berm] dock - rive(fawn sums, axle (peg axle 6), flow [%mote dote %tine lash]) - ?: safe [[bow urn] dock] - =^ [fog=plow sog=berm] dock - rive(fawn form, axle (peg axle 7), flow [%moat urn %disc ~]) - (copy fog bow sog) - =^ uses dock (cool uses.does.u.bore) - =^ dote dock - ?~ flaw - (mend %dote ~ [%jmp bale (boil uses)]) - (mend %dote ~ [%cal bale (boil uses) rut.u.flaw rot.u.flaw]) - =^ [ash=plow dot=berm] dock (whop uses dote) - =^ [bow=plow urn=berm] dock - rive(fawn sums, axle (peg axle 6), flow [%moat dot ash]) - ?: safe [[bow urn] dock] - =^ [fog=plow sog=berm] dock - rive(fawn form, axle (peg axle 7), flow [%moat urn %disc ~]) - (copy fog bow sog) - ++ cool :: generate SSAs for the call side - |= use=(list [@ @ ?]) - ^- [(list [@ @ ?]) _dock] - ?~ use [~ dock] - =^ pan dock wean - =^ lid dock $(use t.use) - :_ dock - [[-.i.use pan +>.i.use] lid] - ++ boil :: SSAs from a use list - |= use=(list [@ @ ?]) - ^- (list @) - (turn use |=([@ ssa=@ ?] ssa)) - ++ whop :: turn a use list into a plow - |= [use=(list [@ @ ?]) her=berm] - ^- [[plow berm] _dock] - ?~ use [[*plow her] dock] - =^ [low=plow him=berm] dock $(use t.use) - =/ ace (take -.i.use [%tine +<.i.use] +>.i.use) - ?~ ace fail - (copy low u.ace him) - ++ bang :: distribute a constant among a plow - |= non=* - ^- [[hat=plow her=berm] _dock] - ?- -.flow - %pond - =^ ret dock wean - =^ her dock (mend %rime [[imm +.fawn ret]]~ %don ret) - :_ dock - [[%disc ~] her] - :: - %rift - ?: =(0 +.fawn) [[[%disc ~] troo.flow] dock] - ?: =(1 +.fawn) [[[%disc ~] fals.flow] dock] - fail :: XX ska should catch this - :: - %moat - =/ what what.flow - |^ - =/ mitt thud - ?~ mitt fail - =^ rock dock (mend %toil u.mitt [%hop wher.flow]) - :_ dock - [[%disc ~] rock] - ++ thud - ^- (unit (list bran)) - ?- -.what - %disc `~ - %tine `[[%imm non +.what ~]] - %fork - ?@ non - ?: safe.what - ~| %safe-axis-atom !! - ~ - %^ clef - thud(what left.what, non -.non) - thud(what rite.what, non +.non) - weld - == - -- + == + :: left both, right this + =/ lu (sass left.l.p.i.tack) + =/ ru (sass rite.l.p.i.tack) + =^ l gen ?~(lu rain [u.lu gen]) + =^ r gen ?~(ru rain [u.ru gen]) + %= $ + pose [[%con l r sass.r.p.i.tack] pose] + tack + :* [%| left.l.p.i.tack %this l] + [%| rite.l.p.i.tack %this r] + [%& sass.l.p.i.tack] + t.tack + == + == + :: + :: crash + :: + :: generate unconditional crashing code + ++ bomb + =^ b gen boom + [[%next [%none ~] b] gen] + :: + :: crash + :: + :: like +bomb, but return only the label and not the need + ++ boom + (emit %boom ~ ~ %bom ~) + :: + :: Defer crash + :: + :: Unconditionally poison the register. + :: + :: This used when a value is known to not match the expectation of a + :: need + ++ mine + |= [r=@uvre t=bile] + ^- [next _gen] + =^ mile gen (emit %mine ~ [%poi r]~ %hop t) + [[%next [%none ~] t] gen] + :: + :: create label + :: + :: emit a label with the given fixed name in the current context + ++ vial + |= t=@tas + [%bile fax t bell] + :: + :: label come-from + :: + :: emit an instruction which explicitly records the jump origin + :: useful for evaluating phi instructions in the jump destination + ++ come + |= [f=bile t=bile] + :- f + %= gen + will + %+ ~(put by will.gen) f + ^- blob [~ ~ %hip f t] + == + :: + :: emit phi node + :: + :: given a destination common to two branches, generate a phi node + :: and come-from blocks + ++ phil + |= =next + =/ tack=(list (each [zp=@uvre op=@uvre] need)) [%| what.next]~ + =| salt=(list [z=need o=need]) + =| biff=(map @uvre (map bile @uvre)) + =/ zb (vial %zebu) + =/ ob (vial %oboe) + |- ^- [[_next _next] _gen] + ?~ tack + ?> ?=(^ salt) + ?> ?=(~ t.salt) + =^ fill gen (emit %phil biff ~ %hop then.next) + =^ zeke gen (come zb fill) + =^ oaks gen (come ob fill) + [[[%next z.i.salt zeke] [%next o.i.salt oaks]] gen] + ?- -.i.tack + %& + ?> ?=(^ salt) + ?> ?=(^ t.salt) + %= $ + tack t.tack + salt + :_ t.t.salt + :- [%both zp.p.i.tack z.i.t.salt z.i.salt] + [%both op.p.i.tack o.i.t.salt o.i.salt] + == + :: + %| + ?- -.p.i.tack + %none $(salt [[[%none ~] %none ~] salt], tack t.tack) + %this + =^ l gen rain + =^ r gen rain + =/ phi (~(gas by *(map bile @uvre)) ~[[zb l] [ob r]]) + %= $ + biff (~(put by biff) sass.p.i.tack phi) + tack t.tack + salt [[[%this l] %this r] salt] == - ++ vert :: add entry points - |= [lout=plow tern=berm] - =^ [use=@ bull=berm] dock (peel lout tern) - :- use - %= dock - lake - %- ~(gas by lake.dock) - :~ - [(vent i.work) ~ %jmp tern] - [(dole i.work) ~ %jmp bull] + :: + %both + =^ hurl gen rain + =^ barf gen rain + =/ phi (~(gas by *(map bile @uvre)) ~[[zb hurl] [ob barf]]) + %= $ + biff (~(put by biff) sass.p.i.tack phi) + tack + :* [%| left.p.i.tack] + [%| rite.p.i.tack] + [%& hurl barf] + t.tack == - == - ++ cite :: enumerate regs - |= =plow - ^- (list @) - ?- -.plow - %tine [+.plow ~] - %disc ~ - %fork (weld $(plow left.plow) $(plow rite.plow)) == - ++ mend :: add a basic block - |= [gen=@ =lock] - ^- [berm _dock] - =/ curb (milk gen) - :- curb - dock(lake (~(put by lake.dock) curb lock)) - ++ milk :: local label - |= gen=@ - ^- berm - [sub.next for.next axle gen] - ++ wean :: fresh ssa - ^- [@ _dock] - [lamb.dock dock(lamb .+(lamb.dock))] - ++ peel :: split a define among a plow of uses - |= [mole=plow hill=berm] - ^- [[use=@ her=berm] _dock] - |^ - =^ [fine=(unit @) load=(list bran)] dock (pare mole) - ?~ fine - =^ crap dock wean - =^ her dock (mend %peel ~ %hop hill) - [[crap her] dock] - ?~ load - [[u.fine hill] dock] - =^ her dock (mend %peel load %hop hill) - [[u.fine her] dock] - ++ pare - |= mole=plow - ^- [[fine=(unit @) load=(list bran)] dock=_dock] - ?- -.mole - %tine [[`+.mole ~] dock] - %disc [[~ ~] dock] - %fork - =^ [file=(unit @) loaf=(list bran)] dock $(mole left.mole) - =^ [fire=(unit @) loaf=(list bran)] dock $(mole rite.mole) - ?~ file - ?~ fire - [[~ ~] dock] - [[fire road] dock] - ?~ fire - [[file loaf] dock] - =^ fell dock wean - :_ dock - :- `fell - ?: safe.mole - [[%hud fell u.file] [%tul fell u.fire] (weld loaf road)] - [[%hed fell u.file] [%al fell u.fire] (weld loaf road)] + == + == + :: + :: direct call information + :: + :: when we emit code for a direct call, we hope to know the + :: registerization already. If we don't, we need to add the call to + :: the redo set. If we do, then we need a linear list of poison + :: registers and a linear list of argument registers, as well as a + :: need which describes which parts of the call subject go in which + :: registers + ++ args + |= =_bell + ^- [[v=(list @uvre) n=need r=?] _gen] + =/ cn (~(get by like) bell) + =? cn ?=(~ cn) + =/ dn (~(get by hill) bell) + ?~ dn ~ + `want.u.dn + ?~ cn + =^ s gen rain + [[~[s] [%this s] &] gen] + =^ s gen (scar u.cn) + [[v n |]:s gen] + :: + :: generate fresh parameter lists + :: + :: generate fresh parameter variables and provide them both in + :: argument list and need form + ++ scar + |= n=need + =| rv=(list @uvre) + =/ tack=(list (each @uvre need)) [%| n]~ + =| salt=(list need) + |- ^- [[v=(list @uvre) n=need] _gen] + ?~ tack + ?> ?=(^ salt) + ?> ?=(~ t.salt) + [[(flop rv) i.salt] gen] + ?- -.i.tack + %& + ?> ?=(^ salt) + ?> ?=(^ t.salt) + $(tack t.tack, salt [[%both p.i.tack i.t.salt i.salt] t.t.salt]) + :: + %| + ?- -.p.i.tack + %both + =^ br gen rain + %= $ + tack + :* [%| left.p.i.tack] + [%| rite.p.i.tack] + [%& br] + t.tack + == == - ++ bomb :: crash - ^- [berm _dock] - (mend %boom ~ [%bom ~]) - ++ fail :: crash but yield destination - ^- [[hat=plow her=berm] dock=_dock] - =^ hole dock bomb - :_ dock - [[%disc ~] hole] - ++ tamp :: distribute same value to plows for branch - |= [hat=plow her=berm cat=plow cur=berm] - ^- [[mat=plow troo=berm fals=berm] _dock] - |^ - =^ [goo=plow mess=(list bran) stew=(list bran)] dock slop - =^ lamp dock (mend %lamp mess %jmp her) - =^ ramp dock (mend %ramp stew %jmp cur) - [[goo lamp ramp] dock] - ++ slop - ^- [[goo=plow mess=(list bran) stew=(list bran)] _dock] - ?- -.hat - %fork - ?- -.cat - %fork - =^ [loo=plow moss=(list bran) stow=(list bran)] dock - slop(hat left.hat, cat left.cat) - =^ [rue=plow ross=(list bran) thou=(list bran)] dock - slop(hat rite.hat, cat rite.cat) - :_ dock - [[%fork loo rue ?&(safe.hat safe.cat)] (weld moss ross) (weld stow thou)] - :: - %tine - =^ [fine=(unit @) load=(list bran)] dock (pare hat) - :_ dock - ?~ fine - [cat ~ ~] - [cat [[%mov +.cat u.fine] load] ~] - :: - %disc - ?: safe.hat - =^ [loo=plow moss=(list bran) stow=(list bran)] dock - slop(hat left.hat) - =^ [rue=plow ross=(list bran) thou=(list bran)] dock - slop(hat rite.hat) - :_ dock - [[%fork loo rue %.y] (weld moss ross) (weld stow thou)] - =^ [fine=(unit @) load=(list bran)] dock (pare cat) - :_ dock - ?~ fine - [[%disc ~] ~ ~] - [[%tine u.fine] load ~] - == - :: - %tine - ?- -.cat - %fork - =^ [fine=(unit @) load=(list bran)] dock (pare cat) - :_ dock - ?~ fine - [hat ~ ~] - [hat ~ [[%mov +.hat u.fine] load]] - :: - %disc - ?- -.cat - %fork - ?: safe.cat - =^ [loo=plow moss=(list bran) stow=(list bran)] dock - slop(cat left.cat) - =^ [rue=plow ross=(list bran) thou=(list bran)] dock - slop(cat rite.cat) - :_ dock - [[%fork loo rue %.y] (weld moss ross) (weld stow thou)] - =^ [fine=(unit @) load=(list bran)] dock (pare cat) - :_ dock - ?~ fine - [[%disc ~] ~ ~] - [[%tine u.fine] ~ load] - :: - %tine [[cat ~ ~] dock] - %disc [[[%disc ~] ~ ~] dock] - == + :: + %none $(tack t.tack, salt [[%none ~] salt]) + %this + =^ vr gen rain + $(rv [vr rv], salt [[%this vr] salt], tack t.tack) + == + == + :: need at axis + :: + :: push a need down by adding %both cases along the path described by + :: the axis. Used for nock 0 / %not. + ++ from + |= [axe=@ =next] + ?< =(0 axe) + =^ crap gen + =/ crop (sass what.next) + ?~ crop rain + [u.crop gen] + =? what.next ?=(%none -.what.next) [%this crap] + =| bait=(list [r=@uvre c=?(%2 %3)]) + |- ^- [_next _gen] + ?. =(1 axe) + =^ barf gen rain + $(bait [[barf (cap axe)] bait], axe (mas axe)) + =/ bits (turn bait |=([r=@uvre *] r)) + =^ fram gen (emit %fram ~ [%ipb ~[crap]]~ %hop then.next) + =/ feed + %+ roll bait + |= [[r=@uvre c=?(%2 %3)] n=_what.next] + ?- c + %2 [%both r n %none ~] + %3 [%both r [%none ~] n] + == + [[%next feed fram] gen] + :: + :: split need at axis + :: + :: split a need along an axis to describe an edit operation. + :: the first returned need is for the patch noun, and the second is + :: for the noun to be edited + ++ into + |= [axe=@ =next] + =* twig what.next + =| tres=(list [lr=?(%2 %3) p=@uvre =need]) + =| pose=(list pole) + ?< =(0 axe) + |- ^- [[need need bile] _gen] + ?. =(1 axe) + =^ p gen rain + ?- (cap axe) + %2 + ?- -.twig + %both + %= $ + tres [[%2 p rite.twig] tres] + twig left.twig + axe (mas axe) + pose [[%mov p sass.twig] pose] == - -- - ++ tear :: split a plow for an edit - |= [axe=@ bit=plow safe=? her=berm] - ^- [[out=plow inn=plow his=berm] _dock] - ?: =(0 axe) - =^ hole dock bomb - [[[%disc ~] [%disc ~] hole] dock] - |^ - =^ [out=plow inn=plow rind=(list bran)] dock gash - ?~ rind - :_ dock - [out inn her] - =^ him dock (mend %diet rind [%hop her]) - :_ dock - [out inn him] - ++ gash - ?: =(1 axe) - :_ dock - [[%disc ~] bit ~] - ?- -.bit - %disc - ?: safe [[[%disc ~] [%disc ~] ~] dock] - ?- (cap axe) - %2 - =^ ruck dock gash(axe (mas axe)) - :_ dock - [[%fork [%disc ~] out.ruck %.n] inn.ruck rind.ruck] - :: - %3 - =^ ruck dock gash(axe (mas axe)) - :_ dock - [[%fork [%disc ~] out.ruck %.n] inn.ruck rind.ruck] - == - :: - %tine - =^ tour dock wean - =^ plat dock wean - ?- (cap axe) - %2 - =^ ruck dock gash(axe (mas axe), bit [%tine plat]) - :_ dock - [[%fork out.ruck [%tine tour] safe] inn.ruck [[%con plat tour +.bit] rind.ruck]] - :: - %3 - =^ ruck dock gash(axe (mas axe), bit [%tine plat]) - :_ dock - [[%fork [%tine tour] out.ruck safe] inn.ruck [[%con tour plat +.bit] rind.ruck]] - == - :: - %fork - ?- (cap axe) - %2 - =^ ruck dock gash(axe (mas axe), bit left.bit) - :_ dock - [[%fork out.ruck rite.bit ?&(safe safe.bit)] inn.ruck rind.ruck] - :: - %3 - =^ ruck dock gash(axe (mas axe), bit rite.bit) - :_ dock - [[%fork left.bit out.ruck ?&(safe safe.bit)] inn.ruck rind.ruck] - == + :: + %this + =^ l gen rain + =^ r gen rain + %= $ + tres [[%2 p %this r] tres] + twig [%this l] + axe (mas axe) + pose [[%con l r sass.twig] pose] == - ++ copy :: distribute same value to 2 plows - |= [hat=plow bat=plow her=berm] - ^- [[hat=plow her=berm] _dock] - |^ - =^ [tog=plow moot=(list bran)] dock echo - =^ his dock (mend %copy moot %hop her) - :_ dock - [tog blab] - ++ echo - ^- [[tog=plow moot=(list bran)] _dock] - ?: ?=([%disc ~] hat) [[bat ~] dock] - ?: ?=([%disc ~] bat) [[hat ~] dock] - ?- -.hat - %tine - ?- -.bat - %tine - ?: =(+.hat +.bat) - [[hat ~] dock] - [[hat [[%mov +.hat +.bat]]~] dock] - :: - %fork - =^ one dock wean - =^ two dock wean - =^ [hog=plow hoot=(list bran)] dock - echo(hat [%tine one], bat left.bat) - =^ [hog=plow hoot=(list bran)] dock - echo(hat [%tine two], bat rite.bat) - :_ dock - :- [%fork hog log safe.bat] - [[%con one two +.hat] (weld hoot loot)] - == - :: - %fork - ?- -.bat - %tine - =^ one dock wean - =^ two dock wean - =^ [hog=plow hoot=list bran)] dock - echo(hat left.hat, bat [%tine one]) - =^ [log=plow loot=(list bran)] - echo(hat rite.hat, bat [%tine two]) - :_ dock - [[%fork hog log safe.hat] [%con one two +.bat] (weld hoot loot)] - :: - %fork - =^ [hog=plow hoot=(list bran)] dock - echo(hat left.hat, bat left.bat) - =^ [log=plow loot=(list bran)] dock - echo(hat rite.hat, bat rite.bat) - :_ dock - [[%fork hog log ?&(safe.hat safe.bat)] (weld hoot loot)] - == + :: + %none + %= $ + tres [[%2 p %none ~] tres] + axe (mas axe) + == + == + :: + %3 + ?- -.twig + %both + %= $ + tres [[%3 p left.twig] tres] + twig rite.twig + axe (mas axe) + pose [[%mov p sass.twig] pose] == - -- - ++ twin :: split a plow to receive a cell - ^- [[plow plow berm] _dock] - ?- -.flow - %rift - =^ hole dock bomb - :_ dock - [[%disc ~] [%disc ~] hole] :: - %pond - =^ one dock wean - =^ two dock wean - =^ ret dock wean - =^ her dock (mend %taco [[%con one two ret]]~ [%don ret]) - :_ dock - [[%tine one] [%tine two] her] + %this + =^ l gen rain + =^ r gen rain + %= $ + tres [[%3 p %this l] tres] + twig [%this r] + axe (mas axe) + pose [[%con l r sass.twig] pose] + == :: - %moat - ?- -.what.flow - %fork - :_ dock - [left.what.flow rite.what.flow wher.flow] - :: - %disc - :_ dock - [[%disc ~] [%disc ~] wher.flow] - :: - %tine - =^ one dock wean - =^ two dock wean - =^ her dock - (mend %cons [[%con one two +.what.flow]]~ [%hop wher.flow]) - :_ dock - [[%tine one] [%tine two] her] + %none + %= $ + tres [[%3 p %none ~] tres] + axe (mas axe) == == - ++ take :: push a plow down by an axis - |= [sax=@ tow=plow row=?] - ^- (unit plow) :: null for crash - ?: =(0 sax) ~ - %- some - |- ^- plow - ?: =(1 sax) tow - ?- (cap sax) - %2 [%fork $(sax (mas sax)) [%disc ~] row] - %3 [%fork [%disc ~] $(sax (mas sax)) row] - == - -- - -- - ++ plot :: subject knowledge analysis, emitting nock-- or "nomm" - =* this . - =| ski=farm - |= ent=barn - ^- [boot farm] - =/ bot (~(get by land.burg) ent) - ?. ?=(~ bot) [says.u.bot ski] :: no need to re-plot a barn - =/ ext (~(get by yard.ski) ent) - ?. ?=(~ ext) [says.u.ext ski] - =; [res=[does=nomm says=boot:ska] sku=farm] - [says.res sku(yard (~(put by yard.sku) ent res), wood [ent wood.sku])] - =. ski :: blackhole to guard recursion - =% ski - yard - (~(put by yard.ski) ent [[%zer 0 %.n] [%risk %toss ~]])) - |- ^- [[does=nomm says=boot:ska] farm] - =< - ?+ for.ent bomb - [[* *] *] - =^ [doth=nomm sath=boot:ska] ski $(for.ent -.for.ent) - ?: ?=([%boom ~] sath) bomb - =^ [toes=nomm tays=boot:ska] ski $(for.ent +.for.ent) - ?: ?=([%boom ~] tays) bomb - :_ ski - :_ (cobb:ska sath tays) - [%par doth toes] + == + =^ flag gen rain + =/ tree=need [%this flag] + |- ^- [[need need bile] _gen] + ?~ tres + =^ tint gen (emit %into ~ [[%ipb ~[flag]] pose] %hop then.next) + [[twig tree tint] gen] + ?- lr.i.tres + %2 + $(tres t.tres, tree [%both p.i.tres tree need.i.tres]) :: - [%0 @] - :: we can decompose the axis into two axes, a safe axis which can - :: be implemented unchecked, and an unsafe axis which must be - :: checked. We then compose these two axes into safe %zer and - :: unsafe %zer composed by %sev - =+ [saf rik ken]=(punt:ska +.for.ent sub.ent) - ?: =(0 saf) bomb - :_ ski - ?: =(1 rik) [[%zer saf %.y] [%safe ken]] - ?: =(1 saf) [[%zer rik %.n] [%risk ken]] - :_ [%risk ken] - [%sev [%zer saf %.y] [%zer rik %.n]] - :: - [%1 *] - :_ ski - :_ [%safe %know +.for.ent] - [%one +.for.ent] + %3 + $(tres t.tres, tree [%both p.i.tres need.i.tres tree]) + == + :: + :: split immediate + :: + :: given a noun and a need, generate instructions to emit that noun + :: into the registers of that need + ++ mede + |= [=bile n=* =need] + =| todo=(list pole) + =/ tack=(list [n=(unit *) =_need]) [`n need]~ + |- ^- [_bile _gen] + ?~ tack + (emit %mede ~ todo %hop bile) + ?- -.need.i.tack + %none $(tack t.tack) + %this + ?~ n.i.tack + $(todo [[%poi sass.need.i.tack] todo], tack t.tack) + $(todo [[%imm u.n.i.tack sass.need.i.tack] todo], tack t.tack) + :: + %both + ?~ n.i.tack + $(tack [[~ rite.need.i.tack] [~ left.need.i.tack] t.tack]) + ?@ u.n.i.tack + $(tack [[~ rite.need.i.tack] [~ left.need.i.tack] t.tack]) + $(tack [[`+.u.n.i.tack rite.need.i.tack] [`-.u.n.i.tack left.need.i.tack] t.tack]) + == + -- +:: +:: lists of registers from a need +:: +:: the second list (walt) is the input registers in left-to-right order +++ sill + |= want=need + =| wart=(list @uvre) + =/ tack=(list need) ~[want] + |- ^- (list @uvre) + ?~ tack wart + ?- -.i.tack + %none $(tack t.tack) + %both + %= $ + tack [rite.i.tack left.i.tack t.tack] + == + :: + %this + %= $ + wart [sass.i.tack wart] + tack t.tack + == + == +:: +:: loop over redos +:: +:: run redo:jean on each arm in the redo list, which will generate +:: code to properly registerize callsites whose registerization was +:: deferred, without changing the registerization of the calling arm +++ mill + =| todo=(list [=bell dire=next =gen]) + =| like=(map bell need) + =/ toil work + =/ wurk toil + |- ^- _hill + ?^ toil + =/ [dire=next =gen] ~(cuts jean i.toil *gen like) + %= $ + toil t.toil + todo [[i.toil dire gen] todo] + like (~(put by like) i.toil what.dire) + == + |- ^- _hill + ?^ todo + =/ r redo.gen.i.todo + |- ^- _hill + ?^ r + =. gen.i.todo + ~| =* bel bell.i.todo + =/ mot (~(get ja moan) form.bel) + |- ^- ?(%redo-fail ~) + ?~ mot ~ + ?: =(soot.i.mot text.bel) + ((outa:blot:sack "redo fail: " `@`0 [seat area]:norm.i.mot) %redo-fail) + $(mot t.mot) + (~(redo jean bell.i.todo gen.i.todo like) i.r) + $(r t.r) + =^ [wish=bile sire=@uvre] gen.i.todo (~(kerf jean bell.i.todo gen.i.todo like) %indy dire.i.todo) + ?. (~(has by will.gen.i.todo) wish) ~& %missing-wish !! + %= ^$ + hill + =/ walt (sill what.dire.i.todo) + %+ ~(put by hill) bell.i.todo + [then.dire.i.todo what.dire.i.todo walt wish sire [will sans]:gen.i.todo] :: - [%2 * *] - =^ [dost=nomm sass=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] sass) bomb - =^ [doff=nomm faff=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] faff) bomb - =/ skun - ?- sass - [%safe *] sure.sass - [%risk *] hope.sass - == - ?: ?=([%safe %know *] faff) - =^ ret ski ^$(ent [skun know.sure.faff]) - :_ ski - :_ ?: ?=([%safe *] sass) ret (dare:ska ret) - [%two dost doff skun (some know.sure.faff) %.y] - ?: ?=([%risk %know *] faff) - =^ ret ski ^$(ent [skun know.hope.faff]) - :_ ski - :_ (dare:ska ret) - [%two dost doff skun (some know.hope.faff) %.n] - :_ ski - :_ [%risk %toss ~] - [%two dost doff skun ~ %.n] + todo t.todo + == + :: XX temporary: turn hip/phi into mov so we can run this as-is + :: note that it's not safe to do mov coalescing on the output of this + :: since we may now have multiple %mov's that target one register + =/ toil wurk + |- ^- _hill + ?~ toil + hill + %= $ + toil t.toil + :: + hill + %+ ~(jab by hill) i.toil + |= =pile + =/ seen (~(gas in *(set bile)) ~[long wish]:pile) + =/ queu=(list bile) ~(tap in seen) + =| back=(list bile) + =| will=(map bile blob) + !. + |- ^+ pile + ?~ queu + ?~ back pile(will will) + $(queu (flop back), back ~) + =/ blob (~(got by will.pile) i.queu) + =^ more=(list bile) blob + ?- -.bend.blob + %hip + :- ~[t.bend.blob] + =/ movs + %- ~(rep by biff:(~(got by will.pile) t.bend.blob)) + |= [[out=@uvre bin=(map bile @uvre)] lit=(list pole)] + [[%mov (~(got by bin) c.bend.blob) out] lit] + [biff.blob (welp body.blob movs) %hop t.bend.blob] :: XX flop? + :: + %clq [~[z o]:bend.blob blob] + %eqq [~[z o]:bend.blob blob] + %brn [~[z o]:bend.blob blob] + %hop [~[t.bend.blob] blob] + %lnk [~[t.bend.blob] blob] + %cal [~[t.bend.blob] blob] + %caf [~[t.bend.blob] blob] + %lnt `blob + %jmp `blob + %jmf `blob + %spy [~[t.bend.blob] blob] + %mer [~[i m]:bend.blob blob] + %don `blob + %bom `blob + == + |- ^+ pile + ?~ more + ^$(queu t.queu, will (~(put by will) i.queu blob)) + ?: (~(has in seen) i.more) + $(more t.more) + $(more t.more, back [i.more back], seen (~(put in seen) i.more)) + + == +-- +:: codegen interface +=+ %1 +|% +:: +:: core reference +++ this . +:: +:: look for code +:: +:: check if code exists for a given subject and formula +:: XX should optionally return a path to be checked against hot state, +:: to invoke jets on indirect +++ peek + |= [s=* f=*] + ^- (unit [=bell hall=_hill]) + =/ moat (~(get ja moan) f) + |- + ?~ moat ~ + ?. (~(huge so:sack soot.i.moat) [& s]) + $(moat t.moat) + ?. (~(has by hill) [soot.i.moat f]) + ~& %not-in-hill !! + `[[soot.i.moat f] hill] +:: +:: core state interface +:: [%comp ...]: generate code for given subject/formula pair +++ poke + |= =gist + ~> %bout + ^- [new=(set bell) old=(set bell) =_this] + :: %comp is the only case + :: analyze + =. sack + ~> %bout.[0 %sack] + (rout:sack s.gist f.gist) + ?< =(~ moan) + :: save old codegen table keys + =/ hole ~(key by hill) + :: codegen + =. hill mill + :: get entry label for new codegen + =/ bell + =/ peep (peek [s f]:gist) + ?> ?=(^ peep) + bell.u.peep + =/ heck ~(key by hill) + [(~(dif in heck) hole) (~(dif in hole) heck) this] +:: pretty-printing door +++ xray + |_ will=(map bile blob) + :: + :: print a bell as an @ux-ed mug + ++ ring + |= a=bell + ^- tank + >`@ux`(mug a)< + :: + :: print a bell as an @ux-ed mug + formula + ++ rang + |= a=bell + ^- tank + [%rose ["-" "" ""] (ring a) >form.a< ~] + :: + :: print a bile as thus and axe + a pretty bell + ++ rung + |= b=bile + ^- tank + [%rose ["." "[" "]"] >thus.b< >axe.b< (ring +>+.b) ~] + :: + :: print a register + ++ near + |= r=@uvre + ^- tank + [%leaf 'r' (a-co:co r)] + :: + :: instruction print helper + ++ pink + |= [t=@tas l=(list tank)] + ^- tank + [%palm [" " "" "" ""] [%leaf (trip t)] l] + :: + :: print a dataflow instruction + ++ ping + |= i=pole + ?- -.i + %imm + (pink -.i >n.i< (near d.i) ~) :: - [%3 *] - =^ [deft=nomm koob=boot:ska] ski $(for.ent +.for.ent) - ?: ?=([%boom ~] koob) bomb - :_ ski - :_ (ques:ska koob) - [%thr deft] + %mov + (pink -.i (near s.i) (near d.i) ~) :: - [%4 *] - =^ [dink=nomm sink=boot:ska] ski $(for.ent +.for.ent) - ?: ?=([%boom ~] sink) bomb - =/ rink - ?- sink - [%safe *] sure.sink - [%risk *] hope.sink - == - :_ ski - :_ (pile:ska sink) - [%fou dink ?|(?=([%dice ~] rink) ?=([%flip ~] rink) ?=([%know @] rink))] + %inc + (pink -.i (near s.i) (near d.i) ~) :: - [%5 * *] - =^ [dome=nomm foam=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] foam) bomb - =^ [doot=nomm foot=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] foot) bomb - :_ ski - :_ (bopp:ska foam foot) - [%fiv dome doot] + %con + (pink -.i (near h.i) (near t.i) (near d.i) ~) :: - [%6 * * *] - =^ [dawn=nomm sond=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%safe %know %0] sond) $(for.ent +>-.for.ent) - ?: ?=([%safe %know %1] sond) $(for.ent +>+.for.ent) - ?: ?=([%safe %know *] sond) bomb - ?: ?=([%safe %bets *] sond) bomb - ?: ?=([%safe %flip ~] sond) - =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent) - =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent) - :_ ski - :_ (gnaw:ska slew song) - [%six dawn drew darn] - ?: ?=([%risk %know %0] sond) - =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent) - :_ ski - :_ (dare:ska slew) - :: run dawn in case it crashes, but throw it away - [%sev [%par dawn drew] [%zer 3 %.y]] - ?: ?=([%risk %know %1] sond) - =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent) - :_ ski - :_ (dare:ska song) - :: run dawn in case it crashes, but throw it away - [%sev [%par dawn darn] [%zer 3 %.y]] - ?: ?=([%risk %know *] sond) bomb - ?: ?=([%risk %bets *] sond) bomb - =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent) - =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent) - :_ ski - :_ (dare:ska (gnaw:ska slew song)) - [%six dawn drew darn] + %hed + (pink -.i (near s.i) (near d.i) ~) :: - [%7 * *] - =^ [deck=nomm keck=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] keck) bomb - =/ news - ?- keck - [%safe *] sure.keck - [%risk *] hope.keck - == - =^ [dest=nomm zest=boot:ska] ski $(sub.ent news, for.ent +>.for.ent) - ?: ?=([%boom ~] zest) bomb - :_ ski - :_ ?: ?=([%safe *] keck) zest (dare:ska zest) - [%sev deck dest] + %tal + (pink -.i (near s.i) (near d.i) ~) :: - [%8 * *] - =^ [pink=nomm pest=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] pest) bomb - =/ nest - ?- pest - [%safe *] sure.pest - [%risk *] hope.pest - == - =^ [dest=nomm zest=boot:ska] ski - $(sub.ent (knit:ska nest sub.ent), for.ent +>.for.ent) - ?: ?=([%boom ~] zest) bomb - :_ ski - :_ ?: ?=([%safe *] pest) - zest - (dare:ska zest) - [%sev [%par pink %zer 1 %.y] dest] + %men + (pink -.i [%leaf (trip l.i)] (near s.i) ~) :: - [%9 @ *] - =^ [lore=nomm sore=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] sore) bomb - =/ news - ?- sore - [%safe *] sure.sore - [%risk *] hope.sore - == - =/ fork (pull:ska +<.for.ent news) - ?: ?=([%safe %know *] fork) - =^ ret ski ^$(ent [news know.sure.fork]) - :_ ski - :_ ?: ?=([%safe *] sore) - ret - (dare:ska ret) - [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent %.y] news (some know.sure.fork) %.y]] - ?: ?=([%risk %know *] fork) - =^ ret ski ^$(ent [news know.hope.fork]) - :_ ski - :_ (dare:ska ret) - [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent %.n] news (some know.hope.fork) %.n]] - :_ ski - :_ [%risk %toss ~] - [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent ?=(%safe -.fork)] news ~ ?=(%safe -.fork)]] + %man + (pink -.i ~) :: - [%10 [@ *] *] - =^ [neat=nomm seat=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] seat) bomb - =^ [pace=nomm spat=boot:ska] ski $(for.ent +<+.for.ent) - ?: ?=([%boom ~] spat) bomb - =/ teak - ?- seat - [%safe *] sure.seat - [%risk *] hope.seat - == - =+ [saf rik ken]=(punt:ska +<-.for.ent teak) - ?: =(0 saf) bomb - :_ ski - :_ (welt:ska +<-.for.ent spat seat) - ?: =(1 rik) - [%ten [+<-.for.ent pace] neat %.y] - ^- nomm - :+ %sev [%par neat pace] - :+ %ten - [saf %ten [rik %zer 3 %.n] [%zer (peg saf 2) %.y] %.y] - [[%zer 2 %.y] %.y] + %hit + (pink -.i (near s.i) ~) + :: + %slg + (pink -.i (near s.i) ~) + :: + %mew + (pink -.i (near k.i) (near u.i) (near f.i) (near r.i) ~) + :: + %tim + (pink -.i ~) + :: + %tom + (pink -.i ~) + :: + %mem + (pink -.i ~) + :: + %poi + (pink -.i (near p.i) ~) :: - [%11 @ *] - =^ [real=nomm seal=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] seal) bomb - ^- [[does=nomm says=boot:ska] farm] - [[[%els +<.for.ent real] seal] ski] + %ipb + (pink -.i (turn p.i near)) :: - [%11 [@ *] *] - =^ [fake=nomm sake=boot:ska] ski $(for.ent +<+.for.ent) - ?: ?=([%boom ~] sake) bomb - =^ [real=nomm seal=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] seal) bomb - :_ ski - ?: ?=([%safe *] sake) - [[%eld [+<-.for.ent fake] real %.y] seal] - [[%eld [+<-.for.ent fake] real %.n] seal] + %slo + ~| %todo !! :: - [%12 * *] - =^ [fear=nomm sear=boot:ska] ski $(for.ent +<.for.ent) - ?: ?=([%boom ~] sear) bomb - =^ [pack=nomm sack=boot:ska] ski $(for.ent +>.for.ent) - ?: ?=([%boom ~] sack) bomb - :_ ski - :_ [%risk %toss ~] - [%twe fear pack] + %sld + ~| %todo !! == - |% - ++ bomb - ^- [[nomm boot:ska] farm] - [[[%zer 0 %.n] [%boom ~]] ski] - -- - ++ rake - |= work=(list barn) - ^- _this - ?~ work this - =+ (~(got by land.burg) i.work) - =/ ewes [(vent i.work) ~] - =/ bred (set berm) - =| sire - (map @ $%([%imm *] [%con @ @] [%hed @] [%tal @] [%mov @])) - |^ - %= ^$ - burg cure - work t.work + :: + :: print a control flow instruction + ++ pine + |= i=site + ^- tank + ?- -.i + %clq + (pink -.i (near s.i) (rung z.i) (rung o.i) ~) + :: + %eqq + (pink -.i (near l.i) (near r.i) (rung z.i) (rung o.i) ~) + :: + %brn + (pink -.i (near s.i) (rung z.i) (rung o.i) ~) + :: + %hop + (pink -.i (rung t.i) ~) + :: + %hip + (pink -.i (rung c.i) (rung t.i) ~) + :: + %lnk + (pink -.i (near u.i) (near f.i) (near d.i) (rung t.i) ~) + :: + %cal + (pink -.i (ring a.i) [%rose ["," "[" "]"] (turn v.i near)] (near d.i) (rung t.i) ~) + :: + %caf + (pink -.i (ring a.i) [%rose ["," "[" "]"] (turn v.i near)] (near d.i) (rung t.i) (near u.i) >n.i< ~) + :: + %lnt + (pink -.i (near u.i) (near f.i) ~) + :: + %jmp + (pink -.i (ring a.i) [%rose ["," "[" "]"] (turn v.i near)] ~) + :: + %jmf + (pink -.i (ring a.i) [%rose ["," "[" "]"] (turn v.i near)] (near u.i) >n.i< ~) + :: + %spy + (pink -.i (near e.i) (near p.i) (near d.i) (rung t.i) ~) + :: + %mer + (pink -.i (near k.i) (near u.i) (near f.i) (near d.i) (rung i.i) (rung m.i) ~) + :: + %don + (pink -.i (near s.i) ~) + :: + %bom + (pink -.i ~) + == + :: + :: print a basic block + ++ plop + |= =blob + ^- tank + [%rose [";" "" ""] (snoc (turn body.blob ping) (pine bend.blob))] + :: + :: topo-sort code in execution order, from an entry point + ++ sore + |= tart=bile + =/ queu=(list bile) ~[tart] + =| back=(list bile) + =| code=(list [bile blob]) + =| done=(set bile) + |- ^- (list [bile blob]) + ?~ queu + ?~ back + (flop code) + $(queu (flop back), back ~) + ?: (~(has in done) i.queu) + $(queu t.queu) + =/ blub (~(got by will) i.queu) + =/ ouch=(list bile) + ?- -.bend.blub + %clq ~[z o]:bend.blub + %eqq ~[z o]:bend.blub + %brn ~[z o]:bend.blub + %hop ~[t]:bend.blub + %hip ~[t]:bend.blub + %lnk ~[t]:bend.blub + %cal ~[t]:bend.blub + %caf ~[t]:bend.blub + %lnt ~ + %jmp ~ + %jmf ~ + %spy ~[t]:bend.blub + %mer ~[i m]:bend.blub + %don ~ + %bom ~ == - ++ cure - ?~ ewes burg - :: XX ewes is a queue of berms, which is populated - :: by control flow instructions. We keep sire which describes - :: the genealogy of SSA variables, so we can decompose them - :: if necessary. - - + %= $ + queu t.queu + back (weld ouch back) + code [[i.queu blub] code] + done (~(put in done) i.queu) + == + :: + :: print the whole code for this arm + ++ parm + |= tart=bile + ^- tank + :* %rose [" " "" ""] + (rang bell.tart) + %+ turn (sore tart) + |= [l=bile b=blob] + [%palm ["" "" "->" ""] (rung l) (plop b) ~] + == + :: + :: print register value assignments + ++ vals + |= v=(map @uvre *) + ^- tank + :* %rose [" " "" ""] + %+ turn ~(tap by v) + |= [r=@uvre n=*] + [%palm ["=" "" "" ""] (near r) >n< ~] + == + :: + :: print value assigned to register + ++ gals + |= [x=@uvre v=(map @uvre *)] + ^- tank + [%palm ["<--" "" "" ""] (near x) (vals v) ~] -- -++ vent :: entry label - |=(barn [sub for 1 %vent]) -++ dole :: entry label with subject in single register - |=(barn [sub for 1 %dole]) +:: +:: print code for an arm, if it exists +++ rake + |= [s=* f=*] + ^- tank + =/ a (peek s f) + ?~ a [%leaf "no code generated for arm"] + =/ pile (~(got by hall.u.a) bell.u.a) + (~(parm xray will.pile) wish.pile) +:: +:: debug-print code for an arm, if it exists +++ rack + |= [s=* f=*] + ^- ~ + ((slog (rake s f) ~) ~) -- diff --git a/hoon/codegen/lib/sack.hoon b/hoon/codegen/lib/sack.hoon new file mode 100644 index 00000000..cb944b10 --- /dev/null +++ b/hoon/codegen/lib/sack.hoon @@ -0,0 +1,809 @@ +:: finished code table +:: +:: entries describe input and output knowledge +:: and analyzed code. +:: Key to the jar is a formula. +:: Call labels are the key formula and the soot face of each entry +=| moan=(jar * hone) :: finished code table +:: cold state +:: +:: see $cool in sur/noir/hoon +=| cole=cool :: cold state +|% +:: +:: core reference +++ thus . +:: +:: trace a label, building up a set of labels it depends on +++ keep + |= [live=(set [sock *]) seed=[sock *]] + =/ work=(list [=sock f=*]) ~[seed] + =| krow=(list [=sock f=*]) + |- ^- _live + ?~ work + ?~ krow live + $(work (flop krow), krow ~) + ?: (~(has in live) i.work) $(work t.work) + =/ hose (~(get ja moan) f.i.work) + |- ^- _live + ?~ hose ~| %keep-wiff !! + ?. (~(huge so soot.i.hose) sock.i.work) $(hose t.hose) + =/ next ~(val by ices.norm.i.hose) + ^$(live (~(put in live) i.work), krow (weld next krow), work t.work) +:: +:: drop labels not in the given live set +:: +:: To build the live set, repeatedly invoke +keep, threading through +:: the live set, and passing labels which will still be needed. This +:: will ensure that transitive dependencies remain in +moan. +++ drop + |= live=(set [sock *]) + =| noam=(jar * hone) + =/ moal=(list [* (list hone)]) ~(tap by moan) + |- ^- _thus + ?~ moal thus(moan noam) + |- ^- _thus + ?~ +.i.moal ^$(moal t.moal) + =/ bell [soot.i.+.i.moal -.i.moal] + ?. (~(has in live) bell) $(+.i.moal t.+.i.moal) + $(+.i.moal t.+.i.moal, noam (~(add ja noam) -.i.moal i.+.i.moal)) +:: +:: outer work loop +:: +:: analyze nock and subject and emit %nomm. +:: Usually the sock will simply be [%.y ] for an indirect +:: call or outer runtime invocation +++ rout + |= [soot=sock form=*] + ^- _thus + =/ moot :: in progress code table + %+ ~(put by *(map @hail toot)) `@hail`1 + :* soot | + `form ~ + [| ~] | ~ + == + =| mind=(map @hail hind) + =/ work=(list @hail) ~[`@hail`1] + =/ mite (~(put in *(set @hail)) `@hail`1) + =| kids=(jug @hail @hail) + |^ ^- _thus + => raid + => loot + => espy + => ruin + ?~(work thus $) + :: + :: inner core reference + ++ this . + :: lower to nomm + :: + :: - translate syntactic crashes to [%not 0] + :: - translate [8 b c] to (nomm of) [7 [b 0 1] c] + :: - translate [9 b c] to (nomm of) [7 c 2 [0 1] 0 c] + :: - label 2 and 11 with formula axes for decoration + ++ raid + =/ cork work + |- ^- _this + ?~ cork this + =* hail i.cork + =/ firm form:(~(got by moot) hail) + ?> ?=(^ firm) + =* form u.firm + =; code + %= $ + moot + %+ ~(jab by moot) hail + |= =toot + toot(norm `code) + :: + cork t.cork + == + |- ^- nomm + ?+ form [%not 0] :: invalid nock crashes + [^ *] + [%par $(form -.form, hail (peg hail 2)) $(form +.form, hail (peg hail 3))] + :: + [%0 axe=@] + [%not axe.form] + :: + [%1 non=*] + [%one non.form] + :: + [%2 sofa=* fora=*] + :* %two + :: we treat the cell [sofa fora] as axis 6 and the + :: hypothetically inlined called formula as axis 7 + :: so the hypothetical inlining looks like + :: [%2 [sofa fora] ] + $(form sofa.form, hail (peg hail 12)) + $(form fora.form, hail (peg hail 13)) + hail + == + :: + [%3 coat=*] + [%the $(form coat.form, hail (peg hail 3))] + :: + [%4 tome=*] + [%for $(form tome.form, hail (peg hail 3))] + :: + [%5 this=* that=*] + :* %ivy + $(form this.form, hail (peg hail 6)) + $(form that.form, hail (peg hail 7)) + == + :: + [%6 what=* then=* else=*] + :* %six + $(form what.form, hail (peg hail 6)) + $(form then.form, hail (peg hail 14)) + $(form else.form, hail (peg hail 15)) + == + :: + [%7 once=* then=*] + :* %eve + $(form once.form, hail (peg hail 6)) + $(form then.form, hail (peg hail 7)) + == + :: + [%8 pint=* then=*] + $(form [%7 [pint.form [%0 1]] then.form]) + :: + [%9 here=@ coil=*] + $(form [%7 coil.form [%2 [%0 1] [%0 here.form]]]) + :: + [%10 [here=@ twig=*] tree=*] + :* %ten + here.form + $(form twig.form, hail (peg hail 13)) + $(form tree.form, hail (peg hail 7)) + == + :: + [%11 hint=@ then=*] + [%sip hint.form $(form then.form, hail (peg hail 7))] + :: + [%11 [hint=@ vice=*] then=*] + :* %tip + hint.form + $(form vice.form, hail (peg hail 13)) + $(form then.form, hail (peg hail 7)) + hail + == + :: + [%12 rent=* walk=*] + :* %elf + $(form rent.form, hail (peg hail 6)) + $(form walk.form, hail (peg hail 7)) + == + == + :: battery masks + :: + :: given the current set of known formulas, + :: discover a mask of which axes in each callsite subject are + :: actually used to fix which formulas are evaluated + ++ espy + =/ cork work + |- ^- _this + ?~ cork this + =* hail i.cork + =/ [norm=(unit nomm) rake=cape] + [norm rake]:(~(got by moot) hail) + ?> ?=(^ norm) + =* code u.norm + =^ soon moot + |- ^- [cape _moot] + ?- -.code + %par + =/ [lack=cape rack=cape] ~(rip ca rake) + =^ lead moot $(code left.code, rake lack) + =^ reed moot $(code rite.code, rake rack) + [(~(uni ca lead) reed) moot] + :: + %not + ?: =(0 here.code) [| moot] + [(~(pat ca rake) here.code) moot] + :: + %one [| moot] + %two + =/ [soot=sock fake=cape form=(unit) norm=(unit nomm)] + [soot rake form norm]:(~(got by moot) rail.code) + =/ mole=(list hone) ?~(form ~ (~(get ja moan) u.form)) + |- ^- [cape _moot] + ?^ mole + ?: ?& (~(huge so soot.i.mole) soot) + !(~(big ca cape.root.i.mole) rake) + == + [cape.soot.i.mole moot] + $(mole t.mole) + =. moot + %+ ~(jab by moot) rail.code + |= =toot + toot(rake rake) + =? moot ?&(?=(^ norm) (~(big ca fake) rake)) + +:^$(hail rail.code, code u.norm, rake rake) + =/ lake sake:(~(got by moot) rail.code) + =^ sake moot ^$(rake lake, code cost.code) + =^ folk moot ^$(rake &, code corn.code) + [(~(uni ca sake) folk) moot] + :: + %the + $(code pell.code, rake |) + :: + %for + $(code mall.code, rake |) + :: + %ivy + =^ lake moot $(code this.code, rake |) + =^ rare moot $(code that.code, rake |) + [(~(uni ca lake) rare) moot] + :: + %six + =^ cake moot $(code what.code, rake |) + =^ lake moot $(code then.code) + =^ rare moot $(code else.code) + [(~(uni ca cake) (~(uni ca lake) rare)) moot] + :: + %eve + =^ rare moot $(code then.code) + $(code once.code, rake rare) + :: + %ten + ?: =(0 here.code) [| moot] + =/ [wipe=cape wine=cape] (~(awl ca rake) here.code) + =^ lake moot $(code twig.code, rake wipe) + =^ rare moot $(code tree.code, rake wine) + [(~(uni ca lake) rare) moot] + :: + %sip + $(code then.code) + :: + %tip + ?: =(hint.code %slow) [| moot] + =? rake =(hint.code %fast) + =/ kind (~(got by mind) rail.code) + ?> ?=([%fast *] kind) + ?~ tire.kind | + cape.bats.u.tire.kind + =^ lake moot $(code vice.code, rake |) + =^ rare moot $(code then.code) + [(~(uni ca lake) rare) moot] + :: + %elf + =^ lake moot $(code rent.code, rake |) + =^ rare moot $(code walk.code, rake |) + [(~(uni ca lake) rare) moot] + == + =. moot + %+ ~(jab by moot) hail + |=(=toot toot(sake soon)) + $(cork t.cork) + :: propagate subject knowledge forward + :: + :: propagate knowledge from where it is known to new callsites, + :: possibly discovering new formulas at previously indirect + :: callsites. + ++ loot + =/ cork work + |- ^- _this + ?~ cork this + =* hail i.cork + =/ [norm=(unit nomm) soot=sock root=sock rake=cape sire=(unit @hail)] + [norm soot root rake sire]:(~(got by moot) hail) + ?> ?=(^ norm) + =* code u.norm + =/ soda=(list (each nomm toms)) ~[[%& code] [%| %wot]] + =/ silt=(list sock) ~[soot] + =| salt=(list sock) + =/ halt=(list @hail) ~[hail] + |- ^- _this + ?~ soda ^$(cork t.cork) + ?: ?=(%& -.i.soda) + =* cone p.i.soda + ?- -.cone + %par + $(soda [[%& left.cone] [%& rite.cone] [%| %par] t.soda]) + :: + %not + ?: =(0 here.cone) $(soda t.soda, salt [[| ~] salt]) + ?> ?=(^ silt) + =/ sand (~(pull so i.silt) here.cone) + ?~ sand $(soda t.soda, salt [[| ~] salt]) + $(soda t.soda, salt [u.sand salt]) + :: + %one + $(soda t.soda, salt [[& moan.cone] salt]) + :: + %two + $(soda [[%& cost.cone] [%& corn.cone] [%| %two rail.cone] t.soda]) + :: + %the + $(soda [[%& pell.cone] [%| %the] t.soda]) + :: + %for + $(soda [[%& mall.cone] [%| %for] t.soda]) + :: + %ivy + $(soda [[%& this.cone] [%& that.cone] [%| %ivy] t.soda]) + :: + %six + $(soda [[%& what.cone] [%& then.cone] [%& else.cone] [%| %six] t.soda]) + :: + %eve + $(soda [[%& once.cone] [%| %eve] [%& then.cone] [%| %vee] t.soda]) + :: + %ten + ?: =(0 here.cone) $(soda t.soda, salt [[| ~] salt]) + $(soda [[%& twig.cone] [%& tree.cone] [%| %ten here.cone] t.soda]) + :: + %sip + $(soda [[%& then.cone] t.soda]) + :: + %tip + ?: =(hint.cone %slow) :: %slow hint handling: no evaluation, just dynamic calls + =/ pots=(list nomm) ~[vice.cone then.cone] + |- ^- _this :: make sure we have moot entries for the dynamic calls + ?^ pots + ?- -.i.pots + %par $(pots [left.i.pots rite.i.pots t.pots]) + %not $(pots t.pots) + %one $(pots t.pots) + %two + =? moot ?!((~(has by moot) rail.i.pots)) + %+ ~(put by moot) rail.i.pots + :* [| ~] | + ~ ~ + [| ~] rake + `hail + == + $(pots [cost.i.pots corn.i.pots t.pots]) + :: + %the $(pots [pell.i.pots t.pots]) + %for $(pots [mall.i.pots t.pots]) + %ivy $(pots [this.i.pots that.i.pots t.pots]) + %six $(pots [what.i.pots then.i.pots else.i.pots t.pots]) + %eve $(pots [once.i.pots then.i.pots t.pots]) + %ten $(pots [twig.i.pots tree.i.pots t.pots]) + %sip $(pots [then.i.pots t.pots]) + %tip $(pots [vice.i.pots then.i.pots t.pots]) + %elf $(pots [rent.i.pots walk.i.pots t.pots]) + == + ^$(soda t.soda, salt [[| ~] salt]) + $(soda [[%& vice.cone] [%& then.cone] [%| %tip hint.cone rail.cone] t.soda]) + :: + %elf + $(soda [[%& rent.cone] [%& walk.cone] [%| %elf] t.soda]) + == + =* kant p.i.soda + ?- kant + %par + ?> ?=(^ salt) + ?> ?=(^ t.salt) + $(soda t.soda, salt [(~(knit so i.t.salt) i.salt) t.t.salt]) + :: + %the + ?> ?=(^ salt) + $(soda t.soda, salt [[| ~] t.salt]) + :: + %for + ?> ?=(^ salt) + $(soda t.soda, salt [[| ~] t.salt]) + :: + %ivy + ?> ?=(^ salt) + ?> ?=(^ t.salt) + $(soda t.soda, salt [[| ~] t.t.salt]) + :: + %six + ?> ?=(^ salt) + ?> ?=(^ t.salt) + ?> ?=(^ t.t.salt) + $(soda t.soda, salt [(~(purr so i.t.salt) i.salt) t.t.t.salt]) + :: + %eve + ?> ?=(^ salt) + $(soda t.soda, salt t.salt, silt [i.salt silt]) + :: + %vee + ?> ?=(^ silt) + $(soda t.soda, silt t.silt) + :: + %elf + ?> ?=(^ salt) + ?> ?=(^ t.salt) + $(soda t.soda, salt [[| ~] t.t.salt]) + :: + %wot + ?> ?=(^ halt) + ?> ?=(^ salt) + ?> ?=(^ silt) + =. moot + (~(jab by moot) i.halt |=(=toot toot(root i.salt))) + =/ rook (~(app ca rake) root) + =/ soap (~(app ca rake) i.salt) + ?: ?&(=(~ t.soda) ?!(=(cape.rook cape.soap)) ?=(^ sire)) + :: stack is empty but we learned more to pass on to our sire + =/ pate (~(got by moot) u.sire) + ?> ?=(^ norm.pate) + %= $ + soda ~[[%& u.norm.pate] [%| %wot]] + silt ~[soot.pate] + salt ~ + halt ~[u.sire] + root root.pate + sire sire.pate + == + $(soda t.soda, halt t.halt, silt t.silt) + :: + [%two *] + ?> ?=(^ salt) + ?> ?=(^ t.salt) + =? moot ?!((~(has by moot) rail.kant)) + %+ ~(put by moot) rail.kant + :* [| ~] | + ~ ~ + [| ~] | + `hail + == + =/ [soot=sock sake=cape root=sock form=(unit) noir=(unit nomm) rack=cape] + [soot sake root form norm rake]:(~(got by moot) rail.kant) + =/ roan=(unit hone) + ?: =(& cape.i.salt) :: equality because a cape can be a cell + =/ huns (~(get ja moan) data.i.salt) + |- ^- (unit hone) + ?~ huns ~ + ?: ?& (~(huge so soot.i.huns) i.t.salt) + !(~(big ca cape.root.i.huns) rack) + == + `i.huns + $(huns t.huns) + ~ + ?^ roan + =. moot :: copy info into moot + %+ ~(jab by moot) rail.kant + |= =toot + %= toot + soot i.t.salt + sake cape.soot.u.roan + root root.u.roan + rake cape.root.u.roan + form `data.i.salt + norm `nomm.norm.u.roan + == + $(soda t.soda, salt [root.u.roan t.t.salt]) + ?. ?|(?!(=(cape.soot cape.i.t.salt)) ?&(=(& cape.i.salt) =(~ form))) + $(soda t.soda, salt [root t.t.salt]) + =/ note ?:(=(& cape.i.salt) `data.i.salt ~) + =? mite ?&(?=(^ note) =(~ form)) (~(put in mite) rail.kant) + =. moot + (~(jab by moot) rail.kant |=(=toot toot(soot i.t.salt, form note))) + ?~ noir $(soda t.soda, salt [[| ~] t.t.salt]) + ?. (~(huge so soot) i.t.salt) $(soda t.soda, salt [soot t.t.salt]) :: XX shouldn't that be root? + %= $ + soda [[%& u.noir] [%| %wot] t.soda] + halt [rail.kant halt] + salt t.t.salt + silt [i.t.salt silt] + == + :: + [%ten *] + ?> ?=(^ salt) + ?> ?=(^ t.salt) + =/ dawn (~(darn so i.salt) here.kant i.t.salt) + ?~ dawn $(soda t.soda, salt [[| ~] t.t.salt]) + $(soda t.soda, salt [u.dawn t.t.salt]) + :: + [%tip *] + ?> ?=(^ salt) + ?> ?=(^ t.salt) + ?> ?=(^ halt) + ?: =(hint.kant %slow) + ?> ?=(^ silt) + $(soda t.soda, salt [[| ~] t.t.salt], silt t.silt) + ?: =(hint.kant %fast) + ?. =(& cape.i.t.salt) ~& %fast-miss $(soda t.soda, salt [i.salt t.t.salt]) + =/ pest (past data.i.t.salt) + ?~ pest $(soda t.soda, salt [[| ~] t.t.salt]) + =+ u.pest + =? mind !(~(has by mind) rail.kant) + (~(put by mind) rail.kant [%fast ~]) + =/ kind (~(got by mind) rail.kant) + ?> ?=([%fast *] kind) + ?^ tire.kind + ?> (~(huge so bats.u.tire.kind) i.salt) + $(soda t.soda, salt [bats.u.tire.kind t.t.salt]) + =/ boas (~(pull so i.salt) 2) + ?~ boas ~& fast-fake-b+name $(soda t.soda, salt [i.salt t.t.salt]) + =/ pork (~(pull so i.salt) ?~(park 3 u.park)) + ?~ pork ~& fast-fake-p+name $(soda t.soda, salt [i.salt t.t.salt]) + ?. =(& cape.u.boas) $(soda t.soda, salt [[| ~] t.t.salt]) + =/ papa=(unit [=path =sock]) + ?~ park ?:(=(& cape.u.pork) `[~ u.pork] ~) + =/ bart (~(pull so u.pork) 2) + ?~ bart ~& fast-fake-pb+name ~ + ?. =(& cape.u.bart) ~ + ?@ data.u.bart ~& fast-fake-pba+name ~ + =/ pats ~(tap in (~(get ju batt.cole) data.u.bart)) + |- ^- (unit [=path =sock]) + ?^ pats + =/ cure ~(tap in (~(get ju core.cole) i.pats)) + |- ^- (unit [=path =sock]) + ?^ cure + ?: (~(huge so i.cure) u.pork) + `[i.pats i.cure] + $(cure t.cure) + ^$(pats t.pats) + ~& fast-fake-np+name ~ + ?~ papa $(soda t.soda, salt [[| ~] t.t.salt]) + =/ kids (~(darn so (~(knit so u.boas) [| ~])) ?~(park 3 u.park) sock.u.papa) + ?> ?=(^ kids) + =/ walk [name path.u.papa] + =. core.cole (~(put ju core.cole) walk u.kids) + ?@ data.u.boas ~& fast-fake-ba+name $(soda t.soda, salt [[| ~] t.t.salt]) + =. batt.cole (~(put ju batt.cole) data.u.boas walk) + =/ matt + %- ~(gas by *(map @ [@hail *])) + %+ turn (peel data.u.boas) + |= [axe=@ form=*] + [axe (peg rail.kant axe) form] + =. mind (~(put by mind) rail.kant [%fast `[walk u.kids matt]]) + =. moot + %- ~(gas by moot) + %+ turn ~(val by matt) + |= [rail=@hail form=*] + :- rail + :* u.kids | + `form ~ + [| ~] | `i.halt + == + =. mite + %- ~(gas in mite) + %+ turn ~(val by matt) + |=([rail=@hail *] rail) + $(soda t.soda, salt [u.kids t.t.salt]) + $(soda t.soda, salt [i.salt t.t.salt]) + == + :: work discovery + :: + :: - find newly direct call sites, and check if they are recursive + :: - add new non-recursive direct callsites to worklist + :: - finalize calls which contain no newly direct non-recursive + :: callsites + :: - add finalized callsites and their call-tree children to moan + :: and cole (cold state) + ++ ruin + =/ mile=(list @hail) ~(tap in mite) + =. work ~ :: non-recursive direct calls + =| slag=(set @hail) :: excluded as finalization roots + =| flux=(set @hail) :: possible finalization roots + =| loop=(map @hail @hail) :: recursive call targets + |- ^- _this + ?^ mile + =/ mill i.mile + =/ [mail=(unit @hail) soot=sock form=(unit) rack=cape] + [sire soot form rake]:(~(got by moot) mill) + ?> ?=(^ form) :: shouldn't get added to mite unless we know it + =/ mole (~(get ja moan) u.form) + |- ^- _this + ?^ mole + ?: ?& (~(huge so soot.i.mole) soot) + !(~(big ca cape.root.i.mole) rack) + == + ^$(mile t.mile) + $(mole t.mole) + =| sirs=(list @hail) + |- ^- _this + ?~ mail + ?~ sirs :: not actually a call just the entrypoint + ^^$(mile t.mile, flux (~(put in flux) mill)) + %= ^^$ :: an un-analyzed indirect call XX direct surely? + mile t.mile + work [i.mile work] + slag (~(gas in slag) [mill sirs]) + == + =. kids (~(put ju kids) u.mail mill) + =. mill u.mail + =/ [suit=sock soju=cape firm=(unit) mire=(unit @hail) ruck=cape] + [soot sake form sire rake]:(~(got by moot) mill) + ?> ?=(^ firm) + ?: ?& =(u.form u.firm) + (~(huge so (~(app ca soju) suit)) soot) + !(~(big ca ruck) rack) + == + %= ^^$ :: found a recursive direct call + mile t.mile + slag (~(gas in slag) sirs) + flux (~(put in flux) mill) + loop (~(put by loop) i.mile mill) + == + $(sirs [mill sirs], mail mire) + =. mite (~(dif in mite) (~(gas in *(set @hail)) work)) + :: normalize all the callsites before we finalize any of them + =/ done ~(tap in (~(dif in flux) slag)) + =| enod=(list (list @hail)) + =| dome=(list @hail) + |- ^- _this + ?^ done + ?: (~(has by loop) i.done) $(done t.done) + =/ hood (~(got by moot) i.done) + =. soot.hood ~(norm so (~(app ca sake.hood) soot.hood)) + =. root.hood ~(norm so (~(app ca rake.hood) root.hood)) + =. moot (~(put by moot) i.done hood) + ?> ?=(^ form.hood) + ?: =/ huns (~(get ja moan) u.form.hood) + |- ^- ? + ?^ huns + ?: ?& (~(huge so soot.i.huns) soot.hood) + !(~(big ca cape.root.i.huns) rake.hood) + == + & + $(huns t.huns) + | + $(done t.done) + =. dome [i.done dome] + =/ next ~(tap in (~(get ju kids) i.done)) + ?~ next + $(done t.done) + $(done t.done, enod [next enod]) + ?^ enod + $(done i.enod, enod t.enod) + |- ^- _this + ?~ dome + this + =/ hood (~(got by moot) i.dome) + ?> ?=(^ norm.hood) + =/ sell (sale u.norm.hood) + =. call.cole (~(gas ju call.cole) sell) + =. back.cole + (~(gas by back.cole) (turn sell |=([p=[path @] a=[sock *]] [a p]))) + ?> ?=(^ form.hood) + =. moan + %+ ~(add ja moan) u.form.hood + [soot.hood (cook u.norm.hood loop) root.hood] + $(dome t.dome) + :: new entries for cold state + ++ sale + |= norm=nomm + ^- (list [[path @] sock *]) + ?- -.norm + %par (weld $(norm left.norm) $(norm rite.norm)) + %not ~ + %one ~ + %two (weld $(norm cost.norm) $(norm corn.norm)) + %the $(norm pell.norm) + %for $(norm mall.norm) + %ivy (weld $(norm this.norm) $(norm that.norm)) + %six + (weld $(norm what.norm) (weld $(norm then.norm) $(norm else.norm))) + :: + %eve (weld $(norm once.norm) $(norm then.norm)) + %ten (weld $(norm twig.norm) $(norm tree.norm)) + %sip $(norm then.norm) + %tip + ?. =(%fast hint.norm) (weld $(norm vice.norm) $(norm then.norm)) + =/ =hind (~(got by mind) rail.norm) + ?~ hind (weld $(norm vice.norm) $(norm then.norm)) + ?~ tire.hind (weld $(norm vice.norm) $(norm then.norm)) + =* tine u.tire.hind + =| kale=(list [[path @] sock *]) + =| calm=(map @ [=cape form=*]) + =/ tack=(list @) ~[1] + |- ^- (list [[path @] sock *]) + ?^ tack + =/ mart (~(get by matt.tine) i.tack) + ?^ mart + =/ =toot (~(got by moot) -.u.mart) + ?> =(bats.tine soot.toot) + %= $ + calm (~(put by calm) i.tack [sake.toot +.u.mart]) + kale + :_ kale + :- [cone.tine i.tack] + [~(norm so (~(app ca sake.toot) bats.tine)) +.u.mart] + :: + tack t.tack + == + =/ clam (~(get by calm) (peg i.tack 2)) + =/ cram (~(get by calm) (peg i.tack 3)) + ?: ?&(?=(^ clam) ?=(^ cram)) + =/ sake (~(uni ca cape.u.clam) cape.u.cram) + =/ form [form.u.clam form.u.cram] + %= $ + calm (~(put by calm) i.tack sake form) + kale + :_ kale + [[cone.tine i.tack] ~(norm so (~(app ca sake) bats.tine)) form] + :: + tack t.tack + == + $(tack [(peg 2 i.tack) (peg 3 i.tack) tack]) + (weld kale (weld ^$(norm vice.norm) ^$(norm then.norm))) + :: + %elf (weld $(norm rent.norm) $(norm walk.norm)) + == + :: pick out food for nomm + ++ cook + |= [norm=nomm pool=(map @hail @hail)] + ^- food + =| ices=(map @hail [=sock form=*]) + =| leap=(set [=sock form=*]) + =/ fore=(list nomm) ~[norm] + |- ^- food + ?^ fore + ?- -.i.fore + %par $(fore [rite.i.fore left.i.fore t.fore]) + %not $(fore t.fore) + %one $(fore t.fore) + %two + =/ roil (~(gut by pool) rail.i.fore rail.i.fore) + =/ foot (~(get by moot) roil) + ?> ?=(^ foot) + ~? ?=(~ form.u.foot) indirect+rail.i.fore + =? ices ?=(^ form.u.foot) + %+ ~(put by ices) rail.i.fore + [soot u.form]:u.foot + =? leap ?&((~(has by pool) rail.i.fore) ?=(^ form.u.foot)) + %- ~(put in leap) [soot u.form]:u.foot + $(fore [corn.i.fore cost.i.fore t.fore]) + :: + %the $(fore [pell.i.fore t.fore]) + %for $(fore [mall.i.fore t.fore]) + %ivy $(fore [this.i.fore that.i.fore t.fore]) + %six $(fore [what.i.fore then.i.fore else.i.fore t.fore]) + %eve $(fore [once.i.fore then.i.fore t.fore]) + %ten $(fore [twig.i.fore tree.i.fore t.fore]) + %sip $(fore [then.i.fore t.fore]) + %tip $(fore [vice.i.fore then.i.fore t.fore]) + %elf $(fore [rent.i.fore walk.i.fore t.fore]) + == + [norm ices leap] + -- +:: +:: parse fast hint +++ past + |= a=* + ^- (unit [name=term park=(unit @) hock=(list [term @])]) + ?. ?=([* [@ @] *] a) ~& [%fast-isnt a] ~ + =/ nume (bait -.a) + ?~ nume ~& [%fast-isnt a] ~ + =/ huck +>.a + =| hock=(list [term @]) + |- ^- (unit [name=term park=(unit @) hock=(list [term @])]) + ?^ huck + ?. ?&(?=([@ @] -.huck) ((sane %ta) -<.huck)) ~& [%fast-isnt a] ~ + $(hock [-.huck hock], huck +.huck) + ?. =(~ huck) ~& [%fast-isnt a] ~ + ?: =(0 +<-.a) `[u.nume `+<+.a (flop hock)] + ?: =([1 0] +<.a) `[u.nume ~ (flop hock)] + ~& [%fast-isnt a] ~ +:: +:: battery members +:: +:: we can discover all possible formulas in a battery by observing that +:: a pair of two valid formulas is itself a valid formula. Therefore we +:: treat the whole battery as a formula, but recursively decompose it +:: along autocons. This allows us to analyze all possible batteries in a +:: formula to enter them into the cold state +++ peel + |= f=* + ^- (list [axe=@ form=*]) + =/ tack=(list [@ *]) [1 f]~ + =| salt=(list [axe=@ form=*]) + |- ^- (list [axe=@ form=*]) + ?^ tack + ?: ?=([^ *] +.i.tack) + $(tack [[(peg -.i.tack 2) +<.i.tack] [(peg -.i.tack 3) +>.i.tack] t.tack]) + $(tack t.tack, salt [i.tack salt]) + salt +:: +:: parse $chum +:: +:: paths are composed of terms but fast hints label cores with $chum, +:: so we need to translate the cell case of $chum into a concatenated +:: term +++ bait + |= a=* + ^- (unit term) + ?@ a ?.(((sane %tas) a) ~ ``@tas`a) + ?. ?=([@ @] a) ~ + ?. ((sane %tas) -.a) ~ + `(crip (scag 32 (weld (trip -.a) (a-co:co +.a)))) +-- diff --git a/hoon/codegen/lib/ska.hoon b/hoon/codegen/lib/ska.hoon deleted file mode 100644 index 2a01b0c7..00000000 --- a/hoon/codegen/lib/ska.hoon +++ /dev/null @@ -1,702 +0,0 @@ -/- *sock -!: -|% -++ trip - |= toob=$<(%boom boot) - ^- (unit *) - ?- -.toob - %safe (stub sure.toob) - %risk (stub hope.toob) - == -++ stub - |= =sock - ^- (unit *) - ?: ?=(%know -.sock) - `know.sock - ~ -:: Split an axis into a sock into safe and unsafe components -++ punt - |= [axe=@ =sock] - ^- [@ @ ^sock] - ?: =(0 axe) - [0 0 %toss ~] - =/ saf 1 - |- - ?: =(axe 1) - [saf 1 sock] - ?+ sock [0 0 %toss ~] - [%know * *] - ?- (cap axe) - %2 $(axe (mas axe), sock [%know -.know.sock], saf (peg saf 2)) - %3 $(axe (mas axe), sock [%know +.know.sock], saf (peg saf 3)) - == - :: - [%bets *] - ?- (cap axe) - %2 $(axe (mas axe), sock hed.sock, saf (peg saf 2)) - %3 $(axe (mas axe), sock tal.sock, saf (peg saf 3)) - == - :: - [%toss ~] - [saf axe %toss ~] - == -:: Get an axis from a sock -++ pull - |= arg=[@ sock] - ^- boot - =+ [saf rik ken]=(punt arg) - ?: =(0 saf) [%boom ~] - ?: =(1 rik) [%safe ken] - [%risk ken] -++ yank - |= [axe=@ =boot] - ?- boot - [%safe *] (pull axe sure.boot) - [%risk *] (dare (pull axe hope.boot)) - [%boom ~] [%boom ~] - == -:: Test if sock is atom or cell, or unknown -++ fits - |= =sock - ^- ^sock - ?- sock - :: - [%know @] - [%know 1] - :: - [%know * *] - [%know 0] - :: - [%bets *] - [%know 0] - :: - [%dice ~] - [%know 1] - :: - [%flip ~] - [%know 1] - :: - [%toss ~] - [%flip ~] - == -:: Test if we can know two socks are equal -++ pear - |= [a=sock b=sock] - ^- sock - ?: ?&(?=([%know *] a) ?=([%know *] b)) - ?: =(know.a know.b) - [%know 0] - [%know 1] - [%flip ~] -:: Test if we can know two boots are equal -++ bopp - |= [a=boot b=boot] - ^- boot - ?: ?= [%boom ~] a - [%boom ~] - ?: ?= [%boom ~] b - [%boom ~] - ?- a - :: - [%safe *] - ?- b - :: - [%safe *] - [%safe (pear sure.a sure.b)] - :: - [%risk *] - [%risk (pear sure.a hope.b)] - == - :: - [%risk *] - ?- b - :: - [%safe *] - [%risk (pear hope.a sure.b)] - :: - [%risk *] - [%risk (pear hope.a hope.b)] - == - == -:: combine two socks into a sock of a cell -++ knit - |= [a=sock b=sock] - ^- sock - ?. ?= [%know *] a - [%bets a b] - ?. ?= [%know *] b - [%bets a b] - [%know [know.a know.b]] -:: combine two boots into a boot of a cell -++ cobb - |= [hed=boot tal=boot] - ^- boot - ?: ?= [%boom ~] hed - [%boom ~] - ?: ?= [%boom ~] tal - [%boom ~] - ?- hed - :: - [%safe *] - ?- tal - :: - [%safe *] - [%safe (knit sure.hed sure.tal)] - :: - [%risk *] - [%risk (knit sure.hed hope.tal)] - == - :: - [%risk *] - ?- tal - :: - [%safe *] - [%risk (knit hope.hed sure.tal)] - :: - [%risk *] - [%risk (knit hope.hed hope.tal)] - == - == -:: patch a sock -++ darn - |= [axe=@ pat=sock =sock] - ^- boot - ?: .= 0 axe - [%boom ~] - |- - ^- boot - ?: =(axe 1) - [%safe pat] - ?: ?= [%dice ~] sock - [%boom ~] - ?: ?= [%flip ~] sock - [%boom ~] - ?: ?= [%know @] sock - [%boom ~] - ?- (cap axe) - :: - %2 - ?- sock - :: - [%know * *] - (cobb $(axe (mas axe), sock [%know -.know.sock]) [%safe %know +.know.sock]) - :: - [%bets * *] - (cobb $(axe (mas axe), sock hed.sock) [%safe tal.sock]) - :: - [%toss ~] - (cobb $(axe (mas axe)) [%risk %toss ~]) - == - :: - %3 - ?- sock - :: - [%know * *] - (cobb [%safe %know -.know.sock] $(axe (mas axe), sock [%know +.know.sock])) - :: - [%bets * *] - (cobb [%safe hed.sock] $(axe (mas axe), sock tal.sock)) - :: - [%toss ~] - (cobb [%risk %toss ~] $(axe (mas axe))) - == - == -:: Stitch a boot into another boot -++ welt - |= [axe=@ pach=boot wole=boot] - ^- boot - ?: ?= [%boom ~] pach - [%boom ~] - ?: ?= [%boom ~] wole - [%boom ~] - =/ poch - ?- pach - :: - [%safe *] - sure.pach - :: - [%risk *] - hope.pach - == - =/ wool - ?- wole - :: - [%safe *] - sure.wole - :: - [%risk *] - hope.wole - == - ?: ?& ?= [%safe *] wole ?= [%safe *] pach == - (darn axe poch wool) - (dare (darn axe poch wool)) - -:: Pessimize a boot by making it %risk even if it's %safe -++ dare - |= =boot - ?- boot - :: - [%boom ~] - [%boom ~] - :: - [%risk *] - [%risk hope.boot] - :: - [%safe *] - [%risk sure.boot] - == -:: Weaken a %know -++ fray - |= a=* - ^- sock - ?: ?= @ a - [%dice ~] - [%bets [%know -.a] [%know +.a]] -:: Produce the intersection of two socks -++ mous - |= [a=sock b=sock] - ?: ?&(?=([%know *] a) ?=([%know *] b)) - ?: =(know.a know.b) - a - $(a (fray know.a), b (fray know.b)) - ?: ?=([%know *] a) - $(a (fray know.a)) - ?: ?=([%know *] b) - $(b (fray know.b)) - ?: ?&(?=([%bets *] a) ?=([%bets *] b)) - [%bets $(a hed.a, b hed.b) $(a tal.a, b tal.b)] - ?: ?&(?=([%dice ~] a) ?|(?=([%dice ~] b) ?=([%flip ~] b))) - [%dice ~] - ?: ?&(?=([%dice ~] b) ?=([%flip ~] a)) - [%dice ~] - ?: ?&(?=([%flip ~] a) ?=([%flip ~] b)) - [%flip ~] - [%toss ~] -:: Produce the intersection of two boots -:: -:: Note that the intersection of a safe or risk -:: boot and a boom boot is a risk boot, since -:: in a branch between a possibly non-crashing computation -:: and a crashing computation, we might crash and we might not. -:: -:: In particular, we have to handle assertions and -:: error cases where it is intended that one branch of a conditional -:: will crash -++ gnaw - |= [a=boot b=boot] - ?: ?= [%safe *] a - ?: ?= [%safe *] b - [%safe (mous sure.a sure.b)] - ?: ?= [%risk *] b - [%risk (mous sure.a hope.b)] - [%risk sure.a] - ?: ?= [%risk *] a - ?: ?= [%safe *] b - [%risk (mous hope.a sure.b)] - ?: ?= [%risk *] b - [%risk (mous hope.a hope.b)] - [%risk hope.a] - ?: ?= [%safe *] b - [%risk sure.b] - ?: ?= [%risk *] b - [%risk hope.b] - [%boom ~] -:: Produce a boot of whether a given boot is a cell or atom -++ ques - |= non=boot - ^- boot - ?: ?=([%boom ~] non) - [%boom ~] - ?- non - :: - [%safe %know @] - [%safe %know 1] - :: - [%safe %know * *] - [%safe %know 0] - :: - [%safe %bets *] - [%safe %know 0] - :: - [%safe %dice ~] - [%safe %know 1] - :: - [%safe %flip ~] - [%safe %know 1] - :: - [%safe %toss ~] - [%safe %flip ~] - :: - [%risk %know @] - [%risk %know 1] - :: - [%risk %know * *] - [%risk %know 0] - :: - [%risk %bets *] - [%risk %know 0] - :: - [%risk %dice ~] - [%risk %know 1] - :: - [%risk %flip ~] - [%risk %know 1] - :: - [%risk %toss ~] - [%risk %flip ~] - == -++ pile - |= tom=boot - ^- boot - ?+ tom [%boom ~] - :: - [%safe %know @] - [%safe %dice ~] - :: - [%safe %dice ~] - [%safe %dice ~] - :: - [%safe %flip ~] - [%safe %dice ~] - :: - [%safe %toss ~] - [%risk %dice ~] - :: - [%risk %know @] - [%risk %dice ~] - :: - [%risk %dice ~] - [%risk %dice ~] - :: - [%risk %flip ~] - [%risk %dice ~] - :: - [%risk %toss ~] - [%risk %dice ~] - == -:: Produce knowledge of the result given knowledge of the subject -++ wash - |= [subj=sock form=*] - ^- boot - =| bare=[ward=(map [sock *] boot) dir=@ ind=@] - =. ward.bare (~(put by ward.bare) [subj form] [%risk %toss ~]) - |^ - =+ swab - ~& "direct calls: {}" - ~& "indirect calls: {}" - -< - ++ swab - |- - ^- [boot _bare] - ?> ?=(^ form) - ?+ form [[%boom ~] bare] - :: - [[* *] *] - =^ l bare $(form -.form) - =^ r bare $(form +.form) - :_ bare - (cobb l r) - :: - [%0 @] - :_ bare - (pull +.form subj) - :: - [%1 *] - :_ bare - [%safe %know +.form] - :: - [%2 * *] - =^ subn bare $(form +<.form) - ?: ?=([%boom ~] subn) - [[%boom ~] bare] - =^ forn bare $(form +>.form) - ?: ?=([%boom ~] forn) - [[%boom ~] bare] - ?: ?= [%safe %dice ~] forn - [[%boom ~] bare] - ?: ?= [%safe %flip ~] forn - [[%boom ~] bare] - ?: ?= [%risk %dice ~] forn - [[%boom ~] bare] - ?: ?= [%risk %flip ~] forn - [[%boom ~] bare] - ?+ forn [[%risk %toss ~] bare(ind .+(ind.bare))] - :: - [%safe %know *] - =. dir.bare .+(dir.bare) - ?- subn - :: - [%safe *] - =/ nubs sure.subn - =/ norm know.sure.forn - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - [r bare(ward (~(put by ward.bare) [nubs norm] r))] - :: - [%risk *] - =/ nubs hope.subn - =/ norm know.sure.forn - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - [(dare r) bare(ward (~(put by ward.bare) [nubs norm] (dare r)))] :: XX fix up ward modifications - == - :: - [%risk %know *] - =. dir.bare .+(dir.bare) - ?- subn - :: - [%safe *] - =/ nubs sure.subn - =/ norm know.hope.forn - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - [(dare r) bare(ward (~(put by ward.bare) [nubs norm] (dare r)))] - :: - [%risk *] - =/ nubs hope.subn - =/ norm know.hope.forn - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - [(dare r) bare(ward (~(put by ward.bare) [nubs norm] (dare r)))] - == - == - :: - [%3 *] - =^ s bare $(form +.form) - :_ bare - (ques s) - :: - [%4 *] - =^ s bare $(form +.form) - :_ bare - (pile s) - :: - [%5 * *] - =^ l bare $(form +<.form) - =^ r bare $(form +>.form) - :_ bare - (bopp l r) - :: - [%6 * * *] - =^ cond bare $(form +<.form) - ?+ cond [[%boom ~] bare] - :: - [%safe *] - ?+ sure.cond [[%boom ~] bare] - :: - [%know %0] - $(form +>-.form) - :: - [%know %1] - $(form +>+.form) - :: - [%flip ~] - =^ t bare $(form +>-.form) - =^ f bare $(form +>+.form) - :_ bare - (gnaw t f) - :: - [%dice ~] - =^ t bare $(form +>-.form) - =^ f bare $(form +>+.form) - :_ bare - (dare (gnaw t f)) - :: - [%toss ~] - =^ t bare $(form +>-.form) - =^ f bare $(form +>+.form) - :_ bare - (dare (gnaw t f)) - == - :: - [%risk *] - ?+ hope.cond [[%boom ~] bare] - :: - [%know %0] - =^ t bare $(form +>-.form) - :_ bare - (dare t) - :: - [%know %1] - =^ f bare $(form +>+.form) - :_ bare - (dare f) - :: - [%flip ~] - =^ t bare $(form +>-.form) - =^ f bare $(form +>+.form) - :_ bare - (dare (gnaw t f)) - :: - [%dice ~] - =^ t bare $(form +>-.form) - =^ f bare $(form +>+.form) - :_ bare - (dare (gnaw t f)) - :: - [%toss ~] - =^ t bare $(form +>-.form) - =^ f bare $(form +>+.form) - :_ bare - (dare (gnaw t f)) - == - == - :: - [%7 * *] - =^ news bare $(form +<.form) - ?+ news [[%boom ~] bare] - :: - [%safe *] - $(subj sure.news, form +>.form) - :: - [%risk *] - =^ r bare $(subj hope.news, form +>.form) - :_ bare - (dare r) - == - :: - [%8 * *] - =^ news bare $(form +<.form) - ?+ news [[%boom ~] bare] - :: - [%safe *] - $(subj (knit sure.news subj), form +>.form) - :: - [%risk *] - =^ r bare $(subj (knit hope.news subj), form +>.form) - :_ bare - (dare r) - == - :: - [%9 @ *] - =^ news bare $(form +>.form) - ?+ news [[%boom ~] bare] - :: - [%safe *] - =/ newf (pull +<.form sure.news) - ?+ newf [[%boom ~] bare] - :: - [%safe %know *] - =. dir.bare .+(dir.bare) - =/ nubs sure.news - =/ norm know.sure.newf - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - :_ bare(ward (~(put by ward.bare) [nubs norm] r)) - r - :: - [%risk %know *] - =. dir.bare .+(dir.bare) - =/ nubs sure.news - =/ norm know.hope.newf - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - :_ bare(ward (~(put by ward.bare) [nubs norm] (dare r))) - (dare r) - :: - [%safe *] - =. ind.bare .+(ind.bare) - [[%risk %toss ~] bare] - :: - [%risk *] - =. ind.bare .+(ind.bare) - [[%risk %toss ~] bare] - == - :: - [%risk *] - =/ newf (pull +<.form hope.news) - ?+ newf [[%boom ~] bare] - :: - [%safe %know *] - =. dir.bare .+(dir.bare) - =/ nubs hope.news - =/ norm know.sure.newf - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - :_ bare(ward (~(put by ward.bare) [nubs norm] (dare r))) - (dare r) - :: - [%risk %know *] - =. dir.bare .+(dir.bare) - =/ nubs hope.news - =/ norm know.hope.newf - =/ mem (~(get by ward.bare) [nubs norm]) - ?. ?=(~ mem) [u.mem bare] - =. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~]) - =^ r bare $(subj nubs, form norm) - :_ bare(ward (~(put by ward.bare) [nubs norm] (dare r))) - (dare r) - :: - [%safe *] - =. ind.bare .+(ind.bare) - [[%risk %toss ~] bare] - :: - [%risk *] - =. ind.bare .+(ind.bare) - [[%risk %toss ~] bare] - == - == - :: - [%10 [@ *] *] - =^ p bare $(form +<+.form) - =^ w bare $(form +>.form) - :_ bare - (welt +<-.form p w) - :: - [%11 @ *] - $(form +>.form) - :: - [%11 [* *] *] - =^ hint bare $(form +<+.form) - ?+ hint [[%boom ~] bare] - :: - [%safe *] - $(form +>.form) - :: - [%risk *] - =^ r bare $(form +<.form) - :_ bare - (dare r) - == - :: - [%12 *] - [[%risk %toss ~] bare] - == - -- -++ cuff - |= =sock - =/ axe 1 - |- - ^- (list @) - ?- sock - :: - [%know *] - (limo [axe ~]) - :: - [%bets *] - (weld $(axe (add axe axe), sock hed.sock) $(axe (add (add axe axe) 1), sock tal.sock)) - :: - [%dice ~] - (limo [axe ~]) - :: - [%flip ~] - (limo [axe ~]) - :: - [%toss ~] - (limo [axe ~]) - == --- diff --git a/hoon/codegen/lib/skan.hoon b/hoon/codegen/lib/skan.hoon new file mode 100644 index 00000000..1630a088 --- /dev/null +++ b/hoon/codegen/lib/skan.hoon @@ -0,0 +1,970 @@ +/- noir +|. +=> $:noir +=< +:: moan contains analyzed code for the linearizer +=| moan=(jar * hone) +:: memo contains saved analyses of arms +=| memo=(jar * meme) +:: cole is the cold state +=| cole=cool +:: +:: compile-time verbosity control (un/comment individual faces) +:: +=/ verb + :* :: call-site/spot lifecycle rubric: + :: memo hit: <1 + :: melo hit: <2 + :: pseudo-recursive: <3 + :: indirect: <4 + :: analysis: >> + :: meloize: >2 + :: finalize: >3 + :: + :: call=& + :: + jet=& :: jet re/registration + :: + ~ + == +:: +~% %skan ..ride ~ +|% +++ thus . +:: ++$ lore + $: rail=@hail :: generator for call sites + hare=@hint :: generator for hint sites + kids=(jug @hail @hail) :: map parent to child callsites + hint=(jug @hail @hint) :: hint sites under a callsite + forb=(map @hint *) :: hint bodies + call=cafe :: finished callsite information + want=urge :: callsite needs + loop=(map @hail [t=@hail s=sock l=naan]) :: recursion targets + memo=_memo :: memoized call analysis + moan=_moan + cole=_cole :: cold state + dire=? :: fully direct? + area=(unit spot) :: outermost spot within this site + wait=(jar @hail @hail) :: sites to finalize + melo=(jar * meal) :: non-final memoization targets + remo=(map @hail [site=@hail =sock]) :: non-final memoization hits + == +:: +++ snak + ~% %snak ..snak ~ + =| $: gen=lore + $= dad + $: sirs=(jar * [site=@hail less=naan]) + lord=(set @hail) :: enclosing scope + tack=(list @hail) + seat=(unit spot) :: innermost spot in lord + wake=(list spot) :: trace within arm + == == + |% + :: +memo: check for memoized, finalized analysis + :: + :: hits are guaranteed complete + :: XX: add debug sanity-check that entries are never in [melo.gen] + :: + ++ memo + ~/ %memo + |= [entr=@hail form=* less=naan] + ^- (unit [naan lore]) + =/ germ (~(get ja memo.gen) form) + |- ^- (unit [naan lore]) + ?~ germ ~ + ?. (~(huge so soot.i.germ) sock.less) + $(germ t.germ) + => !@(call.verb ((outa:blot "<1 " entr seat.dad area.i.germ) .) .) + =/ mope (~(rue qui prot.less) have.i.germ) + =. mope (~(cut qui mope) lord.dad cape.root.i.germ) + =/ more [mope root.i.germ] + :: propagate memoized subject needs + =/ pant (~(due qui prot.less) want.i.germ) + =. want.gen + %- (~(uno by want.gen) pant) + |= [@hail a=cape b=cape] + ~(cut ca (~(uni ca a) b)) + =. call.gen (~(put by call.gen) entr [less more form ~ & ~ seat.dad area.i.germ]) + `[more gen] + :: + :: +melo: check for in-progress analysis + :: + :: NB: hits are estimates, must be validated in +seal + :: + ++ melo + ~/ %melo + |= [entr=@hail form=* less=naan] + ^- (unit [naan lore]) + =/ gorm (~(get ja melo.gen) form) + |- ^- (unit [naan lore]) + ?~ gorm ~ + =/ tote + =/ cope (~(gut by want.gen) site.i.gorm |) + (~(app ca cope) sock.less.i.gorm) + ?. (~(huge so tote) sock.less) + $(gorm t.gorm) + => !@(call.verb ((onto:blot "<2 " entr seat.dad [site seat area]:i.gorm) .) .) + =/ mope (~(rue qui prot.less) have.i.gorm) + =. mope (~(cut qui mope) lord.dad cape.root.i.gorm) + =/ more [mope root.i.gorm] + :: + :+ ~ more + %= gen + remo (~(put by remo.gen) entr [site.i.gorm sock.less]) + loop + %+ roll loom.i.gorm + |= [[c=@hail t=@hail s=sock n=noon] gen=loop=_loop.gen] + ?~ op=(~(get by loop.gen) c) + loop.gen :: NB: got:by has crashed here + =/ rot (~(rue qui prot.less) plop.n) + %+ ~(put by loop.gen) c + u.op(prot.l (~(int qui rot) prot.l.u.op)) + :: + call + =/ lac (~(got by call.gen) site.i.gorm) + (~(put by call.gen) site.i.gorm lac(remos (~(put in remos.lac) entr))) + :: + wait + =< + + %. site.i.gorm + wait(tack.dad +.tack.dad, wait.gen (~(del by wait.gen) entr)) + == + :: + :: +wait: register dependence on [site] for finalization + :: + ++ wait + ~/ %wait + |= site=@hail + =| wire=(list (list @hail)) + |- ^- [@hail _wait.gen] + ?> ?=(^ tack.dad) + =/ fire (~(get ja wait.gen) i.tack.dad) + ?. (lien fire |=(h=@hail =(site h))) + %= $ + tack.dad t.tack.dad + wire [fire wire] + wait.gen (~(del by wait.gen) i.tack.dad) + == + :- i.tack.dad + (~(put by wait.gen) i.tack.dad (zing (flop [fire wire]))) + :: + :: +loop: check for recursion + :: + :: hits are estimates, must be validated in +mend and +seal + :: XX: improve debug output (link site -> target -> finalization site) + :: + ++ loop + ~/ %loop + |= [roil=@hail fork=naan sand=naan] + ^- (unit lore) + =/ pore (~(get ja sirs.dad) data.sock.fork) + |- ^- (unit lore) + ?~ pore ~ + =/ tote + =/ cope (~(gut by want.gen) site.i.pore |) + (~(app ca cope) sock.less.i.pore) + ?. (~(huge so tote) sock.sand) + $(pore t.pore) + :: recursive + =. loop.gen (~(put by loop.gen) roil [site.i.pore sock.less.i.pore sand]) + =^ til=@hail wait.gen (wait site.i.pore) + :: XX also print [site.i.pore] and its spot + => !@(call.verb ((onto:blot "<3 " roil seat.dad til ~ ~) .) .) + `gen + :: + :: +hint: update lore after analyzing through hint (currently just %fast) + :: + :: XX: validate recursive hint processing, refactor + :: + ++ hint + ~/ %hint + |= [form=h=@ mild=naan bite=naan] + ^- lore + ?+ h.form gen + %fast + :: fast hint registration + ?. =(& cape.sock.mild) ~& %fast-hide-clue gen + =* clue data.sock.mild + ?. ?=([name=$@(@tas [@tas @]) pare=* *] clue) + ~& [%fast-bad-clue clue] gen + =/ pell + ?@ name.clue + name.clue + (crip "{(trip -.name.clue)}.{(trip (scot %ud +.name.clue))}") + |- ^- lore + ?+ pare.clue ~& [%fast-bad-clue clue] gen + :: XX may elide crashes [%11 [%1 *] *] + [%11 * *] + $(pare.clue +>.pare.clue) + :: + [%1 %0] + :: register root + ?. =(& cape.sock.bite) + ~& %fast-hide-root gen + %= gen + core.cole (~(put ju core.cole.gen) ~[pell] sock.bite) + root.cole (~(put ju root.cole.gen) data.sock.bite ~[pell]) + == + :: + [%0 a=@] + ?: =(0 @) ~& [%fast-bad-clue clue] gen + :: register child core + =/ batt (~(pull so sock.bite) 2) + ?. =(& cape.batt) ~& [%fast-hide-batt pell] gen + ?. ?=(^ data.batt) gen + =/ park (~(pull so sock.bite) a.pare.clue) + :: XX ??? + :: ?. =(& cape.park) ~& %fast-lost-sire gen + =/ past=(set path) + ?. =(& cape.park) ~ + (~(get ju root.cole.gen) data.park) + =/ bork (~(pull so park) 2) + =? past &(?=(%& cape.bork) ?=(^ data.bork)) + (~(uni in past) (~(get ju batt.cole.gen) data.bork)) + =/ pale ~(tap in past) + |- ^- lore + =* pale-loop $ + ?~ pale gen + =/ nape=path [pell i.pale] + =/ coal ~(tap in (~(get ju core.cole.gen) i.pale)) + |- ^- lore + ?~ coal pale-loop(pale t.pale) + ?. (~(huge so i.coal) park) $(coal t.coal) + =/ naut + =/ bake (~(darn so [| ~]) 2 batt) :: XX [[& |] batt ~] + (~(darn so bake) a.pare.clue i.coal) + :: + => =* dot . + !@ jet.verb + =/ cod + ?:(?!((~(has by core.cole.gen) nape)) %cold-into %cold-peat) + ~> %slog.[0 [%rose [": " ~ ~] cod (smyt nape) ~]] + dot + dot + :: + %= gen + core.cole (~(put ju core.cole.gen) nape naut) + batt.cole (~(put ju batt.cole.gen) data.batt nape) + == + == + == + :: + :: +bide: save non-final results for "meloization" + :: + ++ bide + ~/ %bide + |= [entr=@hail form=* less=naan more=naan] + ^+ melo.gen + => !@(call.verb ((outa:blot ">2 " entr seat.dad area.gen) .) .) + =/ want *cape + =/ sutt *sock + =/ have (~(rel qui prot.more) entr cape.sock.more) + =/ loom + %- ~(rep by loop.gen) + |= [[c=@hail t=@hail s=sock l=naan] loom=(list [c=@hail t=@hail s=sock =noon])] + ^+ loom + :: XX maybe require that t is in sirs + =/ p=plop (~(rel qui prot.l) entr &) + =/ n=noon [p sock.l] + [[c t s n] loom] :: XX skip if ?=(~ p) ? + :: XX remove sutt and want + (~(add ja melo.gen) form [[sutt want sock.more have area.gen] entr less seat.dad loom]) + :: + :: +mend: fixpoints to validate pseudo-recursive estimates + :: + :: XX consider additionally fixpointing into want.gen from remo.gen + :: XX performance + :: + ++ mend + =< $ + ~% %mend ..mend ~ + |. ^- [? lore] + =/ sap gen :: for reset + =| nop=(map @hail [t=@hail s=sock l=naan]) + =| i=@ud + |- ^- [? lore] + =* redo-loop $ + =. gen sap + =. loop.gen (~(dif by loop.gen) nop) + =| j=@ud + |- ^- [? lore] + =* need-loop $ + =/ wap want.gen + =. gen + %- ~(rep by loop.gen) + |= [[c=@hail t=@hail s=sock l=naan] =_gen] + ^- _gen + =/ teed=cape (~(gut by want.gen) t |) + =? want.gen ?!(.=(| teed)) + %- (~(uno by want.gen) (~(due qui prot.l) teed)) + |=([@hail a=cape b=cape] ~(cut ca (~(uni ca a) b))) + gen + ?. =(wap want.gen) + ~? !=(0 j) [%mend-need i=i j=j] + need-loop(j +(j)) + =/ nap nop + =. nop + %- ~(rep by loop.gen) + |= [[c=@hail t=@hail s=sock l=naan] =_nop] + =/ teed (~(gut by want.gen) t |) + =. s (~(app ca teed) s) + :: XX log non pseudo-recursive + ?. (~(huge so s) sock.l) (~(put by nop) c *[t=@hail s=sock l=naan]) + nop + ?. =(nap nop) + ~& [%mend-redo i=i j=j] + redo-loop(i +(i)) + [?=(~ nop) gen] + :: + :: +seal: finalize analysis (including recursive descendants) + :: + :: XX: refactor + :: + ++ seal + ~/ %seal + |= [entr=@hail sane=? wise=(list @hail)] + ^- lore + => :: XX also log kid + !@(call.verb ((outa:blot ">3 " entr seat.dad area.gen) .) .) + :: ~? ?=([* * *] wise) wise=(tail (flop wise)) + ?> =(entr (rear wise)) :: current callsite should be last item of finalization list + %+ roll wise + |= [site=@hail =_gen] + =/ kid (~(get ju kids.gen) site) + :: ~? !=(~ kid) [site=site `kid=(set @hail)`kid] + =+ (~(got by call.gen) site) + ?> ?=(^ load) + =/ want=cape (~(gut by want.gen) site |) + =/ sutt + =/ such + %- ~(uni ca want) + (~(gut by (~(due qui prot.more) cape.sock.more)) site |) + ~(norm so (~(app ca such) sock.less)) + =? memo.gen ?&(rect sane) + =/ have (~(rel qui prot.more) site cape.sock.more) + (~(add ja memo.gen) form [sutt want sock.more have area]) + =. melo.gen + ?~ mel=(~(get by melo.gen) form) + melo.gen + =/ lit (skip u.mel |=([^ lite=@hail *] =(site lite))) + :: =+ [len nel]=[(lent lit) (lent u.mel)] + :: ~? !=(len nel) [%del-melo nel len] + ?: =(~ lit) + (~(del by melo.gen) form) + (~(put by melo.gen) form lit) + :: + =/ soot + => [s=sock.less w=want so=so ca=ca] + ~+ ~(norm so (~(app ca w) s)) + =^ [ices=(map @hail [=sock form=*]) lope=(set [=sock form=*])] gen + %- ~(rep in kid) + |= [k=@hail [ices=(map @hail [=sock form=*]) lope=(set [=sock form=*])] =_gen] + =/ rem (~(get by remo.gen) k) + =/ n ?~(rem k site.u.rem) + =/ m t:(~(gut by loop.gen) k [t=n s=*sock l=*naan]) + =/ w=cape (~(gut by want.gen) m |) + =/ c (~(got by call.gen) m) :: XX would crash on mend-redo? + =/ s + => [s=sock.less.c w=w so=so ca=ca] + ~+ ~(norm so (~(app ca w) s)) + :: + ~| %ices-melo-sock-nest + ?> ?| ?=(~ rem) + (~(huge so s) (~(app ca w) sock.u.rem)) + == + =. ices (~(put by ices) k [s form.c]) + =? lope ?!(.=(m n)) (~(put in lope) [s form.c]) + [[ices lope] gen] + :: trim want/call/loop tables + =. gen + %- ~(rep in kid) + |= [k=@hail =_gen] + ?: (~(has by loop.gen) k) + ?< (~(has by remo.gen) k) + ?< (~(has by call.gen) k) + gen(want (~(del by want.gen) k), loop (~(del by loop.gen) k)) + :: + ?~ rem=(~(get by remo.gen) k) + =/ lac (~(got by call.gen) k) + ?^ remos.lac gen + gen(want (~(del by want.gen) k), call (~(del by call.gen) k)) + :: + ?< (~(has by call.gen) k) + =. gen + ?~ lac=(~(get by call.gen) site.u.rem) + ~& [%missing-call k=k rem=site.u.rem] + gen + ?^ mos=(~(del in remos.u.lac) site) :: XX explain + gen(call (~(put by call.gen) site.u.rem u.lac(remos mos))) + gen(want (~(del by want.gen) site.u.rem), call (~(del by call.gen) site.u.rem)) + gen(want (~(del by want.gen) k), remo (~(del by remo.gen) k)) + + =/ hiss (~(get ju hint.gen) site) + =^ fizz gen + %- ~(rep in hiss) + |= [h=@hint fizz=(map @hint *) gen=_gen] + =. fizz (~(put by fizz) h (~(got by forb.gen) h)) + :: trim forb table + =. forb.gen (~(del by forb.gen) h) + [fizz gen] + :: trim kids and hint tables + =. kids.gen (~(del by kids.gen) site) + =. hint.gen (~(del by hint.gen) site) + =/ loan (~(get ja moan.gen) form) + =? moan.gen (levy loan |=([ss=sock *] !=(soot ss))) + (~(add ja moan.gen) form [soot u.load ices lope fizz seat.dad area.gen]) + gen + :: + :: +scan: statefully analyze formula against subject + :: + ++ scan + ~/ %scan + |= queu=i=todo + ^- [naan lore] + =^ entr gen [rail.gen gen(rail .+(rail.gen))] :: initial callsite + :: ~> %bout.[0 `tank`?.(?=(^ calm.i.queu) %raw [%rose [": " ~ ~] leaf+['+' (scow %ud +.j.u.calm.i.queu)] (smyt -.j.u.calm.i.queu) ~])] + =/ less=naan [~ soot.i.queu] :: subject + =* form form.i.queu :: formula + =. dad + %= dad + sirs (~(add ja ^+(sirs.dad ~)) form [entr less]) + lord ~ + tack ~[entr] + wake ~ + seat ~ + == + :: wrapper for callsite formulas + |- ^- [naan _gen] + =* arm-loop $ + =. prot.less (~(tag qui prot.less) [entr 1]) + =. wait.gen (~(add ja wait.gen) entr entr) + :: check if memoized + ?^ m=(memo entr form less) u.m + ?^ m=(melo entr form less) u.m + :: + =^ [load=nomm more=naan] gen + :: structurally recur over formula + => !@(call.verb ((into:blot ">> " entr seat.dad) .) .) + |- ^- [[=nomm =naan] _gen] + ?+ form [[[%not 0] [~ | ~]] gen] + [b=^ c=*] + =^ [leno=nomm lire=naan] gen $(form b.form) + =^ [reno=nomm rile=naan] gen $(form c.form) + :_ gen + :- [%par leno reno] + [(~(con qui prot.lire) prot.rile) (~(knit so sock.lire) sock.rile)] + :: + [%0 axe=@] + ?: =(0 axe.form) [[[%not 0] [~ | ~]] gen] + :_ gen + :+ [%not axe.form] + (~(ask qui prot.less) axe.form) + (~(pull so sock.less) axe.form) + :: + [%1 n=*] + [[[%one n.form] [~ & n.form]] gen] + :: + [%2 s=* f=*] + =^ roil gen [rail.gen gen(rail .+(rail.gen))] + =/ area area.gen + =: wake.dad ~ + seat.dad ?~(wake.dad ~ `i.wake.dad) + == + =^ [sown=nomm sand=naan] gen $(form s.form, area.gen ~) + =^ [fond=nomm fork=naan] gen $(form f.form, area.gen ~) + ?. =(& cape.sock.fork) + :: indirect call + => !@(call.verb ((outa:blot "<4 " roil seat.dad ~) .) .) + [[[%two sown fond roil] [~ | ~]] gen(dire |, area area)] + :: direct call + =. kids.gen (~(put ju kids.gen) entr roil) + :: record need + =/ pant (~(due qui prot.fork) &) :: callsite provenance by needs + =. want.gen + %- (~(uno by want.gen) pant) + |= [@hail a=cape b=cape] + ~(cut ca (~(uni ca a) b)) + :: check for recursion + ?^ l=(loop roil fork sand) + [[[%two sown fond roil] [~ | ~]] u.l(area area)] + :: not recursive + :: analyze through direct call + =/ dire dire.gen + =^ more gen + %= arm-loop + form data.sock.fork + less sand + entr roil + gen gen(dire &, area ~) + dad %= dad + sirs (~(add ja sirs.dad) data.sock.fork [roil sand]) + lord (~(put in lord.dad) entr) + tack [roil tack.dad] + == == + :- [[%two sown fond roil] more] + gen(dire &(dire dire.gen), area area) + :: + [%3 c=*] + =^ [knob=nomm mild=naan] gen $(form c.form) + :_ gen + [[%the knob] [~ | ~]] + :: + [%4 c=*] + =^ [knob=nomm mild=naan] gen $(form c.form) + :_ gen + [[%for knob] [~ | ~]] + :: + [%5 l=* r=*] + =^ [leno=nomm lire=naan] gen $(form l.form) + =^ [reno=nomm rile=naan] gen $(form r.form) + :_ gen + [[%ivy leno reno] [~ | ~]] + :: + [%6 c=* t=* f=*] + =^ [xeno=nomm mild=naan] gen $(form c.form) + =^ [zero=nomm thin=naan] gen $(form t.form) + =^ [once=nomm fast=naan] gen $(form f.form) + :_ gen + :- [%six xeno zero once] + :- (~(int qui prot.thin) prot.fast) + (~(purr so sock.thin) sock.fast) + :: + [%7 b=* c=*] + =^ [anon=nomm mean=naan] gen $(form b.form) + =^ [then=nomm salt=naan] gen $(form c.form, less mean) + :_ gen + [[%eve anon then] salt] + :: + [%8 b=* c=*] + ?@ b.form $(form [7 [[0 0] 0 1] c.form]) + $(form [7 [b.form 0 1] c.form]) + :: + [%9 b=@ c=*] + $(form [7 c.form 2 [0 1] 0 b.form]) + :: + [%10 [a=@ p=*] b=*] + ?: =(0 a.form) [[[%not 0] [~ | ~]] gen] + =^ [twig=nomm bite=naan] gen $(form p.form) + =^ [tree=nomm hole=naan] gen $(form b.form) + :_ gen + :+ [%ten a.form twig tree] + (~(put qui prot.hole) a.form prot.bite) + (~(darn so sock.hole) a.form sock.bite) + :: + [%11 h=@ f=*] + =^ [then=nomm bite=naan] gen $(form f.form) + [[[%sip h.form then] bite] gen] + :: + [%11 [h=@ v=*] f=*] + =^ hare gen [hare.gen gen(hare .+(hare.gen))] + =^ [vice=nomm mild=naan] gen $(form v.form) + :: + :: XX !@ on call.verb? + :: + => =/ pot=(unit spot) + ?.(=(%spot h.form) ~ ((soft spot) data.sock.mild)) + ?~ pot + + %_ + + wake.dad [u.pot wake.dad] + area.gen ?~(area.gen pot area.gen) + == + :: + =^ [then=nomm bite=naan] gen $(form f.form) + :: save body formula + =. hint.gen (~(put ju hint.gen) entr hare) + =. forb.gen (~(put by forb.gen) hare f.form) + :- [[%tip h.form vice then hare] bite] + (hint h.form mild bite) + :: + [%12 r=* p=*] + =^ [rend=nomm rita=naan] gen $(form r.form) + =^ [pond=nomm walk=naan] gen $(form p.form) + [[[%elf rend pond] [~ | ~]] gen] + == + :: + =. prot.more (~(cut qui prot.more) lord.dad cape.sock.more) + :- more + :: write to call table + =. call.gen (~(put by call.gen) entr [less more form `load dire.gen ~ seat.dad area.gen]) + =/ wise (~(get ja wait.gen) entr) + =. wait.gen (~(del by wait.gen) entr) + ?: =(~ wise) + :: no finalizing here + gen(melo (bide entr form less more)) + :: fixed-point loops to propagate their needs and check that they are really loops + =^ sane=? gen mend + :: finalize waiting callsites + (seal entr sane wise) + -- +:: +:: Analyze a subject/formula pair +++ rout + ~/ %rout + |= [soot=* form=*] + =/ colt cole + =/ queu=(list todo) [[& soot] form ~]~ + =| back=(list todo) + :: analysis queue: first the actual subject/formula pair, + :: then formulas from batteries of any new cold-state registrations + |- ^- _thus + =* cold-loop $ + =/ gnat ((dif-ju core.cole) core.colt) + =. colt cole + =. back + :: queue unanalyzed cold-state batteries + :: (shortest-path first gives a rough topo-sort) + :: + %+ roll + %+ sort + %+ turn ~(tap by gnat) + |=([p=path q=(set sock)] [(lent p) p q]) + |=([l=[len=@ *] r=[len=@ *]] (lth len.l len.r)) + |: [[len=*@ p=*path q=*(set sock)] b=back] + %- ~(rep in q) + |: [s=*sock b=b] + =/ batt (~(pull so s) 2) + ?. =(& cape.batt) ~& [%cold-miss-batt p] b + :: split up battery at autocons sites + =* f data.batt + =/ a=@ 1 + |- ^- _b + ?. ?=([^ *] f) + [[s f `[| p a]] b] + =. b $(f -.f, a (peg a 2)) + =. b $(f +.f, a (peg a 3)) + [[s f `[& p a]] b] + ?~ queu + ?~ back thus + ~& [%cold-loop (lent back)] + cold-loop(queu (flop back), back ~) + :: finish analysis of an autocons from a cold-state battery + ?: ?&(?=(^ calm.i.queu) auto.u.calm.i.queu) + =* j j.u.calm.i.queu + =/ balk=(list [sock *]) ~(tap in (~(get ju back.cole) [-.j (peg +.j 2)])) + =/ bark=(list [sock *]) ~(tap in (~(get ju back.cole) [-.j (peg +.j 3)])) + ?> ?=(^ form.i.queu) + |- ^- _thus + =* balk-loop $ + ?~ balk cold-loop(queu t.queu) + ?. =(-.form.i.queu +.i.balk) balk-loop(balk t.balk) + ?. (~(huge so -.i.balk) soot.i.queu) balk-loop(balk t.balk) + =/ bart bark + |- ^- _thus + =* bart-loop $ + ?~ bart balk-loop(balk t.balk) + ?. =(+.form.i.queu +.i.bart) bart-loop(bart t.bart) + ?. (~(huge so -.i.bart) soot.i.queu) bart-loop(bart t.bart) + =/ soot (~(pack so -.i.balk) -.i.bart) + =. call.cole (~(put by call.cole) [soot form.i.queu] j) + =. back.cole (~(put ju back.cole) j [soot form.i.queu]) + bart-loop(bart t.bart) + :: analyze a formula + =/ gen=lore +:(scan:snak i.queu) + %= cold-loop + queu t.queu + moan moan.gen + memo memo.gen + cole + ?~ calm.i.queu cole.gen + =/ boot + :_ form + =/ want (fall (~(get by want.gen) `@hail`0x0) |) :: first site is always 0x0 + => [s=soot.i.queu w=want so=so ca=ca] + ~+ ~(norm so (~(app ca w) s)) + =* pax j.u.calm.i.queu + %= cole.gen + call (~(put by call.cole.gen) boot pax) + back (~(put ju back.cole.gen) pax boot) + == + == +-- +=< +:: utilities +|% +:: +:: operations on provenance +++ qui + |_ prog=prot + :: + :: provenance tree for +axis + ++ ask + |= axe=@ + ?< =(0 axe) + =/ rev 1 + =| don=(list (pair @ (list peon))) + |- ^- prot + =+ [n l r]=?@(prog [~ ~ ~] prog) + ?. =(1 axe) + ?- (cap axe) + %2 $(axe (mas axe), don [[rev n] don], rev (peg rev 2), prog l) + %3 $(axe (mas axe), don [[rev n] don], rev (peg rev 3), prog r) + == + =. n + %+ roll don + |= [[axe=@ lit=(list peon)] out=_n] + ?: =(~ lit) out + =/ rel (hub axe rev) + %+ roll lit + |=([p=peon =_out] [p(axe (peg axe.p rel)) out]) + ?: ?&(?=(~ n) ?=(~ l) ?=(~ r)) ~ + [n l r] + :: + ++ put + |= [axe=@ poor=prot] + ?< =(0 axe) + ?: &(?=(~ prog) ?=(~ poor)) ~ + =| tack=(list [c=?(%2 %3) p=prot]) + |- ^- prot + ?. =(1 axe) + ?- (cap axe) + %2 $(axe (mas axe), prog hed, tack [[%2 tal] tack]) + %3 $(axe (mas axe), prog tal, tack [[%3 hed] tack]) + == + |- ^- prot + ?~ tack poor + ?- c.i.tack + %2 $(poor [~ poor p.i.tack], tack t.tack) + %3 $(poor [~ p.i.tack poor], tack t.tack) + == + ++ cut + |= [sire=(set @hail) =cape] + ^- prot + ?: |(?=(%| cape) ?=(~ prog)) ~ + =/ n (skim n.prog |=([s=@hail @] (~(has in sire) s))) + =+ [p q]=?@(cape [& &] cape) + =/ l $(prog l.prog, cape p) + =/ r $(prog l.prog, cape q) + ?: ?&(?=(~ n) ?=(~ l) ?=(~ r)) ~ + [n l r] + :: + :: provenance tree for +2 + ++ hed + ^- prot + ?~ prog ~ + =+ [n l r]=?@(l.prog [~ ~ ~] l.prog) + :_ [l r] + %+ roll n.prog + |=([p=peon out=_n] [p(axe (peg axe.p 2)) out]) + :: + :: provenance tree for +3 + ++ tal + ^- prot + ?~ prog ~ + =+ [n l r]=?@(r.prog [~ ~ ~] r.prog) + :_ [l r] + %+ roll n.prog + |=([p=peon out=_n] [p(axe (peg axe.p 3)) out]) + :: + :: provenance tree from two subtrees (cons) + ++ con + |= poor=prot + ^- prot + ?: &(?=(~ prog) ?=(~ poor)) ~ + [~ prog poor] + :: + :: provenance tree of intersection + ++ int + |= poor=prot + ^- prot + ?~ prog poor + ?~ poor prog + =/ n ~(tap in (~(gas in (~(gas in *(set peon)) n.poor)) n.prog)) + [n $(prog l.prog, poor l.poor) $(prog r.prog, poor r.poor)] + :: + :: add a label to the root + ++ tag + |= =peon + ?~ prog [~[peon] ~ ~] + prog(n [peon n.prog]) + :: + :: given a cape, distribute that cape to callsites by provenance + ++ due + !. + =/ unica |=([@hail a=cape b=cape] (~(uni ca a) b)) + |= cave=cape + ^- (map @hail cape) + ?: |(?=(%| cave) ?=(~ prog)) ~ + =/ n + %+ roll n.prog + |= [[s=@hail a=@] m=(map @hail cape)] + (~(put by m) s (~(pat ca cave) a)) + =+ [p q]=?@(cave [& &] cave) + =/ l $(prog l.prog, cave p) + =/ r $(prog r.prog, cave q) + ((~(uno by ((~(uno by l) r) unica)) n) unica) + :: + :: given a callsite produce a new provenance tree only retaining + :: provenance for that callsite's subject + ++ rel + |= [site=@hail =cape] + ^- plop + ?: |(?=(%| cape) ?=(~ prog)) ~ + =/ n (murn n.prog |=(p=peon ?:(=(site site.p) `axe.p ~))) + =+ [p q]=?@(cape [& &] cape) + =/ l $(prog l.prog, cape p) + =/ r $(prog r.prog, cape q) + ?: &(?=(~ l) ?=(~ r) ?=(~ n)) ~ + [n l r] + :: + :: relocate cached provenance + ++ rue + |= prop=plop + =| t=prot + |- ^- prot + ?~ prop t + =. t + %+ roll n.prop + |: [a=*@ t=t] + (int(prog (ask a)) t) + ?~ t + =/ l $(prop l.prop) + =/ r $(prop r.prop) + ?:(?&(?=(~ l) ?=(~ r)) ~ [~ l r]) + =/ l $(prop l.prop, t l.t) + =/ r $(prop r.prop, t r.t) + [n.t l r] + -- +:: +:: push down axes on a list of peons +++ pepe + |= [slav=(list peon) axe=@] + ^- _slav + %+ turn slav + |= =peon + peon(axe (peg axe.peon axe)) +:: +++ hub + :: ~/ %hub + :: axis after axis + :: + :: computes the remainder of axis {b} when navigating to {a}. + :: (crashes if not `(pin a b)`) + |= [a=@ b=@] + ?< =(0 a) + ?< =(0 b) + |- ^- @ + ?: =(a 1) b + ?> =((cap a) (cap b)) + $(a (mas a), b (mas b)) +:: +++ dif-ju + |* a=(jug) + |* b=_a + ^+ a + =/ c=_a (~(dif by a) b) + =/ i=_a (~(int by a) b) + ?: =(~ i) c + %- ~(rep by i) + |= [[p=_?>(?=(^ i) p.n.i) q=_?>(?=(^ i) q.n.i)] =_c] + =/ r=_q (~(get ju b) p) + =/ s=_q (~(dif in q) r) + ?: =(~ s) c + (~(put by c) p s) +:: +++ blot + |% + ++ ren + |= pot=spot + ^- tank + :+ %rose [":" ~ ~] + :~ (smyt p.pot) + =* l p.q.pot + =* r q.q.pot + =/ ud |=(a=@u (scow %ud a)) + leaf+"<[{(ud p.l)} {(ud q.l)}].[{(ud p.r)} {(ud q.r)}]>" + == + :: + ++ hal (cury scot %x) + :: + ++ one + |= [tap=tape ale=@hail pot=spot] + ^- tank + [%rose [": " tap ~] (hal ale) (ren pot) ~] + :: + ++ two + |= [tap=tape ale=@hail pot=spot top=spot] + ^- tank + :+ %rose [": " tap ~] + :~ (hal ale) + [%rose [" -> " ~ ~] (ren pot) (ren top) ~] + == + :: + ++ into + |= [tap=tape ale=@hail f=(unit spot)] + %- slog :_ ~ + :^ %rose + [": " tap ~] + (hal ale) + ?~ f ~ + [(ren u.f) ~] + :: + ++ outa + |= [tap=tape ale=@hail f=(unit spot) t=(unit spot)] + ?~ t + (into tap ale f) + %- slog :_ ~ + :+ %rose [": " tap ~] + :~ (hal ale) + [%rose [" -> " ~ ~] ?~(f '??' (ren u.f)) (ren u.t) ~] + == + :: + ++ onto + |= $: tap=tape + ale=@hail + s=(unit spot) + ole=@hail + f=(unit spot) + t=(unit spot) + == + %- slog :_ ~ + :^ %rose + [": " tap ~] + (hal ale) + ?~ s ~ + :+ (ren u.s) + (hal ole) + ?: |(?=(~ f) ?=(~ t)) ~ + [[%rose [" -> " ~ ~] (ren u.f) (ren u.t) ~] ~] + -- +-- +:: utility types +:: +|% +:: +:: abstract noun with provenance ++$ naan [=prot =sock] +:: +:: abstract noun with local provenance ++$ noon [=plop =sock] +:: +:: callsite information ++$ cafe (map @hail [less=naan more=naan form=* load=(unit nomm) rect=? remos=(set @hail) seat=(unit spot) area=(unit spot)]) +:: +:: subject requirements for callsites ++$ urge (map @hail cape) +:: +:: individual provenance tag: callsite and subject axis ++$ peon [site=@hail axe=@] +:: +:: provenance information to go with a sock ++$ prot (tree (list peon)) +:: +:: single-site provenance tree (axes only, no callsites) ++$ plop (tree (list @)) +:: +:: analysis queue entry ++$ todo + $: soot=sock + form=* + calm=(unit [auto=? j=[path @]]) + == +:: +:: analysis memoization entry ++$ meme [soot=sock want=cape root=sock have=plop area=(unit spot)] +:: +:: loop-local analysis memoization entry +:: XX skip meal, remove [soot] and [want] ++$ meal [meme site=@hail less=naan seat=(unit spot) loom=(list [c=@hail t=@hail s=sock n=noon])] +-- diff --git a/hoon/codegen/lib/sky.hoon b/hoon/codegen/lib/sky.hoon deleted file mode 100644 index 9266db44..00000000 --- a/hoon/codegen/lib/sky.hoon +++ /dev/null @@ -1,132 +0,0 @@ -/- *sock -/+ ska -|% -:: mask axes in a noun to make a sock -++ dope - |= [mask=(list @) non=noun] - ^- boot - =/ sack=boot [%safe %know non] - |- - ^- boot - ?~ mask sack - $(sack (welt:ska i.mask [%safe %toss ~] sack), mask t.mask) -:: turn a hoon type into a boot -++ wove - |= kine=type - ^- boot - =| gil=(set type) - ?@ kine - ?- kine - %noun [%risk %toss ~] - %void [%boom ~] - == - ?- -.kine - %atom - ?~ q.kine - [%risk %dice ~] - [%risk %know u.q.kine] - :: - %cell - (cobb:ska $(kine p.kine) $(kine q.kine)) - :: - %core - %+ cobb:ska - (spry p.r.q.kine) :: compiled battery - $(kine p.kine) :: current payload - :: - %face - $(kine q.kine) - :: - %fork - =/ tins ~(tap in p.kine) - ?~ tins [%boom ~] - =/ hypo $(kine i.tins) - =/ tons t.tins - |- - ^- boot - ?~ tons hypo - $(hypo (gnaw:ska ^$(kine i.tons) hypo), tons t.tons) - :: - %hint - $(kine q.kine) - :: - %hold - ?: (~(has in gil) kine) - [%risk %toss ~] - $(gil (~(put in gil) kine), kine ~(repo ut kine)) - == -:: turn a seminoun into a sock -++ spry - |= seminoun - ^- boot - ?- -.mask - %half - ?> ?=(^ data) - (cobb:ska $(mask left.mask, data -.data) $(mask rite.mask, data +.data)) - :: - %full - ?~ blocks.mask - [%risk %know data] - [%risk %toss ~] - :: - %lazy - [%risk %toss ~] - == -:: for a stateful core, figure out what we can assume across all state -:: transitions -:: -:: step is a list of arm axes and result axes which are expected to produce gates -:: the gates will be simul-slammed with %toss -:: then the result axis will be intersected with the stateful core -:: knowledge -:: -:: fixed point termination argument: we can only know the same or less -:: than what we knew last time (intersection cannot add knowledge) -:: if we know the same, we stop now. We can only subtract finitely many -:: axes of knowledge from the tree before we know [%boom ~] or -:: [%risk %toss ~] at which point we will learn the same thing twice -:: and terminate -++ arid - |= [muck=boot step=(list [@ @])] - ^- boot - =/ yuck muck - =/ stop step - ?: ?=(%boom -.muck) - [%boom ~] - |- - ^- boot - ?~ stop - ?: =(yuck muck) - yuck - ^$(muck yuck) - =/ erm (yank:ska -.i.stop muck) - ?: ?=(%boom -.erm) - $(stop t.stop, yuck (gnaw:ska [%boom ~] yuck)) - =/ arm (trip:ska erm) - ?~ arm - $(stop t.stop, yuck (gnaw:ska [%risk %toss ~] yuck)) - =/ cor - ?- -.muck - %safe sure.muck - %risk hope.muck - == - =/ mat (wash:ska cor u.arm) - ?: ?=(%boom -.mat) - $(stop t.stop, yuck (gnaw:ska [%boom ~] yuck)) - =/ ear (yank:ska 2 mat) - ?: ?=(%boom -.ear) - $(stop t.stop, yuck (gnaw:ska [%boom ~] yuck)) - =/ gar (trip:ska ear) - ?~ gar - $(stop t.stop, yuck (gnaw:ska [%risk %toss ~] yuck)) - =/ mar (welt:ska 6 [%risk %toss ~] mat) - ?: ?=(%boom -.mar) - $(stop t.stop, yuck (gnaw:ska [%boom ~] yuck)) - =/ gor - ?- -.mar - %safe sure.mar - %risk hope.mar - == - =/ beg (wash:ska gor u.gar) - $(stop t.stop, yuck (gnaw:ska (yank:ska +.i.stop beg) yuck)) --- diff --git a/hoon/codegen/lib/soak.hoon b/hoon/codegen/lib/soak.hoon new file mode 100644 index 00000000..7d68dcd1 --- /dev/null +++ b/hoon/codegen/lib/soak.hoon @@ -0,0 +1,341 @@ +/- sock +|. +=> $:sock +|% +:: operations on $cape +++ ca + |_ one=cape + :: axes of yes + :: + :: list all axes of %.y in a cape + ++ cut + ^- cape + ?- one + %| | + %& & + ^ + =/ l cut(one -.one) + =/ r cut(one +.one) + ?: ?&(=(| l) =(| r)) | + ?: ?&(=(& l) =(& r)) & + [l r] + == + ++ yea + ^- (list @) + =/ axe 1 + |- ^- (list @) + ?- one + %| ~ + %& ~[axe] + ^ (weld $(one -.one, axe (peg axe 2)) $(one +.one, axe (peg axe 3))) + == + :: cape intersection + :: + :: intersect two capes + ++ int + |= two=cape + ^- cape + ?- one + %| %| + %& two + ^ + ?- two + %| %| + %& one + ^ + =/ l $(one -.one, two -.two) + =/ r $(one +.one, two +.two) + ?:(?&(?=(@ l) =(l r)) l [l r]) + == + == + :: apply a cape as a mask to a sock + :: + :: mask unknown axes in a cape out of a sock + ++ app + |= know=sock + |- ^- sock + ?- one + %| [%| ~] + %& know + ^ + ?: ?=(%| cape.know) [%| ~] + ?> ?=(^ data.know) + ?: ?=(^ cape.know) + =/ l $(one -.one, cape.know -.cape.know, data.know -.data.know) + =/ r $(one +.one, cape.know +.cape.know, data.know +.data.know) + [[cape.l cape.r] data.l data.r] + =/ l $(one -.one, data.know -.data.know) + =/ r $(one +.one, data.know +.data.know) + [[cape.l cape.r] data.l data.r] + == + :: union two capes + :: + :: + ++ uni + |= two=cape + ^- cape + ?- one + %& & + %| two + ^ + ?- two + %& & + %| one + ^ + =/ l $(one -.one, two -.two) + =/ r $(one +.one, two +.two) + ?:(?&(?=(@ l) =(l r)) l [l r]) + == + == + :: Added axes? + :: + :: big returns true if any subaxis of a masked axis in one + :: is unmasked in two. Note that this is not an ordering relation as + :: it is not antisymmetric + ++ big + |= two=cape + ^- ? + ?- one + %& | + %| ?@(two two ?|($(two -.two) $(two +.two))) + ^ + ?@ two ?|($(one -.one) $(one +.one)) + ?|($(one -.one, two -.two) $(one +.one, two +.two)) + == + :: non-null? + :: + :: true if there are any unmasked axes + ++ any + ^- ? + ?@ one one + ?|(any(one -.one) any(one +.one)) + :: push a cape down to an axis + :: + :: this builds a path described by the input axis with one at the + :: bottom + ++ pat + |= axe=@ + ?< =(0 axe) + |- ^- cape + ?: =(1 axe) one + ?- (cap axe) + %2 [$(axe (mas axe)) |] + %3 [| $(axe (mas axe))] + == + :: split a cape + :: + :: assume a cape will be applied to a cell, + :: and provide capes for the head and tail of the cell. + ++ rip + ^- [cape cape] + ?- one + %| [| |] + %& [& &] + ^ one + == + :: poke a hole in a cape + :: + :: mask an axis out of a cape, and return a cape + :: describing which subaxes were unmasked + ++ awl + |= axe=@ + ?< =(0 axe) + |- ^- [cape cape] + ?: ?=(%| one) [| |] + ?: =(1 axe) [one |] + ?- (cap axe) + %2 + ?- one + %& + =/ [p=cape t=cape] $(axe (mas axe)) + [p t &] + :: + ^ + =/ [p=cape t=cape] $(axe (mas axe), one -.one) + [p t +.one] + == + :: + %3 + ?- one + %& + =/ [p=cape t=cape] $(axe (mas axe)) + [p & t] + :: + ^ + =/ [p=cape t=cape] $(axe (mas axe), one +.one) + [p -.one t] + == + == + -- +:: operations on sock +++ so + |_ one=sock + :: valid? + ++ apt + |- ^- ? + ?@ cape.one + & + ?@ data.one + | + ?& $(cape.one -.cape.one, data.one -.data.one) + $(cape.one +.cape.one, data.one +.data.one) + == + :: normalize + :: throw away unknown axes in data (setting to ~) + ++ norm + |- ^- sock + ?- cape.one + %| [%| ~] + %& one + ^ + ?> ?=(^ data.one) + =/ l $(cape.one -.cape.one, data.one -.data.one) + =/ r $(cape.one +.cape.one, data.one +.data.one) + ?: ?&(=(& cape.l) =(& cape.r)) + [& data.l data.r] + ?: ?&(=(| cape.l) =(| cape.r)) + [| ~] + [[cape.l cape.r] data.l data.r] + == + :: nesting + :: + :: roughly, 1 < 2 + :: + :: every axis known in one is also known in 2, with equal data + ++ huge + |= two=sock + ^- ? + ?| =(one two) + ?@ data.one + ?. ?=(@ cape.one) ~| badone+one !! + ?. cape.one & + ?&(?=(@ cape.two) cape.two =(data.one data.two)) + ?@ data.two ?>(?=(@ cape.two) |) + =/ [lope=cape rope=cape] ?:(?=(^ cape.one) cape.one [cape.one cape.one]) + =/ [loop=cape roop=cape] ?:(?=(^ cape.two) cape.two [cape.two cape.two]) + ?& $(one [lope -.data.one], two [loop -.data.two]) + $(one [rope +.data.one], two [roop +.data.two]) + == + == + :: axis + :: + :: create a sock that, if known, has cells down the given axis + :: and at that axis is one + ++ pull + |= axe=@ + ?< =(0 axe) + |- ^- sock + ?: =(1 axe) one + ?: |(?=(%| cape.one) ?=(@ data.one)) + [| ~] + =+ [now lat]=[(cap axe) (mas axe)] + ?@ cape.one + ?- now + %2 $(axe lat, data.one -.data.one) + %3 $(axe lat, data.one +.data.one) + == + ?- now + %2 $(axe lat, data.one -.data.one, cape.one -.cape.one) + %3 $(axe lat, data.one +.data.one, cape.one +.cape.one) + == + :: pair + :: + :: takes a pair of socks to a sock of a pair. + ++ knit + |= two=sock + ^- sock + =* l cape.one + =* r cape.two + :- ?:(&(?=(@ l) =(l r)) l [l r]) + [data.one data.two] + :: intersect + :: + :: output is unmasked only where both one and two are unmasked and + :: they both agree in data + ++ purr + |= two=sock + |- ^- sock + ?^ data.one + ?@ data.two ?>(?=(@ cape.two) [| ~]) + ?^ cape.one + ?^ cape.two + %- %~ knit so + $(one [-.cape.one -.data.one], two [-.cape.two -.data.two]) + $(one [+.cape.one +.data.one], two [+.cape.two +.data.two]) + ?. cape.two [| ~] + %- %~ knit so + $(one [-.cape.one -.data.one], data.two -.data.two) + $(one [+.cape.one +.data.one], data.two +.data.two) + ?. cape.one [| ~] + ?^ cape.two + %- %~ knit so + $(data.one -.data.one, two [-.cape.two -.data.two]) + $(data.one +.data.one, two [+.cape.two +.data.two]) + ?. cape.two [| ~] + ?: =(data.one data.two) one :: optimization? + %- %~ knit so + $(data.one -.data.one, data.two -.data.two) + $(data.one +.data.one, data.two +.data.two) + ?> ?=(@ cape.one) + ?^ data.two [| ~] + ?> ?=(@ cape.two) + ?: =(data.one data.two) one [| ~] + :: union + :: + :: take the union of two socks, but crash if they disagree on a known + :: axis + ++ pack + |= two=sock + |- ^- sock + ?: ?=(%| cape.one) two + ?: ?=(%| cape.two) one + ?: ?=(%& cape.one) ?>((~(huge so one) two) one) + ?: ?=(%& cape.two) ?>((~(huge so two) one) two) + ?> ?=(^ data.one) + ?> ?=(^ data.two) + %- + %~ knit so + (pack(one [-.cape.one -.data.one]) [-.cape.two -.data.two]) + (pack(one [-.cape.one -.data.one]) [-.cape.two -.data.two]) + :: edit + :: + :: update mask and data at an axis into a sock + ++ darn + |= [axe=@ two=sock] + ?< =(0 axe) + |- ^- sock + ?: =(1 axe) two + =+ [now lat]=[(cap axe) (mas axe)] + ?^ cape.one + ?- now + %2 =/ n $(axe lat, one [-.cape -.data]:one) + [[cape.n +.cape.one] data.n +.data.one] + :: + %3 =/ n $(axe lat, one [+.cape +.data]:one) + [[-.cape.one cape.n] -.data.one data.n] + == + ?: &(cape.one ?=(^ data.one)) + ?- now + %2 =/ n $(axe lat, data.one -.data.one) + :- ?:(?=(%& cape.n) & [cape.n &]) + [data.n +.data.one] + :: + %3 =/ n $(axe lat, data.one +.data.one) + :- ?:(?=(%& cape.n) & [& cape.n]) + [-.data.one data.n] + == + =/ n $(axe lat) + ?- now + %2 [[cape.n |] data.n ~] + %3 [[| cape.n] ~ data.n] + == + -- +:: apt assertion +:: +:: assert a sock is apt:so +++ sap + |= know=sock + ?> ~(apt so know) + know +-- + diff --git a/hoon/codegen/lib/wink.hoon b/hoon/codegen/lib/wink.hoon new file mode 100644 index 00000000..13ea6057 --- /dev/null +++ b/hoon/codegen/lib/wink.hoon @@ -0,0 +1,308 @@ +|% +:: +:: run nock +:: +:: interpret nock, generating code for the outer invocation and any +:: indirect calls encountered. This should be considered the formal +:: entry point for Ares codegen +++ wink + =* thus . + |= [h=heat j=(map @ $-(* (unit))) p=$-(^ (unit (unit))) s=* f=*] + =* wink . + ^- [tone _this] + =/ hull (peek s f) + =? thus ?=(~ hull) this:(poke %comp ~ s f) + =? hull ?=(~ hull) (peek s f) + ?> ?=(^ hull) + =/ bell bell.u.hull + =* hill hall.u.hull + =| from=bile + =/ pyre (~(got by hill) bell) + =/ fram=[will=(map bile blob) regs=(map @uvre *) mean=(list [@ta *]) sick=(set @uvre)] + [will.pyre (~(put in *(map @uvre *)) sire.pyre s) *(list [@ta *]) *(set @uvre)] + =| tack=(list [then=bile r=@uvre _fram]) + =/ bloc (~(got by will.pyre) wish.pyre) + ~% %wink-loop wink ~ + |^ ^- [tone _this] + :: XX dedent + ?^ body.bloc + => |% + :: next instruction + ++ go $(body.bloc t.body.bloc) + -- + =* x i.body.bloc + ?- -.i.body.bloc + %imm + =. regs.fram (~(put by regs.fram) d.x n.x) + go + :: + %mov + =. regs.fram (~(put by regs.fram) d.x (r s.x)) + go + :: + %phi + |- ^- [tone _this] + ?^ s.x + ?. =(from -.i.s.x) + $(s.x t.s.x) + =. regs.fram (~(put by regs.fram) d.x (r +.i.s.x)) + go + ~| %bad-phi !! + :: + %inc + =/ a (r s.x) + ?@ a + =. regs.fram (~(put by regs.fram) d.x +(a)) + go + no + :: + %con + =. regs.fram (~(put by regs.fram) d.x [(r h.x) (r t.x)]) + go + :: + %cop + =? sick.fram ?=(@ (r s.x)) (~(put in sick.fram) s.x) + go + :: + %lop + =? sick.fram ?! ?=(? (r s.x)) (~(put in sick.fram) s.x) + go + :: + %coc + ?@ (r s.x) + no + go + :: + %hed + =/ c (r s.x) + =? sick.fram ?=(@ c) (~(put in sick.fram) s.x) + =? regs.fram ?=(^ c) (~(put by regs.fram) d.x -.c) + go + :: + %hci + =/ c (r s.x) + ?@ c + no + =. regs.fram (~(put by regs.fram) d.x -.c) + go + :: + %tal + =/ c (r s.x) + =? sick.fram ?=(@ c) (~(put in sick.fram) s.x) + =? regs.fram ?=(^ c) (~(put by regs.fram) d.x +.c) + go + :: + %tci + =/ c (r s.x) + ?@ c + no + =. regs.fram (~(put by regs.fram) d.x +.c) + go + :: + %men + =. mean.fram [[l.x (r s.x)] mean.fram] + go + :: + %man + ?> ?=(^ mean.fram) + $(mean.fram t.mean.fram) :: =. here would hit the TMI problem + :: + %sld + ~| %todo !! + :: + %slo + ~| %todo !! + :: + %hit + go + :: + %slg + ~& (r s.x) go + :: + :: XX need to feed in global cache from outside + :: mew and mer influence which code we actually run, which could + :: affect whether dynamic calls are made, which could influence + :: the state of the codegen core. + :: So we do need to handle them properly and not just ignore them + %mew + ~| %todo !! + :: + :: side-effect only + %tim + go + :: + :: side-effect only + %tom + go + :: + :: side-effect only + %mem + go + :: + %pol + =? sick.fram (~(has in sick.fram) s.x) (~(put in sick.fram) d.x) + go + :: + %poi + =. sick.fram (~(put in sick.fram) d.x) + go + :: + %ipb + |- ^- [tone _this] + ?^ s.x + ?: (~(has in sick.fram) i.s.x) no + $(s.x t.s.x) + go + == + =* x bend.bloc + => |% + :: jump to given bile + ++ goto |= =bile ^$(bloc (~(got by will.fram) bile)) + -- + ?- -.bend.bloc + %clq + ?^ (r s.x) + (goto z.x) + (goto o.x) + :: + %eqq + ?: =((r l.x) (r r.x)) + (goto z.x) + (goto o.x) + :: + %brn + =/ b (r s.x) + ?+ b no + %0 (goto z.x) + %1 (goto o.x) + == + :: + %hop + (goto t.x) + :: + %hip + =. from c.x + (goto t.x) + :: + %lnk + =/ s (r u.x) + =/ f (r f.x) + =/ hull (peek s f) + =? thus ?=(~ hull) this:(poke %comp ~ s f) + =? hull ?=(~ hull) (peek s f) + ?> ?=(^ hull) + =. hill hall.u.hull + =/ bell bell.u.hull + =/ pyre (~(got by hill) bell) + =. tack [[t.x d.x fram] tack] + =. sick.fram ~ + =. regs.fram (~(put by *(map @uvre *)) sire.pyre s) + =. will.fram will.pyre + (goto wish.pyre) + :: + %cal + =/ call-sick (turn b.x ~(has in sick.fram)) + =/ call-args (turn v.x r) + =/ pyre (~(got by hill) a.x) + =+ (args want.pyre call-sick call-args) + =. tack [[t.x d.x fram] tack] + =. sick.fram sick + =. regs.fram regs + =. will.fram will.pyre + (goto long.pyre) + :: + %caf :: XX check hot state rather than not in hill + ?. (~(has by hill) a.x) + =/ tore (mink [(r u.x) form.a.x] p) + ?- -.tore + %1 [tore this] + %2 no + %0 + =. regs.fram (~(put by regs.fram) d.x product.tore) + (goto t.x) + == + $(bend.bloc [%cal [a b v d t]:x]) + :: + %lnt + =/ s (r u.x) + =/ f (r f.x) + =/ hull (peek s f) + =? thus ?=(~ hull) this:(poke %comp ~ s f) + =? hull ?=(~ hull) (peek s f) + ?> ?=(^ hull) + =. hill hall.u.hull + =/ bell bell.u.hull + =/ pyre (~(got by hill) bell) + =. sick.fram ~ + =. regs.fram (~(put by *(map @uvre *)) sire.pyre s) + =. will.fram will.pyre + (goto wish.pyre) + :: + %jmf :: XX check hot state rather than not in hill + ?. (~(has by hill) a.x) + =/ tore (mink [(r u.x) form.a.x] p) + ?- -.tore + %1 [tore this] + %2 no + %0 [tore this] + == + $(bend.bloc [%jmp [a b v]:x]) + :: + %jmp + =/ call-sick (turn b.x ~(has in sick.fram)) + =/ call-args (turn v.x r) + =/ pyre (~(got by hill) a.x) + =+ (args want.pyre call-sick call-args) + =. sick.fram sick + =. regs.fram regs + =. will.fram will.pyre + ~_ (~(vals xray will.fram) regs.fram) + (goto long.pyre) + :: + %spy + ~| %todo !! + :: + :: XX we need to pass persistent caches in + %mer + ~| %todo !! + :: + %don + ?^ tack + =. regs.i.tack (~(put by regs.i.tack) r.i.tack (r s.x)) + =. fram +>.i.tack + =/ then then.i.tack + $(bloc (~(got by will.fram) then), tack t.tack) + [[%0 (r s.x)] this] + :: + %bom no + == + :: + :: get register value + ++ r |=(x=@uvre ~_((~(gals xray will.fram) x regs.fram) (~(got by regs.fram) x))) + :: + :: crash with the mean stack + ++ no [[%2 mean.fram] this] + :: + :: match up call arguments + ++ args + |= [=need call-sick=(list ?) call-args=(list *)] + =| [sick=(set @uvre) regs=(map @uvre *)] + =/ tack=(list _need) ~[need] + |- ^- [sick=(set @uvre) regs=(map @uvre *)] + ?~ tack + [sick regs] + ?- -.i.tack + %both + ?> ?=(^ call-sick) + =? sick i.call-sick (~(put in sick) sass.i.tack) + $(tack [left.i.tack rite.i.tack t.tack], call-sick t.call-sick) + :: + %this + ?> ?=(^ call-args) + =. regs (~(put by regs) sass.i.tack i.call-args) + $(tack t.tack, call-args t.call-args) + :: + %none $(tack t.tack) + == + -- +-- diff --git a/hoon/codegen/sur/gene.hoon b/hoon/codegen/sur/gene.hoon index 3cca2f0c..83724d58 100644 --- a/hoon/codegen/sur/gene.hoon +++ b/hoon/codegen/sur/gene.hoon @@ -1,94 +1,227 @@ -/- *sock +/+ skan +|. +=> $:skan |% -+| %ska -+$ barn [sub=sock for=*] -+$ nomm :: SKA-analyzed nock - $~ [%one **] - $% [%par nomm nomm] - [%zer @ ?] :: safety-tagged lookup - [%one *] - [%two nomm nomm sock (unit *) ?] :: subject knowledge and known formula, safety-tag on metaformula - [%thr nomm] - [%fou nomm ?] :: safety-tagged increment - [%fiv nomm nomm] - [%six nomm nomm nomm] - [%sev nomm nomm] - :: we omit 8, translating it to 7 + autocons - :: we omit 9, translating it to 7 + 2 - [%ten [@ nomm] nomm ?] :: safety-tagged edit - [%els @ nomm] - [%eld [@ nomm] nomm ?] :: safety-tagged hint formula - [%twe nomm nomm] +:: +:: hot state +:: +:: faces (per element): +:: j - jet ID +:: p - path +:: a - battery axis +:: need - how this jet expects the subject ++$ heat + (list [p=path a=@ j=@jet =need]) +:: +:: pokes +:: +:: the codegen core can be updated by asking it to analyze new code ++$ gist [%comp slow=path s=* f=*] + +:: slow hint tree ++$ shed $~ [~ ~] [root=(unit bell) kids=(map @tas shed)] +:: +:: external label +:: +:: labels an arm by what is known of its subject paired with its +:: formula ++$ bell [text=sock form=*] +:: +:: internal label +:: +:: labels a basic block within generated code for an arm ++$ bile [%bile axe=@ thus=@tas =bell] +:: noun shape +:: +:: labels axes of an abstract noun with SSA registers, possibly +:: ignoring some axes ++$ need + $% [%this sass=@uvre] + [%both sass=@uvre left=need rite=need] + [%none ~] == -+$ farm [yard=(map barn [does=nomm says=boot]) wood=(list barn)] -+| %lin -+$ berm [sub=sock for=* ax=@ gen=@tas] :: local label -+$ plow :: noun<->ssa map - $% [%fork left=plow rite=plow safe=?] :: cons of two mappings - [%tine @] :: use this SSA value at this axis - [%disc ~] :: no uses here or below +:: linear control flow +:: +:: a label for code for some nock, and the shape of its subject ++$ next $>(%next goal) +:: +:: destination +:: +:: codegen destination +:: +:: %pick: result will be used as a loobean for Nock 6 +:: %done: nock is in tail position, return result +:: %next: jump to given label with result in given $need ++$ goal + $% [%pick sass=@uvre zero=bile once=bile] + [%done ~] + [%next what=need then=bile] == -+$ line :: destination - $% [%moat wher=berm what=plow] :: place result in SSA values specified by what, go wher - [%rift troo=berm fals=berm] :: branch on result - [%pond ~] :: tail position, return result in a register +:: +:: instructions in a block +:: +:: note: the slow and mean stack instructions assume that non-tail +:: calls ($site cases %lnk %cal %caf) save the current state of the +:: mean stack, and %don restores it. This allows us to omit %man and +:: %sld popping instructions after the body of the relevant hints in +:: tail position, maintaining TCO in the presence of stack traces and +:: analysis boundary (%slow) hints. An implementation of this VM *must* +:: conform to this behavior. +:: +:: faces: +:: n - noun +:: d - destination +:: f - formula +:: h - head +:: k - key +:: l - label +:: r - result +:: s - source +:: t - tail +:: u - subject +:: +:: cases: +:: %imm - write immediate n to d +:: %mov - copy s to d +:: %phi - select source based on last %hip, copy to d +:: %inc - increment s and write to d? +:: %con - cons h and t into d +:: %coc - crash immediately if s is an atom +:: %hed - write head of s to d. Poison s if s is an atom +:: %tal - write tail of s to d. Poison s if s is an atom +:: %men - Push s onto the mean stack. +:: %man - Pop the mean stack +:: %slo - Push s onto the slow stack. +:: %sld - Pop from the slow stack +:: %hit - Increment a profiling hit counter labeled with the noun in s +:: %slg - Print out s for debugging +:: %mew - Write r to the memo cache at the triple [k u f] +:: %tim - Push a timer onto the timer stack and start it +:: %tom - Pop a timer from the timer stack, stop it, and print elapsed +:: %mem - Print memory usage +:: %poi - Poison d +:: %ibp - If any register in s is poisoned, crash. ++$ pole + $% [%imm n=* d=@uvre] + [%mov s=@uvre d=@uvre] + [%inc s=@uvre d=@uvre] + [%con h=@uvre t=@uvre d=@uvre] + [%hed s=@uvre d=@uvre] + [%tal s=@uvre d=@uvre] + [%men l=@ta s=@uvre] + [%man ~] + [%slo s=@uvre] + [%sld ~] + [%hit s=@uvre] + [%slg s=@uvre] + [%mew k=@uvre u=@uvre f=@uvre r=@uvre] + [%tim ~] + [%tom ~] + [%mem ~] + [%poi p=@uvre] + [%ipb p=(list @uvre)] == -+$ bran :: instructions in a block - $% [%imm * @] :: Write a noun to an SSA value - [%mov @ @] :: Copy an SSA value - [%inc @ @] :: Define second SSA register as increment of first - [%unc @ @] :: Define a second SSA register as increment of first, without checking atomicity - [%con @ @ @] :: Construct a cell, first SSA head, second SSA tail, third SSA result - [%hed @ @] :: Take the head of first SSA and place in second. - :: Crash if first SSA not a cell - [%hud @ @] :: Take the head of the first SSA, known to be a cell - [%tal @ @] :: Take tail head of first SSA and place in second. - :: Crash if first SSA not a cell - [%tul @ @] :: Take the tail of the first SSA, known to be a cell +:: +:: origin description +:: +:: %hed - register is head of given register +:: %tal - register is tail of given register ++$ pool + $% [%hed s=@uvre] + [%tal s=@uvre] == -:: These instructions end a block. -:: A block ends either because we need to transfer control -:: elsewhere (hop), we need to branch (clq, eqq, brn), we need a saved -:: control point to return to (lnk, call, hnt, spy), or we are done and -:: transfering control to another arm (jmp, lnt), our caller (don), or -:: the crash handler (bom). -:: -:: The bec and eye instructions are intermediate forms only, and are -:: translated into cal and jmp respectively once enough information is -:: available about their targets. They exist because when linearizing -:: and registerizing (mutually) recursive arms, there will be some call -:: targets for which we do not know subject use maps and thus cannot yet -:: build calls to. Once all arms are registerized, we scan for bec and -:: eye and replace them with jmp and call with registers appropriately -:: split. -+$ germ :: instructions ending a block - $% [%clq @ berm berm] :: Branch left if the SSA value is a cell, right otherwise - [%eqq @ @ berm berm] :: Branch left if SSA registers are equal, right otherwise - [%brn @ berm berm] :: Branch left if SSA register is 0, right if 1 - [%hop berm] :: Go to berm unconditionally (local direct jump) - [%lnk @ @ @ berm] :: Call formula in first SSA register with subject in second, - :: result in third, return to berm - [%cal barn (list @) @ berm] :: Call arm given by barn, subject in first SSA register, - :: result in second, return to berm - [%bec barn @ @ berm] :: Not quite a call: we need to know the subject registerization of an arm. - :: see %eye - [%lnt @ @] :: Jump to formula in first SSA register with subject in second - [%jmp barn (list @)] :: Jump to the code at the label in tail position, - :: with the subject in the SSA register - [%eye barn @] :: Look before you jump: we need to know the subject registerization of an arm - :: before we jump to it. Until then, here's a register with - :: the whole subject - [%spy @ @ @ berm] :: Scry with the ref/path pair in the first 2 SSA registers - :: define the third as the result - [%hnt @ berm] :: Treat the result in the SSA register as a hint and continue to the given label - - [%don @] :: Finish the procedure, returning the value in the SSA - [%bom ~] :: Crash +:: +:: instructions ending a block +:: +:: faces: +:: a - target arm +:: b - poisons +:: c - come-from block +:: d - destination +:: e - scry ref +:: f - formula +:: i - in cache +:: k - key +:: l - left source +:: m - cache miss +:: n - fast label and axis into battery +:: o - "one" / false case +:: p - scry path +:: r - right source +:: s - source +:: t - target block +:: u - subject +:: v - subject but registerized +:: z - "zero" / true case +:: +:: cases: +:: %clq - if s is a cell goto z else goto o +:: %eqq - if l and r equal goto z else goto o +:: %brn - if s is 0 goto z, if 1 goto o, else crash +:: %hop - unconditionally go to t +:: %hip - set comefrom label to c and goto t +:: %lnk - evaluate f against u and put the result in d, then goto t +:: %cal - call the arm a with subject in registers v, poisons in b, +:: result in d, and then goto t +:: %caf - like call but with fast label +:: %lnt - evaluate f against u in tail position +:: %jmp - call the arm a with subject in registers u, poisons in b, in +:: tail position +:: %jmf - like jmp but with fast label +:: %spy - scry with ref in e and path in p, put result in d, goto t +:: %mer - check if triple [k u f] is in cache, put result in d if so +:: and goto i, else goto m +:: %don - return value in s from current arm +:: %bom - crash ++$ site + $% [%clq s=@uvre z=bile o=bile] + [%eqq l=@uvre r=@uvre z=bile o=bile] + [%brn s=@uvre z=bile o=bile] + [%hop t=bile] + [%hip c=bile t=bile] + [%lnk u=@uvre f=@uvre d=@uvre t=bile] + [%cal a=bell v=(list @uvre) d=@uvre t=bile] + [%caf a=bell v=(list @uvre) d=@uvre t=bile u=@uvre n=[path @]] + [%lnt u=@uvre f=@uvre] + [%jmp a=bell v=(list @uvre)] + [%jmf a=bell v=(list @uvre) u=@uvre n=[path @]] + [%spy e=@uvre p=@uvre d=@uvre t=bile] + [%mer k=@uvre u=@uvre f=@uvre d=@uvre i=bile m=bile] + [%don s=@uvre] + [%bom ~] == -+$ pool (list [axe=@ ssa=@ saf=?]) :: entry point subject uses: ordered subject/ssa/safety -+$ lock [body=(list bran) bend=germ] :: basic block: instructions + a terminator or branch -+$ lake (map berm lock) :: code table of basic blocks -+$ rice [goes=lake uses=pool lump=@] :: entry information and code table for an arm -+$ sack [does=rice says=boot] :: code table entry: basic blocks + SKA result for an arm -+$ town [land=(map barn sack) lamb=@] :: code table +:: basic block +:: +:: map of phi-arguments, each of which initializes an @uvre from +:: another @uvre selected by which label we came from (see %hip control +:: flow instruction) +:: zero or more dataflow instructions executed in order, followed by a +:: single control-flow instruction ++$ blob [biff=(map @uvre (map bile @uvre)) body=(list pole) bend=site] +:: +:: compilation unit +:: +:: basic blocks and entry information for an arm +:: +:: long: starting label for direct calls axis 2 +:: want: input registers for direct calls axis 6 +:: walt: input starting registers LR axis 14 +:: wish: starting label for indirect calls axis 30 +:: sire: input register for indirect calls axis 62 +:: will: code table for arm axis 126 +:: sans: next SSA register axis 127 ++$ pile + $: long=bile + want=need + walt=(list @uvre) + wish=bile + sire=@uvre + will=(map bile blob) + sans=@uvre + == +:: +:: code table +:: +:: code entry information for arms ++$ hill (map bell pile) -- diff --git a/hoon/codegen/sur/noir.hoon b/hoon/codegen/sur/noir.hoon new file mode 100644 index 00000000..bb147174 --- /dev/null +++ b/hoon/codegen/sur/noir.hoon @@ -0,0 +1,86 @@ +/+ soak +|. +=> $:soak +|% +:: in-progress call table entry +:: +:: soot: subject knowledge +:: sake: subject battery mask +:: form: formula if known +:: root: result knowledge +:: rake: result battery mask +:: sire: @hail for call to caller, if there is one ++$ toot + $: soot=sock sake=cape + form=(unit *) norm=(unit nomm) + root=sock rake=cape + sire=(unit @hail) + == +:: cold state +:: +:: core: nested batteries by path +:: batt: paths by outer batteries +:: root: paths by roots +:: call: path/axis labels by bell +:: back: bells by path/axis label ++$ cool + $: core=(jug path sock) + root=(jug * path) + batt=(jug ^ path) + call=(map [sock *] [path @]) + back=(jug [path @] [sock *]) + == +:: hint table entry +:: +:: stored information about a hint ++$ hind + $@ ~ + [%fast tire=(unit [cone=path bats=sock matt=(map @ [@hail *])])] +:: call table entry +:: +:: soot: known subject for the call +:: norm: nomm and decoration (see $food) ++$ hone [soot=sock norm=food] +:: Nomm (Nock--) +:: +:: 9 is rewritten to 7+2 [9 b c] -> [7 c 2 [0 1] 0 c] +:: 8 is rewritten to 7+autocons+0 ++$ nomm + $% [%par left=nomm rite=nomm] :: autocons + [%one moan=*] :: Nock 1 + [%two cost=nomm corn=nomm rail=@hail] :: Nock 2 - done + [%the pell=nomm] :: Nock 3 + [%for mall=nomm] :: Nock 4 + [%ivy this=nomm that=nomm] :: Nock 5 + [%six what=nomm then=nomm else=nomm] :: Nock 6 + [%eve once=nomm then=nomm] :: Nock 7 + [%ten here=@ twig=nomm tree=nomm] :: Nock 10 + [%sip hint=@ then=nomm] :: Nock 11 (static) + [%tip hint=@ vice=nomm then=nomm hare=@hint] :: Nock 11 (dynamic) + [%elf rent=nomm walk=nomm] :: "Nock 12" + [%not here=@] :: Nock 0 + == +:: Stack computation marker +:: +:: used to describe remaining work in tail-recursive work-stack +:: algorithms over $nomm ++$ toms + $@ $?(%par %wot %the %for %ivy %six %eve %vee %elf) + $% [%two rail=@hail] + [%ten here=@] + [%tip hint=@ rail=@hail] + == +:: call site data +:: +:: nomm: lowered nock for called formula +:: ices: labels for direct calls +:: loop: set of direct calls which are recursive ++$ food + $: =nomm + ices=(map @hail [=sock form=*]) + loop=(set [=sock form=*]) + fizz=(map @hint *) + seat=(unit spot) + area=(unit spot) + == +-- diff --git a/hoon/codegen/sur/sock.hoon b/hoon/codegen/sur/sock.hoon index 756d1408..86c496fc 100644 --- a/hoon/codegen/sur/sock.hoon +++ b/hoon/codegen/sur/sock.hoon @@ -1,14 +1,14 @@ +/+ hoot +|. +=> $:hoot |% -+$ sock - $% [%know know=*] :: We know everything about this noun - [%bets hed=sock tal=sock] :: This noun is a cell, with partial knowledge of its head and tail - [%dice ~] :: This noun is an atom - [%flip ~] :: This noun is an atom, specifically 0 or 1 - [%toss ~] :: We know nothing about this noun - == -+$ boot - $% [%boom ~] :: The Nock will crash - [%risk hope=sock] :: The Nock that produces this noun might crash - [%safe sure=sock] :: The Nock that produces this noun will not crash - == +:: mask +:: +:: describes which axes of a noun are known +:: but does not include the noun ++$ cape $@(? [cape cape]) +:: sock +:: +:: describes knowledge of a noun ++$ sock [=cape data=*] -- diff --git a/hoon/codegen/ted/eval-build.hoon b/hoon/codegen/ted/eval-build.hoon new file mode 100644 index 00000000..b9e9aa65 --- /dev/null +++ b/hoon/codegen/ted/eval-build.hoon @@ -0,0 +1,13 @@ +/- spider +/+ make, strand, strandio +!. +=, strand=strand:spider +^- thread:spider +|= arg=vase +=/ m (strand ,vase) +^- form:m +;< bec=beak bind:m get-beak:strandio +;< now=@da bind:m get-time:strandio +=/ cg=path /(scot %p p.bec)/[q.bec]/(scot %da now) +~& "cg desk: {}" +(pure:m (make-eval-vase:make cg)) diff --git a/rust/ares/bin/cg.jam b/rust/ares/bin/cg.jam new file mode 100644 index 00000000..8dd4dd8b Binary files /dev/null and b/rust/ares/bin/cg.jam differ diff --git a/rust/ares/src/codegen.rs b/rust/ares/src/codegen.rs new file mode 100644 index 00000000..88be47fa --- /dev/null +++ b/rust/ares/src/codegen.rs @@ -0,0 +1,884 @@ +use crate::interpreter::{inc, interpret, Context, Error, Result, BAIL_EXIT, BAIL_FAIL, ContextSnapshot, WhichInterpreter}; +use crate::jets::seam::util::get_by; +use crate::jets::util::slot; +use crate::jets::{Jet, JetErr::*}; +use crate::mem::NockStack; +use crate::noun::{DirectAtom, Noun, D, NOUN_NONE, T}; +use crate::unifying_equality::unifying_equality; +use ares_macros::tas; +use either::{Left, Right}; +use std::mem::size_of; +use std::ptr::{copy_nonoverlapping, write_bytes}; +use std::slice::{from_raw_parts, from_raw_parts_mut}; + +#[derive(Copy, Clone)] +struct Frame { + /// Slow stack as a list + slow: Noun, + /// Mean stack as a list + mean: Noun, + /// Code table for current arm + pile: Noun, + /// Continuation label when returning to this frame + cont: Noun, + /// Result register when returning to this frame + salt: usize, + /// number of locals + vars: usize, +} + +impl Frame { + fn init(&mut self, vars: usize, prev: Option<&Frame>) { + *self = Frame { + slow: prev.map_or(D(0), |f| f.slow), + mean: prev.map_or(D(0), |f| f.mean), + pile: NOUN_NONE, + cont: NOUN_NONE, + salt: usize::MAX, + vars, + }; + unsafe { write_bytes((self as *mut Frame).add(1) as *mut u64, 0, vars) }; + } + + unsafe fn current<'a>(stack: &NockStack) -> &'a Self { + &(*(stack.get_frame_base() as *const Frame)) + } + + unsafe fn current_mut<'a>(stack: &NockStack) -> &'a mut Self { + &mut (*(stack.get_frame_base() as *mut Frame)) + } + + fn vars<'a>(&self) -> &'a [Noun] { + unsafe { from_raw_parts((self as *const Frame).add(1) as *const Noun, self.vars) } + } + + fn vars_mut<'a>(&mut self) -> &'a mut [Noun] { + unsafe { from_raw_parts_mut((self as *mut Frame).add(1) as *mut Noun, self.vars) } + } + +} + +assert_eq_align!(Frame, u64, usize); +assert_eq_size!(u64, usize); +const FRAME_WORD_SIZE: usize = size_of::() / size_of::(); + +fn push_interpreter_frame(stack: &mut NockStack, pile: Noun) { + let vars = pile_sans(pile); + let prev = unsafe { Frame::current(stack) }; + stack.frame_push(FRAME_WORD_SIZE + vars); + let frame = unsafe { Frame::current_mut(stack) }; + frame.init(vars, Some(prev)); + frame.pile = pile; + frame.vars = vars; +} + +fn push_outer_frame(stack: &mut NockStack, pile: Noun) { + let vars = pile_sans(pile); + stack.frame_push(FRAME_WORD_SIZE + vars); + let frame = unsafe { Frame::current_mut(stack) }; + frame.init(vars, None); + frame.pile = pile; + frame.vars = vars; +} + +fn tail_frame(stack: &mut NockStack, pile: Noun) { + let (old_vars, vars, total_vars) = unsafe { + let old_frame = Frame::current(stack); + let old_vars = pile_sans(old_frame.pile); + let vars = pile_sans(pile); + let total_vars = vars + old_vars; + stack.resize_frame(FRAME_WORD_SIZE + total_vars); + (old_vars, vars, total_vars) + }; + let frame = unsafe { Frame::current_mut(stack) }; + unsafe { + let vars_ptr = (frame as *mut Frame).add(1) as *mut Noun; + copy_nonoverlapping(vars_ptr, vars_ptr.add(vars), old_vars); + write_bytes(vars_ptr, 0, vars); + } + frame.pile = pile; + frame.vars = total_vars; + frame.cont = NOUN_NONE; + frame.salt = usize::MAX; +} + +const PEEK_AXIS: u64 = 4; +const POKE_AXIS: u64 = 46; + +fn slam_line(context: &mut Context, arm_axis: u64, sample: Noun) -> Noun { + let axis_noun = DirectAtom::new_panic(arm_axis).as_noun(); + let subject = T(&mut context.stack, &[sample, context.line]); + let sample_patch = T(&mut context.stack, &[D(6), D(0), D(2)]); + let arm_kick_form = T(&mut context.stack, &[D(9), axis_noun, D(0), D(3)]); + let gate_slam_form = T( + &mut context.stack, + &[D(9), D(2), D(10), sample_patch, arm_kick_form], + ); + interpret(context, subject, gate_slam_form).expect("Crash in codegen") +} + +fn cg_peek(context: &mut Context, subject: Noun, formula: Noun) -> Option { + assert!(!context.line.is_none()); + let sample = T(&mut context.stack, &[subject, formula]); + let peek_result = slam_line(context, PEEK_AXIS, sample); + if unsafe { peek_result.raw_equals(D(0)) } { + None + } else { + let unit_cell = peek_result.as_cell().expect("Peek should return unit"); + Some(unit_cell.tail()) + } +} + +fn cg_poke(context: &mut Context, slow: Noun, subject: Noun, formula: Noun) { + assert!(!context.line.is_none()); + let sample = T( + &mut context.stack, + &[D(tas!(b"comp")), slow, subject, formula], + ); + let result = slam_line(context, POKE_AXIS, sample); + let new_line = slot(result, 7).expect("Poke should return triple"); + context.line = new_line; +} + +/// Get the $pile for an arm, possibly updating the line core +fn cg_indirect( + context: &mut Context, + hill: &mut Noun, + slow: Noun, + subject: Noun, + formula: Noun, +) -> Noun { + let bell_hill = if let Some(res) = cg_peek(context, subject, formula) { + res + } else { + cg_poke(context, slow, subject, formula); + cg_peek(context, subject, formula).expect("Codegen peek should return value after poke.") + }; + let bell_hill_cell = bell_hill + .as_cell() + .expect("Codegen successful peek should return pair"); + *hill = bell_hill_cell.tail(); + get_by( + &mut context.stack, + &mut bell_hill_cell.tail(), + &mut bell_hill_cell.head(), + ) + .expect("Codegen bell lookup should succeed.") + .expect("Codegen peek bell should be in hill") +} + +fn cg_direct(context: &mut Context, hill: &mut Noun, bell: &mut Noun) -> Noun { + get_by(&mut context.stack, hill, bell) + .expect("Codegen bell lookup should succeed.") + .expect("Codegen direct bell should be in hill.") +} + +pub fn cg_interpret(context: &mut Context, slow: Noun, subject: Noun, formula: Noun) -> Result { + let snapshot = context.save(); + context.which = WhichInterpreter::CodegenCodegen; + cg_interpret_with_snapshot(context, &snapshot, slow, subject, formula) +} + +pub fn cg_interpret_cg(context: &mut Context, slow: Noun, subject: Noun, formula: Noun) -> Result { + let snapshot = context.save(); + context.which = WhichInterpreter::TreeWalkingCodegen; + cg_interpret_with_snapshot(context, &snapshot, slow, subject, formula) +} + + +pub fn cg_interpret_with_snapshot(context: &mut Context, snapshot: &ContextSnapshot, slow: Noun, subject: Noun, formula: Noun) -> Result { + let mut hill = NOUN_NONE; + let outer_pile = cg_indirect(context, &mut hill, slow, subject, formula); + let virtual_frame = context.stack.get_frame_pointer(); + push_outer_frame(&mut context.stack, outer_pile); + let (mut body, mut bend) = (NOUN_NONE, NOUN_NONE); + let sire = pile_sire(outer_pile); + (unsafe { Frame::current_mut(&context.stack).vars_mut() })[sire] = subject; + let mut wish = pile_wish(outer_pile); + goto(context, &mut body, &mut bend, &mut wish); + let inner_res = 'interpret: loop { + let frame = unsafe { Frame::current_mut(&context.stack) }; + if let Ok(body_cell) = body.as_cell() { + body = body_cell.tail(); + let inst_cell = body_cell + .head() + .as_cell() + .expect("Codegen instruction should be a cell"); + let inst_tag = inst_cell + .head() + .as_atom() + .expect("Codegen instruction tag should be atom") + .as_u64() + .expect("codegen instruction tag should convert to u64"); + match inst_tag { + tas!(b"imm") => { + let imm_cell = inst_cell.tail().as_cell().unwrap(); + let imm_n = imm_cell.head(); + let imm_d = imm_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + frame.vars_mut()[imm_d] = imm_n; + } + tas!(b"mov") => { + let mov_cell = inst_cell.tail().as_cell().unwrap(); + let mov_s = mov_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mov_d = mov_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + frame.vars_mut()[mov_d] = frame.vars()[mov_s]; + } + tas!(b"inc") => { + let inc_cell = inst_cell.tail().as_cell().unwrap(); + let inc_s = inc_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let inc_d = inc_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + if let Ok(s_atom) = frame.vars()[inc_s].as_atom() { + frame.vars_mut()[inc_d] = inc(&mut context.stack, s_atom).as_noun(); + } else { + break BAIL_EXIT; + } + } + tas!(b"con") => { + let con_cell = inst_cell.tail().as_cell().unwrap(); + let con_h = con_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let con_tell = con_cell.tail().as_cell().unwrap(); + let con_t = con_tell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let con_d = con_tell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + frame.vars_mut()[con_d] = T( + &mut context.stack, + &[frame.vars()[con_h], frame.vars()[con_t]], + ); + } + tas!(b"hed") => { + let hed_cell = inst_cell.tail().as_cell().unwrap(); + let hed_s = hed_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let hed_d = hed_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let s_noun = frame.vars()[hed_s]; + if s_noun.is_none() { + frame.vars_mut()[hed_d] = NOUN_NONE; + } else if let Ok(s_cell) = frame.vars()[hed_s].as_cell() { + frame.vars_mut()[hed_d] = s_cell.head(); + } else { + frame.vars_mut()[hed_d] = NOUN_NONE; + } + } + tas!(b"tal") => { + let tal_cell = inst_cell.tail().as_cell().unwrap(); + let tal_s = tal_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let tal_d = tal_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let s_noun = frame.vars()[tal_s]; + if s_noun.is_none() { + frame.vars_mut()[tal_d] = NOUN_NONE; + } else if let Ok(s_cell) = frame.vars()[tal_s].as_cell() { + frame.vars_mut()[tal_d] = s_cell.tail(); + } else { + frame.vars_mut()[tal_d] = NOUN_NONE; + } + } + tas!(b"men") => { + let men_cell = inst_cell.tail().as_cell().unwrap(); + let men_l = men_cell.head(); + assert!(men_l.is_atom()); + let men_s = men_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let men_entry = T(&mut context.stack, &[men_l, frame.vars()[men_s]]); + frame.mean = T(&mut context.stack, &[men_entry, frame.mean]) + } + tas!(b"man") => { + frame.mean = frame.mean.as_cell().unwrap().tail(); + } + tas!(b"slo") => { + let slo_s = inst_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let slo_tag = frame.vars()[slo_s]; + assert!(slo_tag.is_atom()); + frame.slow = T(&mut context.stack, &[slo_tag, frame.slow]); + } + tas!(b"sld") => { + frame.slow = frame.slow.as_cell().unwrap().tail(); + } + tas!(b"hit") => { + // XX TODO implement + } + tas!(b"slg") => { + let slg_s = inst_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + context + .newt + .slog(&mut context.stack, 0, frame.vars()[slg_s]); + } + tas!(b"mew") => { + let mew_kufr = inst_cell.tail().as_cell().unwrap(); + // XX will need for persistent memoization + let _mew_k = mew_kufr.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mew_ufr = mew_kufr.tail().as_cell().unwrap(); + let mew_u = mew_ufr.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mew_fr = mew_ufr.tail().as_cell().unwrap(); + let mew_f = mew_fr.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mew_r = mew_fr.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let mut key = T(&mut context.stack, &[frame.vars()[mew_u], frame.vars()[mew_f]]); + context.cache = context.cache.insert(&mut context.stack, &mut key, frame.vars()[mew_r]); + } + tas!(b"tim") => { + // XX TODO implement + } + tas!(b"tom") => { + // XX TODO implement + } + tas!(b"mem") => { + // XX TODO implement + } + tas!(b"poi") => { + let poi_p = inst_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + frame.vars_mut()[poi_p] = NOUN_NONE; + } + tas!(b"ipb") => { + let mut ipb_p = inst_cell.tail(); + 'ipb: loop { + if unsafe { ipb_p.raw_equals(D(0)) } { + break 'ipb; + } else { + let p_cell = ipb_p.as_cell().unwrap(); + ipb_p = p_cell.tail(); + let p_i = p_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + if frame.vars()[p_i].is_none() { + break 'interpret BAIL_EXIT; + } + } + } + } + _ => { + panic!("Codegen instruction unsupported"); + } + } + } else { + let inst_cell = bend + .as_cell() + .expect("Codegen instruction should be a cell"); + let inst_tag = inst_cell + .head() + .as_atom() + .expect("Codegen instruction tag should be atom") + .as_u64() + .expect("codegen instruction tag should convert to u64"); + match inst_tag { + tas!(b"clq") => { + let clq_cell = inst_cell.tail().as_cell().unwrap(); + let clq_s = clq_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let clq_zo = clq_cell.tail().as_cell().unwrap(); + let mut clq_z = clq_zo.head(); + let mut clq_o = clq_zo.tail(); + + if frame.vars()[clq_s].is_cell() { + goto(context, &mut body, &mut bend, &mut clq_z); + } else { + goto(context, &mut body, &mut bend, &mut clq_o); + } + } + tas!(b"eqq") => { + let eqq_cell = inst_cell.tail().as_cell().unwrap(); + let eqq_l = eqq_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let eqq_rzo = eqq_cell.tail().as_cell().unwrap(); + let eqq_r = eqq_rzo.head().as_atom().unwrap().as_u64().unwrap() as usize; + let eqq_zo = eqq_rzo.tail().as_cell().unwrap(); + let mut eqq_z = eqq_zo.head(); + let mut eqq_o = eqq_zo.tail(); + let l_ref = &mut frame.vars_mut()[eqq_l]; + let r_ref = &mut frame.vars_mut()[eqq_r]; + if unsafe { + unifying_equality( + &mut context.stack, + l_ref as *mut Noun, + r_ref as *mut Noun, + ) + } { + goto(context, &mut body, &mut bend, &mut eqq_z); + } else { + goto(context, &mut body, &mut bend, &mut eqq_o); + } + } + tas!(b"brn") => { + let brn_cell = inst_cell.tail().as_cell().unwrap(); + let brn_s = brn_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let brn_zo = brn_cell.tail().as_cell().unwrap(); + let mut brn_z = brn_zo.head(); + let mut brn_o = brn_zo.tail(); + if unsafe { frame.vars()[brn_s].raw_equals(D(0)) } { + goto(context, &mut body, &mut bend, &mut brn_z); + } else if unsafe { frame.vars()[brn_s].raw_equals(D(1)) } { + goto(context, &mut body, &mut bend, &mut brn_o); + } else { + break BAIL_EXIT; + } + } + tas!(b"hop") => { + let mut hop_t = inst_cell.tail(); + goto(context, &mut body, &mut bend, &mut hop_t); + } + tas!(b"hip") => { + panic!("hip is unsupported for execution"); + } + tas!(b"lnk") => { + let lnk_cell = inst_cell.tail().as_cell().unwrap(); + let lnk_u = lnk_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let lnk_fdt = lnk_cell.tail().as_cell().unwrap(); + let lnk_f = lnk_fdt.head().as_atom().unwrap().as_u64().unwrap() as usize; + let lnk_dt = lnk_fdt.tail().as_cell().unwrap(); + let lnk_d = lnk_dt.head().as_atom().unwrap().as_u64().unwrap() as usize; + let lnk_t = lnk_dt.tail(); + let subject = frame.vars()[lnk_u]; + let formula = frame.vars()[lnk_f]; + frame.salt = lnk_d; + frame.cont = lnk_t; + let new_pile = cg_indirect(context, &mut hill, frame.slow, subject, formula); + let sire = pile_sire(new_pile); + let mut wish = pile_wish(new_pile); + push_interpreter_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&context.stack) }; + new_frame.vars_mut()[sire] = subject; + goto(context, &mut body, &mut bend, &mut wish); + } + tas!(b"cal") => { + let cal_cell = inst_cell.tail().as_cell().unwrap(); + let mut cal_a = cal_cell.head(); + let cal_vdt = cal_cell.tail().as_cell().unwrap(); + let mut cal_v = cal_vdt.head(); + let cal_dt = cal_vdt.tail().as_cell().unwrap(); + let cal_d = cal_dt.head().as_atom().unwrap().as_u64().unwrap() as usize; + let cal_t = cal_dt.tail(); + let new_pile = cg_direct(context, &mut hill, &mut cal_a); + let mut long = pile_long(new_pile); + let mut walt = pile_walt(new_pile); + frame.salt = cal_d; + frame.cont = cal_t; + push_interpreter_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&context.stack) }; + 'args: loop { + if unsafe { cal_v.raw_equals(D(0)) } { + assert!(unsafe { walt.raw_equals(D(0)) }); + break 'args; + } else { + let v_cell = cal_v.as_cell().unwrap(); + let walt_cell = walt.as_cell().unwrap(); + cal_v = v_cell.tail(); + walt = walt_cell.tail(); + let v_i = v_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let walt_i = + walt_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + new_frame.vars_mut()[walt_i] = frame.vars()[v_i]; + } + } + goto(context, &mut body, &mut bend, &mut long); + } + tas!(b"caf") => { + let caf_cell = inst_cell.tail().as_cell().unwrap(); + let mut caf_a = caf_cell.head(); + let caf_vdtun = caf_cell.tail().as_cell().unwrap(); + let mut caf_v = caf_vdtun.head(); + let caf_dtun = caf_vdtun.tail().as_cell().unwrap(); + let caf_d = caf_dtun.head().as_atom().unwrap().as_u64().unwrap() as usize; + let caf_tun = caf_dtun.tail().as_cell().unwrap(); + let caf_t = caf_tun.head(); + let caf_un = caf_tun.tail().as_cell().unwrap(); + let caf_u = caf_un.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mut caf_n = caf_un.tail(); + let mut jet: Option = None; + for (n, a, j) in context.hot { + let mut na = T(&mut context.stack, &[n, a.as_noun()]); + if unsafe { unifying_equality(&mut context.stack, &mut na, &mut caf_n) } { + jet = Some(j); + break; + } + } + if let Some(j) = jet { + let subject = frame.vars()[caf_u]; + match j(context, subject) { + Ok(r) => { + frame.vars_mut()[caf_d] = r; + } + Err(Punt) => { + let new_pile = cg_direct(context, &mut hill, &mut caf_a); + let mut long = pile_long(new_pile); + let mut walt = pile_walt(new_pile); + frame.salt = caf_d; + frame.cont = caf_t; + push_interpreter_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&context.stack) }; + 'args: loop { + if unsafe { caf_v.raw_equals(D(0)) } { + assert!(unsafe { walt.raw_equals(D(0)) }); + break 'args; + } else { + let v_cell = caf_v.as_cell().unwrap(); + let walt_cell = walt.as_cell().unwrap(); + caf_v = v_cell.tail(); + walt = walt_cell.tail(); + let v_i = v_cell.head().as_atom().unwrap().as_u64().unwrap() + as usize; + let walt_i = + walt_cell.head().as_atom().unwrap().as_u64().unwrap() + as usize; + new_frame.vars_mut()[walt_i] = frame.vars()[v_i]; + } + } + goto(context, &mut body, &mut bend, &mut long); + } + Err(Fail(err)) => { + break Err(err); + } + } + } else { + let new_pile = cg_direct(context, &mut hill, &mut caf_a); + let mut long = pile_long(new_pile); + let mut walt = pile_walt(new_pile); + frame.salt = caf_d; + frame.cont = caf_t; + push_interpreter_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&context.stack) }; + 'args: loop { + if unsafe { caf_v.raw_equals(D(0)) } { + assert!(unsafe { walt.raw_equals(D(0)) }); + break 'args; + } else { + let v_cell = caf_v.as_cell().unwrap(); + let walt_cell = walt.as_cell().unwrap(); + caf_v = v_cell.tail(); + walt = walt_cell.tail(); + let v_i = + v_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let walt_i = + walt_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + new_frame.vars_mut()[walt_i] = frame.vars()[v_i]; + } + } + goto(context, &mut body, &mut bend, &mut long); + } + } + tas!(b"lnt") => { + let lnt_cell = inst_cell.tail().as_cell().unwrap(); + let lnt_u = lnt_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let lnt_f = lnt_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let subject = frame.vars()[lnt_u]; + let formula = frame.vars()[lnt_f]; + let new_pile = cg_indirect(context, &mut hill, frame.slow, subject, formula); + let sire = pile_sire(new_pile); + let mut wish = pile_wish(new_pile); + tail_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&mut context.stack) }; + new_frame.vars_mut()[sire] = subject; + goto(context, &mut body, &mut bend, &mut wish); + } + tas!(b"jmp") => { + let jmp_cell = inst_cell.tail().as_cell().unwrap(); + let mut jmp_a = jmp_cell.head(); + let mut jmp_v = jmp_cell.tail(); + let new_pile = cg_direct(context, &mut hill, &mut jmp_a); + let new_vars = pile_sans(new_pile); + let mut long = pile_long(new_pile); + let mut walt = pile_walt(new_pile); + tail_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&mut context.stack) }; + 'args: loop { + if unsafe { jmp_v.raw_equals(D(0)) } { + assert!(unsafe { walt.raw_equals(D(0)) }); + break 'args; + } else { + let v_cell = jmp_v.as_cell().unwrap(); + let walt_cell = walt.as_cell().unwrap(); + jmp_v = v_cell.tail(); + walt = walt_cell.tail(); + let v_i = v_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let walt_i = + walt_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + new_frame.vars_mut()[walt_i] = new_frame.vars()[new_vars..][v_i]; + } + } + goto(context, &mut body, &mut bend, &mut long); + } + tas!(b"jmf") => { + let jmf_cell = inst_cell.tail().as_cell().unwrap(); + let mut jmf_a = jmf_cell.head(); + let jmf_vun = jmf_cell.tail().as_cell().unwrap(); + let mut jmf_v = jmf_vun.head(); + let jmf_un = jmf_vun.tail().as_cell().unwrap(); + let jmf_u = jmf_un.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mut jmf_n = jmf_un.tail(); + let mut jet: Option = None; + for (n, a, j) in context.hot { + let mut na = T(&mut context.stack, &[n, a.as_noun()]); + if unsafe { unifying_equality(&mut context.stack, &mut na, &mut jmf_n) } { + jet = Some(j); + break; + } + } + if let Some(j) = jet { + let subject = frame.vars()[jmf_u]; + match j(context, subject) { + Ok(mut r) => { + unsafe { + context.preserve(); + context.stack.preserve(&mut r); + context.stack.frame_pop(); + } + if context.stack.get_frame_pointer() == virtual_frame { + break Ok(r); + } else { + let new_frame = + unsafe { Frame::current_mut(&mut context.stack) }; + new_frame.vars_mut()[new_frame.salt] = r; + goto(context, &mut body, &mut bend, &mut new_frame.cont) + } + } + Err(Punt) => { + let new_pile = cg_direct(context, &mut hill, &mut jmf_a); + let new_vars = pile_sans(new_pile); + let mut long = pile_long(new_pile); + let mut walt = pile_walt(new_pile); + tail_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&mut context.stack) }; + 'args: loop { + if unsafe { jmf_v.raw_equals(D(0)) } { + assert!(unsafe { walt.raw_equals(D(0)) }); + break 'args; + } else { + let v_cell = jmf_v.as_cell().unwrap(); + let walt_cell = walt.as_cell().unwrap(); + jmf_v = v_cell.tail(); + walt = walt_cell.tail(); + let v_i = v_cell.head().as_atom().unwrap().as_u64().unwrap() + as usize; + let walt_i = + walt_cell.head().as_atom().unwrap().as_u64().unwrap() + as usize; + new_frame.vars_mut()[walt_i] = + new_frame.vars()[new_vars..][v_i]; + } + } + goto(context, &mut body, &mut bend, &mut long); + } + Err(Fail(err)) => { + break Err(err); + } + } + } else { + let new_pile = cg_direct(context, &mut hill, &mut jmf_a); + let new_vars = pile_sans(new_pile); + let mut long = pile_long(new_pile); + let mut walt = pile_walt(new_pile); + tail_frame(&mut context.stack, new_pile); + let new_frame = unsafe { Frame::current_mut(&mut context.stack) }; + 'args: loop { + if unsafe { jmf_v.raw_equals(D(0)) } { + assert!(unsafe { walt.raw_equals(D(0)) }); + break 'args; + } else { + let v_cell = jmf_v.as_cell().unwrap(); + let walt_cell = walt.as_cell().unwrap(); + jmf_v = v_cell.tail(); + walt = walt_cell.tail(); + let v_i = + v_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let walt_i = + walt_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + new_frame.vars_mut()[walt_i] = new_frame.vars()[new_vars..][v_i]; + } + } + goto(context, &mut body, &mut bend, &mut long); + } + } + tas!(b"spy") => { + // XX: what do we want to do about the slow path here? + let spy_cell = inst_cell.tail().as_cell().unwrap(); + let spy_e = spy_cell.head().as_atom().unwrap().as_u64().unwrap() as usize; + let spy_pdt = spy_cell.tail().as_cell().unwrap(); + let spy_p = spy_pdt.head().as_atom().unwrap().as_u64().unwrap() as usize; + let spy_dt = spy_pdt.tail().as_cell().unwrap(); + let spy_d = spy_dt.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mut spy_t = spy_dt.tail(); + frame.vars_mut()[spy_d] = scry(context, frame.vars()[spy_e], frame.vars()[spy_p])?; + goto(context, &mut body, &mut bend, &mut spy_t); + } + tas!(b"mer") => { + let mer_kufdim = inst_cell.tail().as_cell().unwrap(); + // XX will need for persistent memoization + let _mer_k = mer_kufdim.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mer_ufdim = mer_kufdim.tail().as_cell().unwrap(); + let mer_u = mer_ufdim.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mer_fdim = mer_ufdim.tail().as_cell().unwrap(); + let mer_f = mer_fdim.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mer_dim = mer_fdim.tail().as_cell().unwrap(); + let mer_d = mer_dim.head().as_atom().unwrap().as_u64().unwrap() as usize; + let mer_im = mer_dim.tail().as_cell().unwrap(); + let mut mer_i = mer_im.head(); + let mut mer_m = mer_im.tail(); + let mut key = T(&mut context.stack, &[frame.vars()[mer_u], frame.vars()[mer_f]]); + if let Some(res) = context.cache.lookup(&mut context.stack, &mut key) { + frame.vars_mut()[mer_d] = res; + goto(context, &mut body, &mut bend, &mut mer_i); + } else { + goto(context, &mut body, &mut bend, &mut mer_m); + } + } + tas!(b"don") => { + let don_s = inst_cell.tail().as_atom().unwrap().as_u64().unwrap() as usize; + let mut result = frame.vars()[don_s]; + unsafe { + context.preserve(); + context.stack.preserve(&mut result); + context.stack.frame_pop(); + } + if context.stack.get_frame_pointer() == virtual_frame { + break Ok(result); + } else { + let new_frame = unsafe { Frame::current_mut(&mut context.stack) }; + new_frame.vars_mut()[new_frame.salt] = result; + goto(context, &mut body, &mut bend, &mut new_frame.cont); + } + } + tas!(b"bom") => { + break BAIL_EXIT; + } + _ => { + panic!("Codegen instruction unsupported"); + } + } + } + }; + match inner_res { + Ok(res) => { + context.which = snapshot.which; + Ok(res) + }, + Err(err) => Err(exit(context, &snapshot, virtual_frame, err)), + } +} + +/// Crash with an error, but first unwind the stack +fn exit(context: &mut Context, snapshot: &ContextSnapshot, virtual_frame: *const u64, error: Error) -> Error { + context.restore(snapshot); + if context.stack.copying() { + assert!(context.stack.get_frame_pointer() != virtual_frame); + unsafe { context.stack.frame_pop() }; + } + + let stack = &mut context.stack; + let mut preserve = match error { + Error::ScryBlocked(path) => path, + Error::Deterministic(_, t) | Error::NonDeterministic(_, t) | Error::ScryCrashed(t) => { + let frame = unsafe { Frame::current(stack) }; + T(stack, &[frame.mean, t]) + }, + }; + + while stack.get_frame_pointer() != virtual_frame { + unsafe { + stack.preserve(&mut preserve); + stack.frame_pop(); + } + } + + match error { + Error::Deterministic(mote, _) => Error::Deterministic(mote, preserve), + Error::NonDeterministic(mote, _) => Error::NonDeterministic(mote, preserve), + Error::ScryCrashed(_) => Error::ScryCrashed(preserve), + Error::ScryBlocked(_) => error + } +} + +fn goto(context: &mut Context, body: &mut Noun, bend: &mut Noun, bile: &mut Noun) { + let frame = unsafe { Frame::current(&context.stack) }; + let (o, e) = get_blob(context, frame.pile, bile); + *body = o; + *bend = e; +} + +fn pile_sans(pile: Noun) -> usize { + (slot(pile, 127) + .expect("Codegen pile should have sans face") + .as_atom() + .expect("Codegen sans should be atom") + .as_u64() + .expect("Codegen sans too big")) as usize +} + +fn pile_wish(pile: Noun) -> Noun { + slot(pile, 30).expect("Codegen pile should have wish face") +} + +fn pile_sire(pile: Noun) -> usize { + (slot(pile, 62) + .expect("Codegen pile should have sire face") + .as_atom() + .expect("Codegen sire should be atom") + .as_u64() + .expect("Codegen sire too big")) as usize +} + +fn pile_will(pile: Noun) -> Noun { + slot(pile, 126).expect("Codegen pile should have will face") +} + +fn pile_long(pile: Noun) -> Noun { + slot(pile, 2).expect("Codegen pile should have long face") +} + +fn pile_walt(pile: Noun) -> Noun { + slot(pile, 14).expect("Codegen pile should have walt face") +} + +fn get_blob(context: &mut Context, pile: Noun, bile: &mut Noun) -> (Noun, Noun) { + let mut will = pile_will(pile); + let blob_with_biff = get_by(&mut context.stack, &mut will, bile) + .expect("Codegen bile lookup successful") + .expect("Codegen will has bile"); + let blob_cell = slot(blob_with_biff, 3) + .expect("Codegen blob has tail") + .as_cell() + .expect("Codegen blob tail should be cell"); + (blob_cell.head(), blob_cell.tail()) +} + +fn scry(context: &mut Context, reff: Noun, path: Noun) -> Result { + if let Some(cell) = context.scry_stack.cell() { + let scry_stack = context.scry_stack; // So we can put it back + let scry_handler = cell.head(); + let scry_payload = T(&mut context.stack, &[reff, path]); + let scry_patch = T(&mut context.stack, &[D(6), D(0), D(3)]); + let scry_formula = T(&mut context.stack, &[D(9), D(2), D(10), scry_patch, D(0), D(2)]); + let scry_subject = T(&mut context.stack, &[scry_handler, scry_payload]); + context.scry_stack = cell.tail(); + let snapshot = context.save(); + match cg_interpret_with_snapshot(context, &snapshot, D(0), scry_subject, scry_formula) { + Ok(noun) => match noun.as_either_atom_cell() { + Left(atom) => { + if unsafe { atom.as_noun().raw_equals(D(0)) } { + Err(Error::ScryBlocked(path)) + } else { + Err(Error::ScryCrashed(D(0))) + } + }, + Right(cell) => { + match cell.tail().as_either_atom_cell() { + Left(_) => { + let hunk = T(&mut context.stack, &[D(tas!(b"hunk")), reff, path]); + let frame = unsafe { Frame::current_mut(&mut context.stack) }; + frame.mean = T(&mut context.stack, &[hunk, frame.mean]); + Err(Error::ScryCrashed(D(0))) + }, + Right(cell) => { + context.scry_stack = scry_stack; + Ok(cell.tail()) + } + } + } + }, + Err(error) => match error { + Error::Deterministic(_, trace) + | Error::ScryCrashed(trace) => { + Err(Error::ScryCrashed(trace)) + }, + Error::NonDeterministic(_, _) => { + Err(error) + }, + Error::ScryBlocked(_) => { + BAIL_FAIL + } + } + } + } else { + // no scry handler + BAIL_EXIT + } +} diff --git a/rust/ares/src/interpreter.rs b/rust/ares/src/interpreter.rs index c250d883..ccd62822 100644 --- a/rust/ares/src/interpreter.rs +++ b/rust/ares/src/interpreter.rs @@ -28,6 +28,14 @@ use std::time::Instant; crate::gdb!(); +#[derive(Copy,Clone)] +#[repr(u8)] +pub enum WhichInterpreter { + TreeWalking, + TreeWalkingCodegen, + CodegenCodegen, +} + #[derive(Copy, Clone)] #[repr(u8)] enum TodoCons { @@ -260,6 +268,7 @@ enum NockWork { pub struct ContextSnapshot { cold: Cold, warm: Warm, + pub which: WhichInterpreter, } pub struct Context { @@ -268,6 +277,8 @@ pub struct Context { pub cold: Cold, pub warm: Warm, pub hot: Hot, + pub line: Noun, + pub which: WhichInterpreter, pub cache: Hamt, pub scry_stack: Noun, pub trace_info: Option, @@ -278,12 +289,21 @@ impl Context { ContextSnapshot { cold: self.cold, warm: self.warm, + which: self.which, } } pub fn restore(&mut self, saved: &ContextSnapshot) { self.cold = saved.cold; self.warm = saved.warm; + self.which = saved.which; + } + + pub unsafe fn preserve(&mut self) { + self.stack.preserve(&mut self.cache); + self.stack.preserve(&mut self.cold); + self.stack.preserve(&mut self.warm); + self.stack.preserve(&mut self.line); } /** @@ -360,9 +380,9 @@ impl From for Error { pub type Result = result::Result; -const BAIL_EXIT: Result = Err(Error::Deterministic(Mote::Exit, D(0))); -const BAIL_FAIL: Result = Err(Error::NonDeterministic(Mote::Fail, D(0))); -const BAIL_INTR: Result = Err(Error::NonDeterministic(Mote::Intr, D(0))); +pub const BAIL_EXIT: Result = Err(Error::Deterministic(Mote::Exit, D(0))); +pub const BAIL_FAIL: Result = Err(Error::NonDeterministic(Mote::Fail, D(0))); +pub const BAIL_INTR: Result = Err(Error::NonDeterministic(Mote::Intr, D(0))); #[allow(unused_variables)] fn debug_assertions(stack: &mut NockStack, noun: Noun) { @@ -378,6 +398,7 @@ pub fn interpret(context: &mut Context, mut subject: Noun, formula: Noun) -> Res let snapshot = context.save(); let virtual_frame: *const u64 = context.stack.get_frame_pointer(); let mut res: Noun = D(0); + context.which = WhichInterpreter::TreeWalking; // Setup stack for Nock computation unsafe { @@ -415,38 +436,32 @@ pub fn interpret(context: &mut Context, mut subject: Noun, formula: Noun) -> Res NockWork::Done => { write_trace(context); - let stack = &mut context.stack; - debug_assertions(stack, orig_subject); - debug_assertions(stack, subject); - debug_assertions(stack, res); + debug_assertions(&mut context.stack, orig_subject); + debug_assertions(&mut context.stack, subject); + debug_assertions(&mut context.stack, res); - stack.preserve(&mut context.cache); - stack.preserve(&mut context.cold); - stack.preserve(&mut context.warm); - stack.preserve(&mut res); - stack.frame_pop(); + context.preserve(); + context.stack.preserve(&mut res); + context.stack.frame_pop(); - debug_assertions(stack, orig_subject); - debug_assertions(stack, res); + debug_assertions(&mut context.stack, orig_subject); + debug_assertions(&mut context.stack, res); break Ok(res); } NockWork::Ret => { write_trace(context); - let stack = &mut context.stack; - debug_assertions(stack, orig_subject); - debug_assertions(stack, subject); - debug_assertions(stack, res); + debug_assertions(&mut context.stack, orig_subject); + debug_assertions(&mut context.stack, subject); + debug_assertions(&mut context.stack, res); - stack.preserve(&mut context.cache); - stack.preserve(&mut context.cold); - stack.preserve(&mut context.warm); - stack.preserve(&mut res); - stack.frame_pop(); + context.preserve(); + context.stack.preserve(&mut res); + context.stack.frame_pop(); - debug_assertions(stack, orig_subject); - debug_assertions(stack, res); + debug_assertions(&mut context.stack, orig_subject); + debug_assertions(&mut context.stack, res); } NockWork::WorkCons(mut cons) => match cons.todo { TodoCons::ComputeHead => { @@ -959,7 +974,10 @@ pub fn interpret(context: &mut Context, mut subject: Noun, formula: Noun) -> Res }); match nock { - Ok(res) => Ok(res), + Ok(res) => { + context.which = snapshot.which; + Ok(res) + }, Err(err) => Err(exit(context, &snapshot, virtual_frame, err)), } } diff --git a/rust/ares/src/jets.rs b/rust/ares/src/jets.rs index f9ebe3cd..a12191c1 100644 --- a/rust/ares/src/jets.rs +++ b/rust/ares/src/jets.rs @@ -11,12 +11,13 @@ pub mod lute; pub mod math; pub mod nock; pub mod parse; +pub mod seam; pub mod serial; pub mod sort; pub mod tree; use crate::flog; -use crate::interpreter::{Context, Error, Mote}; +use crate::interpreter::{Context, Error, Mote, WhichInterpreter}; use crate::jets::bits::*; use crate::jets::cold::Cold; use crate::jets::form::*; @@ -185,7 +186,7 @@ pub fn get_jet_test_mode(_jet_name: Noun) -> bool { pub mod util { use super::*; - use crate::interpreter::interpret; + use crate::jets::nock::util::ctx_interpret; use crate::noun::{Noun, D, T}; use bitvec::prelude::{BitSlice, Lsb0}; use std::result; @@ -290,7 +291,7 @@ pub mod util { pub fn kick(context: &mut Context, core: Noun, axis: Noun) -> result::Result { let formula: Noun = T(&mut context.stack, &[D(9), axis, D(0), D(1)]); - interpret(context, core, formula).map_err(JetErr::Fail) + ctx_interpret(context, core, formula).map_err(JetErr::Fail) } pub fn slam(context: &mut Context, gate: Noun, sample: Noun) -> result::Result { @@ -309,7 +310,7 @@ pub mod util { use super::*; use crate::hamt::Hamt; use crate::mem::NockStack; - use crate::noun::{Atom, Noun, D, T}; + use crate::noun::{Atom, Noun, D, NOUN_NONE, T}; use crate::unifying_equality::unifying_equality; use assert_no_alloc::assert_no_alloc; use ibig::UBig; @@ -321,6 +322,7 @@ pub mod util { let warm = Warm::new(&mut stack); let hot = Hot::init(&mut stack, URBIT_HOT_STATE); let cache = Hamt::::new(&mut stack); + let line = NOUN_NONE; Context { stack, @@ -329,8 +331,10 @@ pub mod util { warm, hot, cache, + line, scry_stack: D(0), trace_info: None, + which: WhichInterpreter::CodegenCodegen, } } diff --git a/rust/ares/src/jets/list.rs b/rust/ares/src/jets/list.rs index 3a2d318f..96d721a3 100644 --- a/rust/ares/src/jets/list.rs +++ b/rust/ares/src/jets/list.rs @@ -1,7 +1,8 @@ /** Text processing jets */ -use crate::interpreter::{interpret, Context}; +use crate::interpreter::{Context}; use crate::jets::util::{slot, BAIL_FAIL}; +use crate::jets::nock::util::ctx_interpret; use crate::jets::Result; use crate::noun::{Cell, Noun, D, T}; use bitvec::order::Lsb0; @@ -100,7 +101,7 @@ pub fn jet_turn(context: &mut Context, subject: Noun) -> Result { ); unsafe { let (new_cell, new_mem) = Cell::new_raw_mut(&mut context.stack); - (*new_mem).head = interpret(context, element_subject, gate_battery)?; + (*new_mem).head = ctx_interpret(context, element_subject, gate_battery)?; *dest = new_cell.as_noun(); dest = &mut (*new_mem).tail; } diff --git a/rust/ares/src/jets/lute.rs b/rust/ares/src/jets/lute.rs index 9610407a..a9c521d0 100644 --- a/rust/ares/src/jets/lute.rs +++ b/rust/ares/src/jets/lute.rs @@ -1,6 +1,7 @@ /** ++ut jets (compiler backend and pretty-printer) */ -use crate::interpreter::{interpret, Context}; +use crate::interpreter::{Context}; +use crate::jets::nock::util::ctx_interpret; use crate::jets::util::*; use crate::jets::Result; use crate::noun::{Noun, D, NO, NONE, T, YES}; @@ -30,7 +31,7 @@ pub fn jet_ut_crop(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; context.cache = context.cache.insert(&mut context.stack, &mut key, pro); Ok(pro) } @@ -60,7 +61,7 @@ pub fn jet_ut_fish(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; context.cache = context.cache.insert(&mut context.stack, &mut key, pro); Ok(pro) } @@ -89,7 +90,7 @@ pub fn jet_ut_fuse(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; context.cache = context.cache.insert(&mut context.stack, &mut key, pro); Ok(pro) } @@ -111,7 +112,7 @@ pub fn jet_ut_mint(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; context.cache = context.cache.insert(&mut context.stack, &mut key, pro); Ok(pro) } @@ -142,7 +143,7 @@ pub fn jet_ut_mull(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; context.cache = context.cache.insert(&mut context.stack, &mut key, pro); Ok(pro) } @@ -177,7 +178,7 @@ pub fn jet_ut_nest_dext(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; if unsafe { pro.raw_equals(YES) && reg.raw_equals(D(0)) } || unsafe { pro.raw_equals(NO) && seg.raw_equals(D(0)) } { @@ -210,7 +211,7 @@ pub fn jet_ut_rest(context: &mut Context, subject: Noun) -> Result { match context.cache.lookup(&mut context.stack, &mut key) { Some(pro) => Ok(pro), None => { - let pro = interpret(context, subject, slot(subject, 2)?)?; + let pro = ctx_interpret(context, subject, slot(subject, 2)?)?; context.cache = context.cache.insert(&mut context.stack, &mut key, pro); Ok(pro) } diff --git a/rust/ares/src/jets/nock.rs b/rust/ares/src/jets/nock.rs index 9c5964f6..f582abd4 100644 --- a/rust/ares/src/jets/nock.rs +++ b/rust/ares/src/jets/nock.rs @@ -71,7 +71,8 @@ pub fn jet_mute(context: &mut Context, subject: Noun) -> Result { pub mod util { use crate::hamt::Hamt; - use crate::interpreter::{interpret, Context, Error, Mote}; + use crate::interpreter::{interpret, Context, Error, Mote, WhichInterpreter}; + use crate::codegen::{cg_interpret, cg_interpret_cg}; use crate::jets; use crate::jets::bits::util::rip; use crate::jets::form::util::scow; @@ -84,6 +85,15 @@ pub mod util { pub const LEAF: Noun = D(tas!(b"leaf")); pub const ROSE: Noun = D(tas!(b"rose")); + pub fn ctx_interpret(context: &mut Context, subject: Noun, formula: Noun) -> crate::interpreter::Result { + match context.which { + // TODO: pass through slow stack + WhichInterpreter::TreeWalking => { interpret(context, subject, formula) }, + WhichInterpreter::TreeWalkingCodegen => { cg_interpret_cg(context, D(0), subject, formula) }, + WhichInterpreter::CodegenCodegen => { cg_interpret(context, D(0), subject, formula) }, + } + } + /// The classic "slam gate" formula. pub fn slam_gate_fol(stack: &mut NockStack) -> Noun { T(stack, &[D(9), D(2), D(0), D(1)]) @@ -152,7 +162,7 @@ pub mod util { context.cache = Hamt::::new(&mut context.stack); context.scry_stack = T(&mut context.stack, &[scry, context.scry_stack]); - match interpret(context, subject, formula) { + match ctx_interpret(context, subject, formula) { Ok(res) => { context.cache = cache_snapshot; context.scry_stack = scry_snapshot; diff --git a/rust/ares/src/jets/seam.rs b/rust/ares/src/jets/seam.rs new file mode 100644 index 00000000..c5f3ad67 --- /dev/null +++ b/rust/ares/src/jets/seam.rs @@ -0,0 +1,103 @@ +/* map/set jets + */ +// use crate::interpreter::Context; +// use crate::jets::bits::util::*; +// use crate::jets::util::*; +// use crate::jets::Result; +// use crate::noun::{IndirectAtom, Noun, D}; +//use self::util::*; + +crate::gdb!(); + +// XX TODO actual jets + +pub mod util { + use crate::jets::math::util::lth_b; + use crate::jets::util::slot; + use crate::jets::JetErr; + use crate::mem::NockStack; + use crate::mug::mug_u32; + use crate::noun::{Noun, D}; + use crate::unifying_equality::unifying_equality; + use either::Either::*; + + pub fn dor_b(stack: &mut NockStack, a: &mut Noun, b: &mut Noun) -> bool { + let mut ap = a as *mut Noun; + let mut bp = b as *mut Noun; + + unsafe { + loop { + if unifying_equality(stack, ap, bp) { + break true; + } else { + match (*ap).as_either_atom_cell() { + Left(a_atom) => { + if let Ok(b_atom) = (*bp).as_atom() { + break lth_b(stack, a_atom, b_atom); + } else { + break true; + } + } + Right(a_cell) => { + if let Ok(b_cell) = (*bp).as_cell() { + if unifying_equality( + stack, + a_cell.head_as_mut(), + b_cell.head_as_mut(), + ) { + ap = a_cell.tail_as_mut(); + bp = b_cell.tail_as_mut(); + continue; + } else { + ap = a_cell.head_as_mut(); + bp = b_cell.head_as_mut(); + continue; + } + } else { + break false; + } + } + } + } + } + } + } + + pub fn gor_b(stack: &mut NockStack, a: &mut Noun, b: &mut Noun) -> bool { + let c = mug_u32(stack, *a); + let d = mug_u32(stack, *b); + if c == d { + dor_b(stack, a, b) + } else { + c < d + } + } + + pub fn get_by( + stack: &mut NockStack, + a: &mut Noun, + b: &mut Noun, + ) -> Result, JetErr> { + let mut ap = a as *mut Noun; + let bp = b as *mut Noun; + unsafe { + loop { + if (*ap).raw_equals(D(0)) { + break Ok(None); + } + let na = slot(*ap, 2)?; // n.a + let mut pna = slot(na, 2)?; // p.n.a + if unifying_equality(stack, bp, &mut pna) { + break Ok(Some(slot(na, 3)?)); // q.n.a + } + let lr_cell = slot(*ap, 3)?.as_cell()?; + + ap = if gor_b(stack, &mut (*bp), &mut pna) { + lr_cell.head_as_mut() + } else { + lr_cell.tail_as_mut() + }; + } + } + } +} diff --git a/rust/ares/src/lib.rs b/rust/ares/src/lib.rs index e7c37ec9..1af3eecf 100644 --- a/rust/ares/src/lib.rs +++ b/rust/ares/src/lib.rs @@ -3,11 +3,13 @@ extern crate num_derive; extern crate lazy_static; #[macro_use] extern crate static_assertions; +pub mod codegen; pub mod flog; pub mod guard; pub mod hamt; pub mod interpreter; pub mod jets; +pub mod load; pub mod mem; pub mod mug; pub mod newt; diff --git a/rust/ares/src/load.rs b/rust/ares/src/load.rs new file mode 100644 index 00000000..e713837e --- /dev/null +++ b/rust/ares/src/load.rs @@ -0,0 +1,17 @@ +use crate::jets::util::slot; +use crate::mem::NockStack; +use crate::noun::{Noun, D}; +use crate::serialization::cue_bytes; +use crate::mug::mug_u32; +use ares_macros::tas; +use std::include_bytes; + +// formula, subject +pub fn load_cg(stack: &mut NockStack) -> (Noun, Noun) { + let cg_bytes = include_bytes!("../bin/cg.jam"); + let cg_noun = cue_bytes(stack, cg_bytes); + let cg_mug = mug_u32(stack, cg_noun); + eprintln!("codegen mug: {:x}", cg_mug); + assert!(unsafe { slot(cg_noun, 2).unwrap().raw_equals(D(tas!(b"cg"))) }); + (slot(cg_noun, 6).unwrap(), slot(cg_noun, 7).unwrap()) +} diff --git a/rust/ares/src/mem.rs b/rust/ares/src/mem.rs index 6852139a..33922db7 100644 --- a/rust/ares/src/mem.rs +++ b/rust/ares/src/mem.rs @@ -1,7 +1,7 @@ use crate::assert_acyclic; use crate::assert_no_forwarding_pointers; use crate::assert_no_junior_pointers; -use crate::noun::{Atom, Cell, CellMemory, IndirectAtom, Noun, NounAllocator}; +use crate::noun::{Atom, Cell, CellMemory, IndirectAtom, Noun, NounAllocator, NOUN_NONE}; use assert_no_alloc::permit_alloc; use either::Either::{self, Left, Right}; use ibig::Stack; @@ -9,7 +9,7 @@ use memmap::MmapMut; use std::alloc::Layout; use std::mem; use std::ptr; -use std::ptr::copy_nonoverlapping; +use std::ptr::{copy, copy_nonoverlapping}; crate::gdb!(); @@ -146,6 +146,45 @@ impl NockStack { self.frame_pointer } + pub fn get_frame_base(&self) -> *mut u64 { + if self.is_west() { + unsafe { *(self.prev_alloc_pointer_pointer()) } + } else { + unsafe { self.frame_pointer.add(RESERVED) } + } + } + + pub unsafe fn resize_frame(&mut self, new_size: usize) { + // lightweight stack must be empty + assert!(self.stack_pointer == self.frame_pointer); + let raw_new_size = (new_size + RESERVED) as isize; + if self.is_west() { + let current_size = self + .frame_pointer + .offset_from(*(self.prev_alloc_pointer_pointer())); + assert!(current_size >= RESERVED as isize); + let offset = raw_new_size - current_size; + let new_frame_pointer = self.frame_pointer.offset(offset); + copy( + self.frame_pointer.sub(RESERVED), + new_frame_pointer.sub(RESERVED), + RESERVED, + ); + self.frame_pointer = new_frame_pointer; + self.stack_pointer = new_frame_pointer; + } else { + let current_size = + (*(self.prev_alloc_pointer_pointer())).offset_from(self.frame_pointer); + assert!(current_size >= RESERVED as isize); + let offset = current_size - raw_new_size; + let new_frame_pointer = self.frame_pointer.offset(offset); + let copy_size = current_size.min(raw_new_size) as usize; // OK because >= reserved + copy(self.frame_pointer, new_frame_pointer, copy_size); + self.frame_pointer = new_frame_pointer; + self.stack_pointer = new_frame_pointer; + } + } + /** Current stack pointer of this NockStack */ pub fn get_stack_pointer(&self) -> *const u64 { self.stack_pointer @@ -456,6 +495,11 @@ impl NockStack { let next_noun = *(self.top::()); self.pop::(); + if next_noun.is_none() { + *next_dest = NOUN_NONE; + continue; + } + // If it's a direct atom, just write it to the destination. // Otherwise, we have allocations to make. match next_noun.as_either_direct_allocated() { diff --git a/rust/ares/src/noun.rs b/rust/ares/src/noun.rs index 3ce5f80f..a66004b1 100644 --- a/rust/ares/src/noun.rs +++ b/rust/ares/src/noun.rs @@ -31,6 +31,9 @@ const CELL_TAG: u64 = u64::MAX & INDIRECT_MASK; /** Tag mask for a cell. */ const CELL_MASK: u64 = !(u64::MAX >> 3); +const NONE_BITS: u64 = !(u64::MAX >> 3); +pub const NOUN_NONE: Noun = Noun { raw: NONE_BITS }; + /* A note on forwarding pointers: * * Forwarding pointers are only used temporarily during copies between NockStack frames and between @@ -155,6 +158,10 @@ fn is_cell(noun: u64) -> bool { noun & CELL_MASK == CELL_TAG } +fn is_none(noun: u64) -> bool { + noun == NONE_BITS +} + /** A noun-related error. */ #[derive(Debug, PartialEq)] pub enum Error { @@ -586,6 +593,7 @@ pub struct Cell(u64); impl Cell { pub unsafe fn from_raw_pointer(ptr: *const CellMemory) -> Self { + assert!(!ptr.is_null()); Cell((ptr as u64) >> 3 | CELL_TAG) } @@ -1023,14 +1031,16 @@ pub union Noun { impl Noun { pub fn is_none(self) -> bool { - unsafe { self.raw == u64::MAX } + unsafe { is_none(self.raw) } } pub fn is_direct(&self) -> bool { + assert!(!self.is_none()); unsafe { is_direct_atom(self.raw) } } pub fn is_indirect(&self) -> bool { + assert!(!self.is_none()); unsafe { is_indirect_atom(self.raw) } } @@ -1043,6 +1053,7 @@ impl Noun { } pub fn is_cell(&self) -> bool { + assert!(!self.is_none()); unsafe { is_cell(self.raw) } } diff --git a/rust/ares/src/serf.rs b/rust/ares/src/serf.rs index be84067b..5e3a9e0b 100644 --- a/rust/ares/src/serf.rs +++ b/rust/ares/src/serf.rs @@ -1,14 +1,16 @@ +use crate::codegen::cg_interpret; use crate::hamt::Hamt; -use crate::interpreter::{inc, interpret, Error, Mote}; +use crate::interpreter::{inc, interpret, Error, Mote, WhichInterpreter}; use crate::jets::cold::Cold; use crate::jets::hot::{Hot, HotEntry}; use crate::jets::list::util::{lent, zing}; use crate::jets::nock::util::mook; use crate::jets::warm::Warm; +use crate::load::load_cg; use crate::mem::NockStack; use crate::mug::*; use crate::newt::Newt; -use crate::noun::{Atom, Cell, DirectAtom, Noun, Slots, D, T}; +use crate::noun::{Atom, Cell, DirectAtom, Noun, Slots, D, NOUN_NONE, T}; use crate::persist::pma_meta_set; use crate::persist::{pma_meta_get, pma_open, pma_sync, Persist}; use crate::trace::*; @@ -40,9 +42,11 @@ impl Persist for Snapshot { unsafe fn space_needed(&mut self, stack: &mut NockStack) -> usize { let mut arvo = (*(self.0)).arvo; let mut cold = (*(self.0)).cold; + let mut line = (*(self.0)).line; let arvo_space_needed = arvo.space_needed(stack); let cold_space_needed = cold.space_needed(stack); - (((size_of::() + 7) >> 3) << 3) + arvo_space_needed + cold_space_needed + let line_space_needed = line.space_needed(stack); + (((size_of::() + 7) >> 3) << 3) + arvo_space_needed + cold_space_needed + line_space_needed } unsafe fn copy_to_buffer(&mut self, stack: &mut NockStack, buffer: &mut *mut u8) { @@ -58,6 +62,10 @@ impl Persist for Snapshot { let mut cold = (*snapshot_buffer).cold; cold.copy_to_buffer(stack, buffer); (*snapshot_buffer).cold = cold; + + let mut line = (*snapshot_buffer).line; + line.copy_to_buffer(stack, buffer); + (*snapshot_buffer).line = line; } unsafe fn handle_to_u64(&self) -> u64 { @@ -76,6 +84,7 @@ struct SnapshotMem { pub event_num: u64, pub arvo: Noun, pub cold: Cold, + pub line: Noun, } const PMA_CURRENT_SNAPSHOT_VERSION: u64 = 1; @@ -119,6 +128,7 @@ impl Context { (*snapshot_mem_ptr).event_num = self.event_num; (*snapshot_mem_ptr).arvo = self.arvo; (*snapshot_mem_ptr).cold = self.nock_context.cold; + (*snapshot_mem_ptr).line = self.nock_context.line; snapshot_mem_ptr }); @@ -128,6 +138,7 @@ impl Context { self.arvo = (*snapshot.0).arvo; self.event_num = (*snapshot.0).event_num; self.nock_context.cold = (*snapshot.0).cold; + self.nock_context.line = (*snapshot.0).line; handle }; @@ -147,15 +158,16 @@ impl Context { let newt = Newt::new(); let cache = Hamt::::new(&mut stack); - let (epoch, event_num, arvo, mut cold) = unsafe { + let (epoch, event_num, arvo, mut cold, line) = unsafe { match snapshot { Some(snapshot) => ( (*(snapshot.0)).epoch, (*(snapshot.0)).event_num, (*(snapshot.0)).arvo, (*(snapshot.0)).cold, + (*(snapshot.0)).line, ), - None => (0, 0, D(0), Cold::new(&mut stack)), + None => (0, 0, D(0), Cold::new(&mut stack), NOUN_NONE), } }; @@ -163,7 +175,7 @@ impl Context { let warm = Warm::init(&mut stack, &mut cold, &hot); let mug = mug_u32(&mut stack, arvo); - let nock_context = interpreter::Context { + let mut nock_context = interpreter::Context { stack, newt, cold, @@ -172,8 +184,17 @@ impl Context { cache, scry_stack: D(0), trace_info, + line, + which: WhichInterpreter::CodegenCodegen, }; + // XX presently no way to upgrade the codegen nock + if nock_context.line.is_none() { + let (cg_f, cg_s) = load_cg(&mut nock_context.stack); + let line = interpret(&mut nock_context, cg_s, cg_f).expect("Could not successfully kick codegen trap"); + nock_context.line = line; + } + Context { epoch, event_num, @@ -412,7 +433,7 @@ fn slam(context: &mut Context, axis: u64, ovo: Noun) -> Result { let fol = T(stack, &[D(8), pul, D(9), D(2), D(10), sam, D(0), D(2)]); let sub = T(stack, &[arvo, ovo]); - interpret(&mut context.nock_context, sub, fol) + cg_interpret(&mut context.nock_context, D(0), sub, fol) } fn peek(context: &mut Context, ovo: Noun) -> Noun { @@ -476,12 +497,12 @@ fn play_life(context: &mut Context, eve: Noun) { let res = if context.nock_context.trace_info.is_some() { let trace_name = "boot"; let start = Instant::now(); - let boot_res = interpret(&mut context.nock_context, eve, lyf); + let boot_res = cg_interpret(&mut context.nock_context, D(0), eve, lyf); write_serf_trace_safe(&mut context.nock_context, trace_name, start); boot_res } else { - interpret(&mut context.nock_context, eve, lyf) + cg_interpret(&mut context.nock_context, D(0), eve, lyf) }; match res { diff --git a/rust/ares/src/serialization.rs b/rust/ares/src/serialization.rs index 9975c37f..5e4d0b7e 100644 --- a/rust/ares/src/serialization.rs +++ b/rust/ares/src/serialization.rs @@ -2,7 +2,7 @@ use crate::assert_acyclic; use crate::hamt::MutHamt; use crate::mem::NockStack; use crate::noun::{Atom, Cell, DirectAtom, IndirectAtom, Noun}; -use bitvec::prelude::{BitSlice, Lsb0}; +use bitvec::prelude::{BitSlice, BitStore, Lsb0}; use either::Either::{Left, Right}; crate::gdb!(); @@ -24,7 +24,11 @@ pub fn met0_u64_to_usize(x: u64) -> usize { } pub fn cue(stack: &mut NockStack, buffer: Atom) -> Noun { - let buffer_bitslice = buffer.as_bitslice(); + cue_bytes(stack, buffer.as_bytes()) +} + +pub fn cue_bytes(stack: &mut NockStack, buffer: &[u8]) -> Noun { + let buffer_bitslice: &BitSlice = BitSlice::from_slice(buffer); let mut cursor: usize = 0; let backref_map = MutHamt::::new(stack); stack.frame_push(1); @@ -98,7 +102,7 @@ pub fn cue(stack: &mut NockStack, buffer: Atom) -> Noun { } // TODO: use first_zero() on a slice of the buffer -fn get_size(cursor: &mut usize, buffer: &BitSlice) -> usize { +fn get_size(cursor: &mut usize, buffer: &BitSlice) -> usize { let buff_at_cursor = &buffer[*cursor..]; let bitsize = buff_at_cursor .first_one() @@ -108,43 +112,47 @@ fn get_size(cursor: &mut usize, buffer: &BitSlice) -> usize { 0 } else { let mut size: u64 = 0; - BitSlice::from_element_mut(&mut size)[0..bitsize - 1] - .copy_from_bitslice(&buffer[*cursor + bitsize + 1..*cursor + bitsize + bitsize]); + BitSlice::::from_element_mut(&mut size)[0..bitsize - 1] + .clone_from_bitslice(&buffer[*cursor + bitsize + 1..*cursor + bitsize + bitsize]); *cursor += bitsize + bitsize; (size as usize) + (1 << (bitsize - 1)) } } -fn rub_atom(stack: &mut NockStack, cursor: &mut usize, buffer: &BitSlice) -> Atom { +fn rub_atom( + stack: &mut NockStack, + cursor: &mut usize, + buffer: &BitSlice, +) -> Atom { let size = get_size(cursor, buffer); if size == 0 { unsafe { DirectAtom::new_unchecked(0).as_atom() } } else if size < 64 { // fits in a direct atom let mut direct_raw = 0; - BitSlice::from_element_mut(&mut direct_raw)[0..size] - .copy_from_bitslice(&buffer[*cursor..*cursor + size]); + BitSlice::::from_element_mut(&mut direct_raw)[0..size] + .clone_from_bitslice(&buffer[*cursor..*cursor + size]); *cursor += size; unsafe { DirectAtom::new_unchecked(direct_raw).as_atom() } } else { // need an indirect atom let wordsize = (size + 63) >> 6; let (atom, slice) = unsafe { IndirectAtom::new_raw_mut_bitslice(stack, wordsize) }; // fast round to wordsize - slice[0..size].copy_from_bitslice(&buffer[*cursor..*cursor + size]); + slice[0..size].clone_from_bitslice(&buffer[*cursor..*cursor + size]); debug_assert!(atom.size() > 0); *cursor += size; atom.as_atom() } } -fn rub_backref(cursor: &mut usize, buffer: &BitSlice) -> u64 { +fn rub_backref(cursor: &mut usize, buffer: &BitSlice) -> u64 { let size = get_size(cursor, buffer); if size == 0 { 0 } else if size <= 64 { let mut backref: u64 = 0; - BitSlice::from_element_mut(&mut backref)[0..size] - .copy_from_bitslice(&buffer[*cursor..*cursor + size]); + BitSlice::::from_element_mut(&mut backref)[0..size] + .clone_from_bitslice(&buffer[*cursor..*cursor + size]); *cursor += size; backref } else {