hoon-138.hoon 416 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286132871328813289132901329113292132931329413295132961329713298132991330013301133021330313304133051330613307133081330913310133111331213313133141331513316133171331813319133201332113322133231332413325133261332713328133291333013331133321333313334133351333613337133381333913340133411334213343133441334513346133471334813349133501335113352133531335413355133561335713358133591336013361133621336313364133651336613367133681336913370133711337213373133741337513376133771337813379133801338113382133831338413385133861338713388133891339013391133921339313394133951339613397133981339913400134011340213403134041340513406134071340813409134101341113412134131341413415134161341713418134191342013421134221342313424134251342613427134281342913430134311343213433134341343513436134371343813439134401344113442134431344413445134461344713448134491345013451134521345313454134551345613457134581345913460134611346213463134641346513466134671346813469134701347113472134731347413475134761347713478134791348013481134821348313484134851348613487134881348913490134911349213493134941349513496134971349813499135001350113502135031350413505135061350713508135091351013511135121351313514135151351613517135181351913520135211352213523135241352513526135271352813529135301353113532135331353413535135361353713538135391354013541135421354313544135451354613547135481354913550135511355213553135541355513556135571355813559135601356113562135631356413565135661356713568135691357013571135721357313574135751357613577135781357913580135811358213583135841358513586135871358813589135901359113592135931359413595135961359713598135991360013601136021360313604136051360613607136081360913610136111361213613136141361513616136171361813619136201362113622136231362413625136261362713628136291363013631136321363313634136351363613637136381363913640136411364213643136441364513646136471364813649136501365113652136531365413655136561365713658136591366013661136621366313664136651366613667136681366913670136711367213673136741367513676136771367813679136801368113682136831368413685136861368713688136891369013691136921369313694136951369613697136981369913700137011370213703137041370513706137071370813709137101371113712137131371413715137161371713718137191372013721137221372313724137251372613727137281372913730137311373213733137341373513736137371373813739137401374113742137431374413745137461374713748137491375013751137521375313754137551375613757137581375913760137611376213763137641376513766137671376813769137701377113772137731377413775137761377713778137791378013781137821378313784137851378613787137881378913790137911379213793137941379513796137971379813799138001380113802138031380413805138061380713808138091381013811138121381313814138151381613817138181381913820138211382213823138241382513826138271382813829138301383113832138331383413835138361383713838138391384013841138421384313844138451384613847138481384913850138511385213853138541385513856138571385813859138601386113862138631386413865138661386713868138691387013871138721387313874138751387613877138781387913880138811388213883138841388513886138871388813889138901389113892138931389413895138961389713898138991390013901139021390313904139051390613907139081390913910139111391213913139141391513916139171391813919139201392113922139231392413925139261392713928139291393013931139321393313934139351393613937139381393913940139411394213943139441394513946139471394813949139501395113952139531395413955139561395713958139591396013961139621396313964139651396613967139681396913970139711397213973139741397513976139771397813979139801398113982139831398413985139861398713988139891399013991139921399313994139951399613997139981399914000140011400214003140041400514006140071400814009140101401114012140131401414015140161401714018140191402014021140221402314024140251402614027140281402914030140311403214033140341403514036140371403814039140401404114042140431404414045140461404714048140491405014051140521405314054140551405614057140581405914060140611406214063140641406514066140671406814069140701407114072140731407414075
  1. ::
  2. :::: /sys/hoon ::
  3. :: ::
  4. =< ride
  5. => %138 =>
  6. :: ::
  7. :::: 0: version stub ::
  8. :: ::
  9. ~% %k.138 ~ ~ ::
  10. |%
  11. ++ hoon-version +
  12. -- =>
  13. ~% %one + ~
  14. :: layer-1
  15. ::
  16. :: basic mathematical operations
  17. |%
  18. :: unsigned arithmetic
  19. +| %math
  20. ++ add
  21. ~/ %add
  22. :: unsigned addition
  23. ::
  24. :: a: augend
  25. :: b: addend
  26. |= [a=@ b=@]
  27. :: sum
  28. ^- @
  29. ?: =(0 a) b
  30. $(a (dec a), b +(b))
  31. ::
  32. ++ dec
  33. ~/ %dec
  34. :: unsigned decrement by one.
  35. |= a=@
  36. ~_ leaf+"decrement-underflow"
  37. ?< =(0 a)
  38. =+ b=0
  39. :: decremented integer
  40. |- ^- @
  41. ?: =(a +(b)) b
  42. $(b +(b))
  43. ::
  44. ++ div
  45. ~/ %div
  46. :: unsigned divide
  47. ::
  48. :: a: dividend
  49. :: b: divisor
  50. |: [a=`@`1 b=`@`1]
  51. :: quotient
  52. ^- @
  53. -:(dvr a b)
  54. ::
  55. ++ dvr
  56. ~/ %dvr
  57. :: unsigned divide with remainder
  58. ::
  59. :: a: dividend
  60. :: b: divisor
  61. |: [a=`@`1 b=`@`1]
  62. :: p: quotient
  63. :: q: remainder
  64. ^- [p=@ q=@]
  65. ~_ leaf+"divide-by-zero"
  66. ?< =(0 b)
  67. =+ c=0
  68. |-
  69. ?: (lth a b) [c a]
  70. $(a (sub a b), c +(c))
  71. ::
  72. ++ gte
  73. ~/ %gte
  74. :: unsigned greater than or equals
  75. ::
  76. :: returns whether {a >= b}.
  77. ::
  78. :: a: left hand operand (todo: name)
  79. :: b: right hand operand
  80. |= [a=@ b=@]
  81. :: greater than or equal to?
  82. ^- ?
  83. !(lth a b)
  84. ::
  85. ++ gth
  86. ~/ %gth
  87. :: unsigned greater than
  88. ::
  89. :: returns whether {a > b}
  90. ::
  91. :: a: left hand operand (todo: name)
  92. :: b: right hand operand
  93. |= [a=@ b=@]
  94. :: greater than?
  95. ^- ?
  96. !(lte a b)
  97. ::
  98. ++ lte
  99. ~/ %lte
  100. :: unsigned less than or equals
  101. ::
  102. :: returns whether {a >= b}.
  103. ::
  104. :: a: left hand operand (todo: name)
  105. :: b: right hand operand
  106. |= [a=@ b=@]
  107. :: less than or equal to?
  108. |(=(a b) (lth a b))
  109. ::
  110. ++ lth
  111. ~/ %lth
  112. :: unsigned less than
  113. ::
  114. :: a: left hand operand (todo: name)
  115. :: b: right hand operand
  116. |= [a=@ b=@]
  117. :: less than?
  118. ^- ?
  119. ?& !=(a b)
  120. |-
  121. ?| =(0 a)
  122. ?& !=(0 b)
  123. $(a (dec a), b (dec b))
  124. == == ==
  125. ::
  126. ++ max
  127. ~/ %max
  128. :: unsigned maximum
  129. |= [a=@ b=@]
  130. :: the maximum
  131. ^- @
  132. ?: (gth a b) a
  133. b
  134. ::
  135. ++ min
  136. ~/ %min
  137. :: unsigned minimum
  138. |= [a=@ b=@]
  139. :: the minimum
  140. ^- @
  141. ?: (lth a b) a
  142. b
  143. ::
  144. ++ mod
  145. ~/ %mod
  146. :: unsigned modulus
  147. ::
  148. :: a: dividend
  149. :: b: divisor
  150. |: [a=`@`1 b=`@`1]
  151. :: the remainder
  152. ^- @
  153. +:(dvr a b)
  154. ::
  155. ++ mul
  156. ~/ %mul
  157. :: unsigned multiplication
  158. ::
  159. :: a: multiplicand
  160. :: b: multiplier
  161. |: [a=`@`1 b=`@`1]
  162. :: product
  163. ^- @
  164. =+ c=0
  165. |-
  166. ?: =(0 a) c
  167. $(a (dec a), c (add b c))
  168. ::
  169. ++ sub
  170. ~/ %sub
  171. :: unsigned subtraction
  172. ::
  173. :: a: minuend
  174. :: b: subtrahend
  175. |= [a=@ b=@]
  176. ~_ leaf+"subtract-underflow"
  177. :: difference
  178. ^- @
  179. ?: =(0 b) a
  180. $(a (dec a), b (dec b))
  181. ::
  182. :: tree addressing
  183. +| %tree
  184. ++ cap
  185. ~/ %cap
  186. :: tree head
  187. ::
  188. :: tests whether an `a` is in the head or tail of a noun. produces %2 if it
  189. :: is within the head, or %3 if it is within the tail.
  190. |= a=@
  191. ^- ?(%2 %3)
  192. ?- a
  193. %2 %2
  194. %3 %3
  195. ?(%0 %1) !!
  196. * $(a (div a 2))
  197. ==
  198. ::
  199. ++ mas
  200. ~/ %mas
  201. :: axis within head/tail
  202. ::
  203. :: computes the axis of `a` within either the head or tail of a noun
  204. :: (depends whether `a` lies within the the head or tail).
  205. |= a=@
  206. ^- @
  207. ?- a
  208. ?(%2 %3) 1
  209. ?(%0 %1) !!
  210. * (add (mod a 2) (mul $(a (div a 2)) 2))
  211. ==
  212. ::
  213. ++ peg
  214. ~/ %peg
  215. :: axis within axis
  216. ::
  217. :: computes the axis of {b} within axis {a}.
  218. |= [a=@ b=@]
  219. ?< =(0 a)
  220. ?< =(0 b)
  221. :: a composed axis
  222. ^- @
  223. ?- b
  224. %1 a
  225. %2 (mul a 2)
  226. %3 +((mul a 2))
  227. * (add (mod b 2) (mul $(b (div b 2)) 2))
  228. ==
  229. ::
  230. :: # %containers
  231. ::
  232. :: the most basic of data types
  233. +| %containers
  234. ::
  235. +$ bite
  236. :: atom slice specifier
  237. ::
  238. $@(bloq [=bloq =step])
  239. ::
  240. +$ bloq
  241. :: blocksize
  242. ::
  243. :: a blocksize is the power of 2 size of an atom. ie, 3 is a byte as 2^3 is
  244. :: 8 bits.
  245. @
  246. ::
  247. ++ each
  248. |$ [this that]
  249. :: either {a} or {b}, defaulting to {a}.
  250. ::
  251. :: mold generator: produces a discriminated fork between two types,
  252. :: defaulting to {a}.
  253. ::
  254. $% [%| p=that]
  255. [%& p=this]
  256. ==
  257. ::
  258. +$ gate
  259. :: function
  260. ::
  261. :: a core with one arm, `$`--the empty name--which transforms a sample noun
  262. :: into a product noun. If used dryly as a type, the subject must have a
  263. :: sample type of `*`.
  264. $-(* *)
  265. ::
  266. ++ list
  267. |$ [item]
  268. :: null-terminated list
  269. ::
  270. :: mold generator: produces a mold of a null-terminated list of the
  271. :: homogeneous type {a}.
  272. ::
  273. $@(~ [i=item t=(list item)])
  274. ::
  275. ++ lone
  276. |$ [item]
  277. :: single item tuple
  278. ::
  279. :: mold generator: puts the face of `p` on the passed in mold.
  280. ::
  281. p=item
  282. ::
  283. ++ lest
  284. |$ [item]
  285. :: null-terminated non-empty list
  286. ::
  287. :: mold generator: produces a mold of a null-terminated list of the
  288. :: homogeneous type {a} with at least one element.
  289. [i=item t=(list item)]
  290. ::
  291. +$ mold
  292. :: normalizing gate
  293. ::
  294. :: a gate that accepts any noun, and validates its shape, producing the
  295. :: input if it fits or a default value if it doesn't.
  296. ::
  297. :: examples: * @ud ,[p=time q=?(%a %b)]
  298. $~(* $-(* *))
  299. ::
  300. ++ pair
  301. |$ [head tail]
  302. :: dual tuple
  303. ::
  304. :: mold generator: produces a tuple of the two types passed in.
  305. ::
  306. :: a: first type, labeled {p}
  307. :: b: second type, labeled {q}
  308. ::
  309. [p=head q=tail]
  310. ::
  311. ++ pole
  312. |$ [item]
  313. :: faceless list
  314. ::
  315. :: like ++list, but without the faces {i} and {t}.
  316. ::
  317. $@(~ [item (pole item)])
  318. ::
  319. ++ qual
  320. |$ [first second third fourth]
  321. :: quadruple tuple
  322. ::
  323. :: mold generator: produces a tuple of the four types passed in.
  324. ::
  325. [p=first q=second r=third s=fourth]
  326. ::
  327. ++ quip
  328. |$ [item state]
  329. :: pair of list of first and second
  330. ::
  331. :: a common pattern in hoon code is to return a ++list of changes, along with
  332. :: a new state.
  333. ::
  334. :: a: type of list item
  335. :: b: type of returned state
  336. ::
  337. [(list item) state]
  338. ::
  339. ++ step
  340. :: atom size or offset, in bloqs
  341. ::
  342. _`@u`1
  343. ::
  344. ++ trap
  345. |$ [product]
  346. :: a core with one arm `$`
  347. ::
  348. _|?($:product)
  349. ::
  350. ++ tree
  351. |$ [node]
  352. :: tree mold generator
  353. ::
  354. :: a `++tree` can be empty, or contain a node of a type and
  355. :: left/right sub `++tree` of the same type. pretty-printed with `{}`.
  356. ::
  357. $@(~ [n=node l=(tree node) r=(tree node)])
  358. ::
  359. ++ trel
  360. |$ [first second third]
  361. :: triple tuple
  362. ::
  363. :: mold generator: produces a tuple of the three types passed in.
  364. ::
  365. [p=first q=second r=third]
  366. ::
  367. ++ unit
  368. |$ [item]
  369. :: maybe
  370. ::
  371. :: mold generator: either `~` or `[~ u=a]` where `a` is the
  372. :: type that was passed in.
  373. ::
  374. $@(~ [~ u=item])
  375. -- =>
  376. ::
  377. ~% %two + ~
  378. :: layer-2
  379. ::
  380. |%
  381. :: 2a: unit logic
  382. +| %unit-logc
  383. ::
  384. ++ biff :: apply
  385. |* [a=(unit) b=$-(* (unit))]
  386. ?~ a ~
  387. (b u.a)
  388. ::
  389. ++ bind :: argue
  390. |* [a=(unit) b=gate]
  391. ?~ a ~
  392. [~ u=(b u.a)]
  393. ::
  394. ++ bond :: replace
  395. |* a=(trap)
  396. |* b=(unit)
  397. ?~ b $:a
  398. u.b
  399. ::
  400. ++ both :: all the above
  401. |* [a=(unit) b=(unit)]
  402. ?~ a ~
  403. ?~ b ~
  404. [~ u=[u.a u.b]]
  405. ::
  406. ++ clap :: combine
  407. |* [a=(unit) b=(unit) c=_=>(~ |=(^ +<-))]
  408. ?~ a b
  409. ?~ b a
  410. [~ u=(c u.a u.b)]
  411. ::
  412. ++ clef :: compose
  413. |* [a=(unit) b=(unit) c=_=>(~ |=(^ `+<-))]
  414. ?~ a ~
  415. ?~ b ~
  416. (c u.a u.b)
  417. ::
  418. ++ drop :: enlist
  419. |* a=(unit)
  420. ?~ a ~
  421. [i=u.a t=~]
  422. ::
  423. ++ fall :: default
  424. |* [a=(unit) b=*]
  425. ?~(a b u.a)
  426. ::
  427. ++ flit :: make filter
  428. |* a=$-(* ?)
  429. |* b=*
  430. ?.((a b) ~ [~ u=b])
  431. ::
  432. ++ hunt :: first of units
  433. |* [ord=$-(^ ?) a=(unit) b=(unit)]
  434. ^- %- unit
  435. $? _?>(?=(^ a) u.a)
  436. _?>(?=(^ b) u.b)
  437. ==
  438. ?~ a b
  439. ?~ b a
  440. ?:((ord u.a u.b) a b)
  441. ::
  442. ++ lift :: lift mold (fmap)
  443. |* a=mold :: flipped
  444. |* b=(unit) :: curried
  445. (bind b a) :: bind
  446. ::
  447. ++ mate :: choose
  448. |* [a=(unit) b=(unit)]
  449. ?~ b a
  450. ?~ a b
  451. ?.(=(u.a u.b) ~>(%mean.'mate' !!) a)
  452. ::
  453. ++ need :: demand
  454. ~/ %need
  455. |* a=(unit)
  456. ?~ a ~>(%mean.'need' !!)
  457. u.a
  458. ::
  459. ++ some :: lift (pure)
  460. |* a=*
  461. [~ u=a]
  462. ::
  463. :: 2b: list logic
  464. +| %list-logic
  465. :: +snoc: append an element to the end of a list
  466. ::
  467. ++ snoc
  468. |* [a=(list) b=*]
  469. (weld a ^+(a [b]~))
  470. ::
  471. :: +lure: List pURE
  472. ++ lure
  473. |* a=*
  474. [i=a t=~]
  475. ::
  476. ++ fand :: all indices
  477. ~/ %fand
  478. |= [nedl=(list) hstk=(list)]
  479. =| i=@ud
  480. =| fnd=(list @ud)
  481. |- ^+ fnd
  482. =+ [n=nedl h=hstk]
  483. |-
  484. ?: |(?=(~ n) ?=(~ h))
  485. (flop fnd)
  486. ?: =(i.n i.h)
  487. ?~ t.n
  488. ^$(i +(i), hstk +.hstk, fnd [i fnd])
  489. $(n t.n, h t.h)
  490. ^$(i +(i), hstk +.hstk)
  491. ::
  492. ++ find :: first index
  493. ~/ %find
  494. |= [nedl=(list) hstk=(list)]
  495. =| i=@ud
  496. |- ^- (unit @ud)
  497. =+ [n=nedl h=hstk]
  498. |-
  499. ?: |(?=(~ n) ?=(~ h))
  500. ~
  501. ?: =(i.n i.h)
  502. ?~ t.n
  503. `i
  504. $(n t.n, h t.h)
  505. ^$(i +(i), hstk +.hstk)
  506. ::
  507. ++ flop :: reverse
  508. ~/ %flop
  509. |* a=(list)
  510. => .(a (homo a))
  511. ^+ a
  512. =+ b=`_a`~
  513. |-
  514. ?~ a b
  515. $(a t.a, b [i.a b])
  516. ::
  517. ++ gulf :: range inclusive
  518. |= [a=@ b=@]
  519. ?> (lte a b)
  520. |- ^- (list @)
  521. ?:(=(a +(b)) ~ [a $(a +(a))])
  522. ::
  523. ++ homo :: homogenize
  524. |* a=(list)
  525. ^+ =< $
  526. |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
  527. --
  528. a
  529. :: +join: construct a new list, placing .sep between every pair in .lit
  530. ::
  531. ++ join
  532. |* [sep=* lit=(list)]
  533. =. sep `_?>(?=(^ lit) i.lit)`sep
  534. ?~ lit ~
  535. =| out=(list _?>(?=(^ lit) i.lit))
  536. |- ^+ out
  537. ?~ t.lit
  538. (flop [i.lit out])
  539. $(out [sep i.lit out], lit t.lit)
  540. ::
  541. :: +bake: convert wet gate to dry gate by specifying argument mold
  542. ::
  543. ++ bake
  544. |* [f=gate a=mold]
  545. |= arg=a
  546. (f arg)
  547. ::
  548. ++ lent :: length
  549. ~/ %lent
  550. |= a=(list)
  551. ^- @
  552. =+ b=0
  553. |-
  554. ?~ a b
  555. $(a t.a, b +(b))
  556. ::
  557. ++ levy
  558. ~/ %levy :: all of
  559. |* [a=(list) b=$-(* ?)]
  560. |- ^- ?
  561. ?~ a &
  562. ?. (b i.a) |
  563. $(a t.a)
  564. ::
  565. ++ lien :: some of
  566. ~/ %lien
  567. |* [a=(list) b=$-(* ?)]
  568. |- ^- ?
  569. ?~ a |
  570. ?: (b i.a) &
  571. $(a t.a)
  572. ::
  573. ++ limo :: listify
  574. |* a=*
  575. ^+ =< $
  576. |@ ++ $ ?~(a ~ ?:(*? [i=-.a t=$] $(a +.a)))
  577. --
  578. a
  579. ::
  580. ++ murn :: maybe transform
  581. ~/ %murn
  582. |* [a=(list) b=$-(* (unit))]
  583. => .(a (homo a))
  584. |- ^- (list _?>(?=(^ a) (need (b i.a))))
  585. ?~ a ~
  586. =/ c (b i.a)
  587. ?~ c $(a t.a)
  588. [+.c $(a t.a)]
  589. ::
  590. ++ oust :: remove
  591. ~/ %oust
  592. |* [[a=@ b=@] c=(list)]
  593. (weld (scag +<-< c) (slag (add +<-< +<->) c))
  594. ::
  595. ++ reap :: replicate
  596. ~/ %reap
  597. |* [a=@ b=*]
  598. |- ^- (list _b)
  599. ?~ a ~
  600. [b $(a (dec a))]
  601. ::
  602. ++ rear :: last item of list
  603. ~/ %rear
  604. |* a=(list)
  605. ^- _?>(?=(^ a) i.a)
  606. ?> ?=(^ a)
  607. ?: =(~ t.a) i.a ::NOTE avoiding tmi
  608. $(a t.a)
  609. ::
  610. ++ reel :: right fold
  611. ~/ %reel
  612. |* [a=(list) b=_=>(~ |=([* *] +<+))]
  613. |- ^+ ,.+<+.b
  614. ?~ a
  615. +<+.b
  616. (b i.a $(a t.a))
  617. ::
  618. ++ roll :: left fold
  619. ~/ %roll
  620. |* [a=(list) b=_=>(~ |=([* *] +<+))]
  621. |- ^+ ,.+<+.b
  622. ?~ a
  623. +<+.b
  624. $(a t.a, b b(+<+ (b i.a +<+.b)))
  625. ::
  626. ++ scag :: prefix
  627. ~/ %scag
  628. |* [a=@ b=(list)]
  629. |- ^+ b
  630. ?: |(?=(~ b) =(0 a)) ~
  631. [i.b $(b t.b, a (dec a))]
  632. ::
  633. ++ skid :: separate
  634. ~/ %skid
  635. |* [a=(list) b=$-(* ?)]
  636. |- ^+ [p=a q=a]
  637. ?~ a [~ ~]
  638. =+ c=$(a t.a)
  639. ?:((b i.a) [[i.a p.c] q.c] [p.c [i.a q.c]])
  640. ::
  641. ++ skim :: only
  642. ~/ %skim
  643. |* [a=(list) b=$-(* ?)]
  644. |-
  645. ^+ a
  646. ?~ a ~
  647. ?:((b i.a) [i.a $(a t.a)] $(a t.a))
  648. ::
  649. ++ skip :: except
  650. ~/ %skip
  651. |* [a=(list) b=$-(* ?)]
  652. |-
  653. ^+ a
  654. ?~ a ~
  655. ?:((b i.a) $(a t.a) [i.a $(a t.a)])
  656. ::
  657. ++ slag :: suffix
  658. ~/ %slag
  659. |* [a=@ b=(list)]
  660. |- ^+ b
  661. ?: =(0 a) b
  662. ?~ b ~
  663. $(b t.b, a (dec a))
  664. ::
  665. ++ snag :: index
  666. ~/ %snag
  667. |* [a=@ b=(list)]
  668. |- ^+ ?>(?=(^ b) i.b)
  669. ?~ b
  670. ~_ leaf+"snag-fail"
  671. !!
  672. ?: =(0 a) i.b
  673. $(b t.b, a (dec a))
  674. ::
  675. ++ snip :: drop tail off list
  676. ~/ %snip
  677. |* a=(list)
  678. ^+ a
  679. ?~ a ~
  680. ?: =(~ t.a) ~
  681. [i.a $(a t.a)]
  682. ::
  683. ++ sort !. :: quicksort
  684. ~/ %sort
  685. |* [a=(list) b=$-([* *] ?)]
  686. => .(a ^.(homo a))
  687. |- ^+ a
  688. ?~ a ~
  689. =+ s=(skid t.a |:(c=i.a (b c i.a)))
  690. %+ weld
  691. $(a p.s)
  692. ^+ t.a
  693. [i.a $(a q.s)]
  694. ::
  695. ++ spin :: stateful turn
  696. ::
  697. :: a: list
  698. :: b: state
  699. :: c: gate from list-item and state to product and new state
  700. ~/ %spin
  701. |* [a=(list) b=* c=_|=(^ [** +<+])]
  702. => .(c `$-([_?>(?=(^ a) i.a) _b] [_-:(c) _b])`c)
  703. =/ acc=(list _-:(c)) ~
  704. :: transformed list and updated state
  705. |- ^- (pair _acc _b)
  706. ?~ a
  707. [(flop acc) b]
  708. =^ res b (c i.a b)
  709. $(acc [res acc], a t.a)
  710. ::
  711. ++ spun :: internal spin
  712. ::
  713. :: a: list
  714. :: b: gate from list-item and state to product and new state
  715. ~/ %spun
  716. |* [a=(list) b=_|=(^ [** +<+])]
  717. :: transformed list
  718. p:(spin a +<+.b b)
  719. ::
  720. ++ swag :: slice
  721. |* [[a=@ b=@] c=(list)]
  722. (scag +<-> (slag +<-< c))
  723. :: +turn: transform each value of list :a using the function :b
  724. ::
  725. ++ turn
  726. ~/ %turn
  727. |* [a=(list) b=gate]
  728. => .(a (homo a))
  729. ^- (list _?>(?=(^ a) (b i.a)))
  730. |-
  731. ?~ a ~
  732. [i=(b i.a) t=$(a t.a)]
  733. ::
  734. ++ weld :: concatenate
  735. ~/ %weld
  736. |* [a=(list) b=(list)]
  737. => .(a ^.(homo a), b ^.(homo b))
  738. |- ^+ b
  739. ?~ a b
  740. [i.a $(a t.a)]
  741. ::
  742. ++ snap :: replace item
  743. ~/ %snap
  744. |* [a=(list) b=@ c=*]
  745. ^+ a
  746. (weld (scag b a) [c (slag +(b) a)])
  747. ::
  748. ++ into :: insert item
  749. ~/ %into
  750. |* [a=(list) b=@ c=*]
  751. ^+ a
  752. (weld (scag b a) [c (slag b a)])
  753. ::
  754. ++ welp :: faceless weld
  755. ~/ %welp
  756. |* [* *]
  757. ?~ +<-
  758. +<-(. +<+)
  759. +<-(+ $(+<- +<->))
  760. ::
  761. ++ zing :: promote
  762. ~/ %zing
  763. |* *
  764. ?~ +<
  765. +<
  766. (welp +<- $(+< +<+))
  767. ::
  768. :: 2c: bit arithmetic
  769. +| %bit-arithmetic
  770. ::
  771. ++ bex :: binary exponent
  772. ~/ %bex
  773. |= a=bloq
  774. ^- @
  775. ?: =(0 a) 1
  776. (mul 2 $(a (dec a)))
  777. ::
  778. ++ can :: assemble
  779. ~/ %can
  780. |= [a=bloq b=(list [p=step q=@])]
  781. ^- @
  782. ?~ b 0
  783. (add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b)))
  784. ::
  785. ++ cat :: concatenate
  786. ~/ %cat
  787. |= [a=bloq b=@ c=@]
  788. (add (lsh [a (met a b)] c) b)
  789. ::
  790. ++ cut :: slice
  791. ~/ %cut
  792. |= [a=bloq [b=step c=step] d=@]
  793. (end [a c] (rsh [a b] d))
  794. ::
  795. ++ end :: tail
  796. ~/ %end
  797. |= [a=bite b=@]
  798. =/ [=bloq =step] ?^(a a [a *step])
  799. (mod b (bex (mul (bex bloq) step)))
  800. ::
  801. ++ fil :: fill bloqstream
  802. ~/ %fil
  803. |= [a=bloq b=step c=@]
  804. =| n=@ud
  805. =. c (end a c)
  806. =/ d c
  807. |- ^- @
  808. ?: =(n b)
  809. (rsh a d)
  810. $(d (add c (lsh a d)), n +(n))
  811. ::
  812. ++ lsh :: left-shift
  813. ~/ %lsh
  814. |= [a=bite b=@]
  815. =/ [=bloq =step] ?^(a a [a *step])
  816. (mul b (bex (mul (bex bloq) step)))
  817. ::
  818. ++ met :: measure
  819. ~/ %met
  820. |= [a=bloq b=@]
  821. ^- @
  822. =+ c=0
  823. |-
  824. ?: =(0 b) c
  825. $(b (rsh a b), c +(c))
  826. ::
  827. ++ rap :: assemble variable
  828. ~/ %rap
  829. |= [a=bloq b=(list @)]
  830. ^- @
  831. ?~ b 0
  832. (cat a i.b $(b t.b))
  833. ::
  834. ++ rep :: assemble fixed
  835. ~/ %rep
  836. |= [a=bite b=(list @)]
  837. =/ [=bloq =step] ?^(a a [a *step])
  838. =| i=@ud
  839. |- ^- @
  840. ?~ b 0
  841. %+ add $(i +(i), b t.b)
  842. (lsh [bloq (mul step i)] (end [bloq step] i.b))
  843. ::
  844. ++ rev
  845. :: reverses block order, accounting for leading zeroes
  846. ::
  847. :: boz: block size
  848. :: len: size of dat, in boz
  849. :: dat: data to flip
  850. ~/ %rev
  851. |= [boz=bloq len=@ud dat=@]
  852. ^- @
  853. =. dat (end [boz len] dat)
  854. %+ lsh
  855. [boz (sub len (met boz dat))]
  856. (swp boz dat)
  857. ::
  858. ++ rip :: disassemble
  859. ~/ %rip
  860. |= [a=bite b=@]
  861. ^- (list @)
  862. ?: =(0 b) ~
  863. [(end a b) $(b (rsh a b))]
  864. ::
  865. ++ rsh :: right-shift
  866. ~/ %rsh
  867. |= [a=bite b=@]
  868. =/ [=bloq =step] ?^(a a [a *step])
  869. (div b (bex (mul (bex bloq) step)))
  870. ::
  871. ++ run :: +turn into atom
  872. ~/ %run
  873. |= [a=bite b=@ c=$-(@ @)]
  874. (rep a (turn (rip a b) c))
  875. ::
  876. ++ rut :: +turn into list
  877. ~/ %rut
  878. |* [a=bite b=@ c=$-(@ *)]
  879. (turn (rip a b) c)
  880. ::
  881. ++ sew :: stitch into
  882. ~/ %sew
  883. |= [a=bloq [b=step c=step d=@] e=@]
  884. ^- @
  885. %+ add
  886. (can a b^e c^d ~)
  887. =/ f [a (add b c)]
  888. (lsh f (rsh f e))
  889. ::
  890. ++ swp :: naive rev bloq order
  891. ~/ %swp
  892. |= [a=bloq b=@]
  893. (rep a (flop (rip a b)))
  894. ::
  895. ++ xeb :: binary logarithm
  896. ~/ %xeb
  897. |= a=@
  898. ^- @
  899. (met 0 a)
  900. ::
  901. ++ fe :: modulo bloq
  902. |_ a=bloq
  903. ++ dif :: difference
  904. |=([b=@ c=@] (sit (sub (add out (sit b)) (sit c))))
  905. ++ inv |=(b=@ (sub (dec out) (sit b))) :: inverse
  906. ++ net |= b=@ ^- @ :: flip byte endianness
  907. => .(b (sit b))
  908. ?: (lte a 3)
  909. b
  910. =+ c=(dec a)
  911. %+ con
  912. (lsh c $(a c, b (cut c [0 1] b)))
  913. $(a c, b (cut c [1 1] b))
  914. ++ out (bex (bex a)) :: mod value
  915. ++ rol |= [b=bloq c=@ d=@] ^- @ :: roll left
  916. =+ e=(sit d)
  917. =+ f=(bex (sub a b))
  918. =+ g=(mod c f)
  919. (sit (con (lsh [b g] e) (rsh [b (sub f g)] e)))
  920. ++ ror |= [b=bloq c=@ d=@] ^- @ :: roll right
  921. =+ e=(sit d)
  922. =+ f=(bex (sub a b))
  923. =+ g=(mod c f)
  924. (sit (con (rsh [b g] e) (lsh [b (sub f g)] e)))
  925. ++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add
  926. ++ sit |=(b=@ (end a b)) :: enforce modulo
  927. --
  928. ::
  929. :: 2d: bit logic
  930. +| %bit-logic
  931. ::
  932. ++ con :: binary or
  933. ~/ %con
  934. |= [a=@ b=@]
  935. =+ [c=0 d=0]
  936. |- ^- @
  937. ?: ?&(=(0 a) =(0 b)) d
  938. %= $
  939. a (rsh 0 a)
  940. b (rsh 0 b)
  941. c +(c)
  942. d %+ add d
  943. %+ lsh [0 c]
  944. ?& =(0 (end 0 a))
  945. =(0 (end 0 b))
  946. ==
  947. ==
  948. ::
  949. ++ dis :: binary and
  950. ~/ %dis
  951. |= [a=@ b=@]
  952. =| [c=@ d=@]
  953. |- ^- @
  954. ?: ?|(=(0 a) =(0 b)) d
  955. %= $
  956. a (rsh 0 a)
  957. b (rsh 0 b)
  958. c +(c)
  959. d %+ add d
  960. %+ lsh [0 c]
  961. ?| =(0 (end 0 a))
  962. =(0 (end 0 b))
  963. ==
  964. ==
  965. ::
  966. ++ mix :: binary xor
  967. ~/ %mix
  968. |= [a=@ b=@]
  969. ^- @
  970. =+ [c=0 d=0]
  971. |-
  972. ?: ?&(=(0 a) =(0 b)) d
  973. %= $
  974. a (rsh 0 a)
  975. b (rsh 0 b)
  976. c +(c)
  977. d (add d (lsh [0 c] =((end 0 a) (end 0 b))))
  978. ==
  979. ::
  980. ++ not |= [a=bloq b=@ c=@] :: binary not (sized)
  981. (mix c (dec (bex (mul b (bex a)))))
  982. ::
  983. :: 2e: insecure hashing
  984. +| %insecure-hashing
  985. ::
  986. ++ muk :: standard murmur3
  987. ~% %muk ..muk ~
  988. =+ ~(. fe 5)
  989. |= [syd=@ len=@ key=@]
  990. =. syd (end 5 syd)
  991. =/ pad (sub len (met 3 key))
  992. =/ data (weld (rip 3 key) (reap pad 0))
  993. =/ nblocks (div len 4) :: intentionally off-by-one
  994. =/ h1 syd
  995. =+ [c1=0xcc9e.2d51 c2=0x1b87.3593]
  996. =/ blocks (rip 5 key)
  997. =/ i nblocks
  998. =. h1 =/ hi h1 |-
  999. ?: =(0 i) hi
  1000. =/ k1 (snag (sub nblocks i) blocks) :: negative array index
  1001. =. k1 (sit (mul k1 c1))
  1002. =. k1 (rol 0 15 k1)
  1003. =. k1 (sit (mul k1 c2))
  1004. =. hi (mix hi k1)
  1005. =. hi (rol 0 13 hi)
  1006. =. hi (sum (sit (mul hi 5)) 0xe654.6b64)
  1007. $(i (dec i))
  1008. =/ tail (slag (mul 4 nblocks) data)
  1009. =/ k1 0
  1010. =/ tlen (dis len 3)
  1011. =. h1
  1012. ?+ tlen h1 :: fallthrough switch
  1013. %3 =. k1 (mix k1 (lsh [0 16] (snag 2 tail)))
  1014. =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
  1015. =. k1 (mix k1 (snag 0 tail))
  1016. =. k1 (sit (mul k1 c1))
  1017. =. k1 (rol 0 15 k1)
  1018. =. k1 (sit (mul k1 c2))
  1019. (mix h1 k1)
  1020. %2 =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
  1021. =. k1 (mix k1 (snag 0 tail))
  1022. =. k1 (sit (mul k1 c1))
  1023. =. k1 (rol 0 15 k1)
  1024. =. k1 (sit (mul k1 c2))
  1025. (mix h1 k1)
  1026. %1 =. k1 (mix k1 (snag 0 tail))
  1027. =. k1 (sit (mul k1 c1))
  1028. =. k1 (rol 0 15 k1)
  1029. =. k1 (sit (mul k1 c2))
  1030. (mix h1 k1)
  1031. ==
  1032. =. h1 (mix h1 len)
  1033. |^ (fmix32 h1)
  1034. ++ fmix32
  1035. |= h=@
  1036. =. h (mix h (rsh [0 16] h))
  1037. =. h (sit (mul h 0x85eb.ca6b))
  1038. =. h (mix h (rsh [0 13] h))
  1039. =. h (sit (mul h 0xc2b2.ae35))
  1040. =. h (mix h (rsh [0 16] h))
  1041. h
  1042. --
  1043. ::
  1044. ++ mug :: mug with murmur3
  1045. ~/ %mug
  1046. |= a=*
  1047. |^ ?@ a (mum 0xcafe.babe 0x7fff a)
  1048. =/ b (cat 5 $(a -.a) $(a +.a))
  1049. (mum 0xdead.beef 0xfffe b)
  1050. ::
  1051. ++ mum
  1052. |= [syd=@uxF fal=@F key=@]
  1053. =/ wyd (met 3 key)
  1054. =| i=@ud
  1055. |- ^- @F
  1056. ?: =(8 i) fal
  1057. =/ haz=@F (muk syd wyd key)
  1058. =/ ham=@F (mix (rsh [0 31] haz) (end [0 31] haz))
  1059. ?.(=(0 ham) ham $(i +(i), syd +(syd)))
  1060. --
  1061. :: ::
  1062. :: 2f: noun ordering
  1063. +| %noun-ordering
  1064. ::
  1065. :: +aor: alphabetical order
  1066. ::
  1067. :: Orders atoms before cells, and atoms in ascending LSB order.
  1068. ::
  1069. ++ aor
  1070. ~/ %aor
  1071. |= [a=* b=*]
  1072. ^- ?
  1073. ?: =(a b) &
  1074. ?. ?=(@ a)
  1075. ?: ?=(@ b) |
  1076. ?: =(-.a -.b)
  1077. $(a +.a, b +.b)
  1078. $(a -.a, b -.b)
  1079. ?. ?=(@ b) &
  1080. |-
  1081. =+ [c=(end 3 a) d=(end 3 b)]
  1082. ?: =(c d)
  1083. $(a (rsh 3 a), b (rsh 3 b))
  1084. (lth c d)
  1085. :: +dor: depth order
  1086. ::
  1087. :: Orders in ascending tree depth.
  1088. ::
  1089. ++ dor
  1090. ~/ %dor
  1091. |= [a=* b=*]
  1092. ^- ?
  1093. ?: =(a b) &
  1094. ?. ?=(@ a)
  1095. ?: ?=(@ b) |
  1096. ?: =(-.a -.b)
  1097. $(a +.a, b +.b)
  1098. $(a -.a, b -.b)
  1099. ?. ?=(@ b) &
  1100. (lth a b)
  1101. :: +gor: mug order
  1102. ::
  1103. :: Orders in ascending +mug hash order, collisions fall back to +dor.
  1104. ::
  1105. ++ gor
  1106. ~/ %gor
  1107. |= [a=* b=*]
  1108. ^- ?
  1109. =+ [c=(mug a) d=(mug b)]
  1110. ?: =(c d)
  1111. (dor a b)
  1112. (lth c d)
  1113. :: +mor: (more) mug order
  1114. ::
  1115. :: Orders in ascending double +mug hash order, collisions fall back to +dor.
  1116. ::
  1117. ++ mor
  1118. ~/ %mor
  1119. |= [a=* b=*]
  1120. ^- ?
  1121. =+ [c=(mug (mug a)) d=(mug (mug b))]
  1122. ?: =(c d)
  1123. (dor a b)
  1124. (lth c d)
  1125. ::
  1126. :: 2g: unsigned powers
  1127. +| %unsigned-powers
  1128. ::
  1129. ++ pow :: unsigned exponent
  1130. ~/ %pow
  1131. |= [a=@ b=@]
  1132. ?: =(b 0) 1
  1133. |- ?: =(b 1) a
  1134. =+ c=$(b (div b 2))
  1135. =+ d=(mul c c)
  1136. ?~ (dis b 1) d (mul d a)
  1137. ::
  1138. ++ sqt :: unsigned sqrt/rem
  1139. ~/ %sqt
  1140. |= a=@ ^- [p=@ q=@]
  1141. ?~ a [0 0]
  1142. =+ [q=(div (dec (xeb a)) 2) r=0]
  1143. =- [-.b (sub a +.b)]
  1144. ^= b |-
  1145. =+ s=(add r (bex q))
  1146. =+ t=(mul s s)
  1147. ?: =(q 0)
  1148. ?:((lte t a) [s t] [r (mul r r)])
  1149. ?: (lte t a)
  1150. $(r s, q (dec q))
  1151. $(q (dec q))
  1152. ::
  1153. :: 2h: set logic
  1154. +| %set-logic
  1155. ::
  1156. ++ in :: set engine
  1157. ~/ %in
  1158. =| a=(tree) :: (set)
  1159. |@
  1160. ++ all :: logical AND
  1161. ~/ %all
  1162. |* b=$-(* ?)
  1163. |- ^- ?
  1164. ?~ a
  1165. &
  1166. ?&((b n.a) $(a l.a) $(a r.a))
  1167. ::
  1168. ++ any :: logical OR
  1169. ~/ %any
  1170. |* b=$-(* ?)
  1171. |- ^- ?
  1172. ?~ a
  1173. |
  1174. ?|((b n.a) $(a l.a) $(a r.a))
  1175. ::
  1176. ++ apt :: check correctness
  1177. =< $
  1178. ~/ %apt
  1179. =| [l=(unit) r=(unit)]
  1180. |. ^- ?
  1181. ?~ a &
  1182. ?& ?~(l & &((gor n.a u.l) !=(n.a u.l)))
  1183. ?~(r & &((gor u.r n.a) !=(u.r n.a)))
  1184. ?~(l.a & ?&((mor n.a n.l.a) !=(n.a n.l.a) $(a l.a, l `n.a)))
  1185. ?~(r.a & ?&((mor n.a n.r.a) !=(n.a n.r.a) $(a r.a, r `n.a)))
  1186. ==
  1187. ::
  1188. ++ bif :: splits a by b
  1189. ~/ %bif
  1190. |* b=*
  1191. ^+ [l=a r=a]
  1192. =< +
  1193. |- ^+ a
  1194. ?~ a
  1195. [b ~ ~]
  1196. ?: =(b n.a)
  1197. a
  1198. ?: (gor b n.a)
  1199. =+ c=$(a l.a)
  1200. ?> ?=(^ c)
  1201. c(r a(l r.c))
  1202. =+ c=$(a r.a)
  1203. ?> ?=(^ c)
  1204. c(l a(r l.c))
  1205. ::
  1206. ++ del :: b without any a
  1207. ~/ %del
  1208. |* b=*
  1209. |- ^+ a
  1210. ?~ a
  1211. ~
  1212. ?. =(b n.a)
  1213. ?: (gor b n.a)
  1214. a(l $(a l.a))
  1215. a(r $(a r.a))
  1216. |- ^- [$?(~ _a)]
  1217. ?~ l.a r.a
  1218. ?~ r.a l.a
  1219. ?: (mor n.l.a n.r.a)
  1220. l.a(r $(l.a r.l.a))
  1221. r.a(l $(r.a l.r.a))
  1222. ::
  1223. ++ dif :: difference
  1224. ~/ %dif
  1225. |* b=_a
  1226. |- ^+ a
  1227. ?~ b
  1228. a
  1229. =+ c=(bif n.b)
  1230. ?> ?=(^ c)
  1231. =+ d=$(a l.c, b l.b)
  1232. =+ e=$(a r.c, b r.b)
  1233. |- ^- [$?(~ _a)]
  1234. ?~ d e
  1235. ?~ e d
  1236. ?: (mor n.d n.e)
  1237. d(r $(d r.d))
  1238. e(l $(e l.e))
  1239. ::
  1240. ++ dig :: axis of a in b
  1241. |= b=*
  1242. =+ c=1
  1243. |- ^- (unit @)
  1244. ?~ a ~
  1245. ?: =(b n.a) [~ u=(peg c 2)]
  1246. ?: (gor b n.a)
  1247. $(a l.a, c (peg c 6))
  1248. $(a r.a, c (peg c 7))
  1249. ::
  1250. ++ gas :: concatenate
  1251. ~/ %gas
  1252. |= b=(list _?>(?=(^ a) n.a))
  1253. |- ^+ a
  1254. ?~ b
  1255. a
  1256. $(b t.b, a (put i.b))
  1257. :: +has: does :b exist in :a?
  1258. ::
  1259. ++ has
  1260. ~/ %has
  1261. |* b=*
  1262. ^- ?
  1263. :: wrap extracted item type in a unit because bunting fails
  1264. ::
  1265. :: If we used the real item type of _?^(a n.a !!) as the sample type,
  1266. :: then hoon would bunt it to create the default sample for the gate.
  1267. ::
  1268. :: However, bunting that expression fails if :a is ~. If we wrap it
  1269. :: in a unit, the bunted unit doesn't include the bunted item type.
  1270. ::
  1271. :: This way we can ensure type safety of :b without needing to perform
  1272. :: this failing bunt. It's a hack.
  1273. ::
  1274. %. [~ b]
  1275. |= b=(unit _?>(?=(^ a) n.a))
  1276. => .(b ?>(?=(^ b) u.b))
  1277. |- ^- ?
  1278. ?~ a
  1279. |
  1280. ?: =(b n.a)
  1281. &
  1282. ?: (gor b n.a)
  1283. $(a l.a)
  1284. $(a r.a)
  1285. ::
  1286. ++ int :: intersection
  1287. ~/ %int
  1288. |* b=_a
  1289. |- ^+ a
  1290. ?~ b
  1291. ~
  1292. ?~ a
  1293. ~
  1294. ?. (mor n.a n.b)
  1295. $(a b, b a)
  1296. ?: =(n.b n.a)
  1297. a(l $(a l.a, b l.b), r $(a r.a, b r.b))
  1298. ?: (gor n.b n.a)
  1299. %- uni(a $(a l.a, r.b ~)) $(b r.b)
  1300. %- uni(a $(a r.a, l.b ~)) $(b l.b)
  1301. ::
  1302. ++ put :: puts b in a, sorted
  1303. ~/ %put
  1304. |* b=*
  1305. |- ^+ a
  1306. ?~ a
  1307. [b ~ ~]
  1308. ?: =(b n.a)
  1309. a
  1310. ?: (gor b n.a)
  1311. =+ c=$(a l.a)
  1312. ?> ?=(^ c)
  1313. ?: (mor n.a n.c)
  1314. a(l c)
  1315. c(r a(l r.c))
  1316. =+ c=$(a r.a)
  1317. ?> ?=(^ c)
  1318. ?: (mor n.a n.c)
  1319. a(r c)
  1320. c(l a(r l.c))
  1321. ::
  1322. ++ rep :: reduce to product
  1323. ~/ %rep
  1324. |* b=_=>(~ |=([* *] +<+))
  1325. |-
  1326. ?~ a +<+.b
  1327. $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
  1328. ::
  1329. ++ run :: apply gate to values
  1330. ~/ %run
  1331. |* b=gate
  1332. =+ c=`(set _?>(?=(^ a) (b n.a)))`~
  1333. |- ?~ a c
  1334. =. c (~(put in c) (b n.a))
  1335. =. c $(a l.a, c c)
  1336. $(a r.a, c c)
  1337. ::
  1338. ++ tap :: convert to list
  1339. =< $
  1340. ~/ %tap
  1341. =+ b=`(list _?>(?=(^ a) n.a))`~
  1342. |. ^+ b
  1343. ?~ a
  1344. b
  1345. $(a r.a, b [n.a $(a l.a)])
  1346. ::
  1347. ++ uni :: union
  1348. ~/ %uni
  1349. |* b=_a
  1350. ?: =(a b) a
  1351. |- ^+ a
  1352. ?~ b
  1353. a
  1354. ?~ a
  1355. b
  1356. ?: =(n.b n.a)
  1357. b(l $(a l.a, b l.b), r $(a r.a, b r.b))
  1358. ?: (mor n.a n.b)
  1359. ?: (gor n.b n.a)
  1360. $(l.a $(a l.a, r.b ~), b r.b)
  1361. $(r.a $(a r.a, l.b ~), b l.b)
  1362. ?: (gor n.a n.b)
  1363. $(l.b $(b l.b, r.a ~), a r.a)
  1364. $(r.b $(b r.b, l.a ~), a l.a)
  1365. ::
  1366. ++ wyt :: size of set
  1367. =< $
  1368. ~% %wyt + ~
  1369. |. ^- @
  1370. ?~(a 0 +((add $(a l.a) $(a r.a))))
  1371. --
  1372. ::
  1373. :: 2i: map logic
  1374. +| %map-logic
  1375. ::
  1376. ++ by :: map engine
  1377. ~/ %by
  1378. =| a=(tree (pair)) :: (map)
  1379. |@
  1380. ++ all :: logical AND
  1381. ~/ %all
  1382. |* b=$-(* ?)
  1383. |- ^- ?
  1384. ?~ a
  1385. &
  1386. ?&((b q.n.a) $(a l.a) $(a r.a))
  1387. ::
  1388. ++ any :: logical OR
  1389. ~/ %any
  1390. |* b=$-(* ?)
  1391. |- ^- ?
  1392. ?~ a
  1393. |
  1394. ?|((b q.n.a) $(a l.a) $(a r.a))
  1395. ::
  1396. ++ bif :: splits a by b
  1397. ~/ %bif
  1398. |* b=*
  1399. |- ^+ [l=a r=a]
  1400. ?~ a
  1401. [~ ~]
  1402. ?: =(b p.n.a)
  1403. +.a
  1404. ?: (gor b p.n.a)
  1405. =+ d=$(a l.a)
  1406. ?> ?=(^ d)
  1407. [l.d a(l r.d)]
  1408. =+ d=$(a r.a)
  1409. ?> ?=(^ d)
  1410. [a(r l.d) r.d]
  1411. ::
  1412. ++ del :: delete at key b
  1413. ~/ %del
  1414. |* b=*
  1415. |- ^+ a
  1416. ?~ a
  1417. ~
  1418. ?. =(b p.n.a)
  1419. ?: (gor b p.n.a)
  1420. a(l $(a l.a))
  1421. a(r $(a r.a))
  1422. |- ^- [$?(~ _a)]
  1423. ?~ l.a r.a
  1424. ?~ r.a l.a
  1425. ?: (mor p.n.l.a p.n.r.a)
  1426. l.a(r $(l.a r.l.a))
  1427. r.a(l $(r.a l.r.a))
  1428. ::
  1429. ++ dif :: difference
  1430. ~/ %dif
  1431. |* b=_a
  1432. |- ^+ a
  1433. ?~ b
  1434. a
  1435. =+ c=(bif p.n.b)
  1436. ?> ?=(^ c)
  1437. =+ d=$(a l.c, b l.b)
  1438. =+ e=$(a r.c, b r.b)
  1439. |- ^- [$?(~ _a)]
  1440. ?~ d e
  1441. ?~ e d
  1442. ?: (mor p.n.d p.n.e)
  1443. d(r $(d r.d))
  1444. e(l $(e l.e))
  1445. ::
  1446. ++ dig :: axis of b key
  1447. |= b=*
  1448. =+ c=1
  1449. |- ^- (unit @)
  1450. ?~ a ~
  1451. ?: =(b p.n.a) [~ u=(peg c 2)]
  1452. ?: (gor b p.n.a)
  1453. $(a l.a, c (peg c 6))
  1454. $(a r.a, c (peg c 7))
  1455. ::
  1456. ++ apt :: check correctness
  1457. =< $
  1458. ~/ %apt
  1459. =| [l=(unit) r=(unit)]
  1460. |. ^- ?
  1461. ?~ a &
  1462. ?& ?~(l & &((gor p.n.a u.l) !=(p.n.a u.l)))
  1463. ?~(r & &((gor u.r p.n.a) !=(u.r p.n.a)))
  1464. ?~ l.a &
  1465. &((mor p.n.a p.n.l.a) !=(p.n.a p.n.l.a) $(a l.a, l `p.n.a))
  1466. ?~ r.a &
  1467. &((mor p.n.a p.n.r.a) !=(p.n.a p.n.r.a) $(a r.a, r `p.n.a))
  1468. ==
  1469. ::
  1470. ++ gas :: concatenate
  1471. ~/ %gas
  1472. |* b=(list [p=* q=*])
  1473. => .(b `(list _?>(?=(^ a) n.a))`b)
  1474. |- ^+ a
  1475. ?~ b
  1476. a
  1477. $(b t.b, a (put p.i.b q.i.b))
  1478. ::
  1479. ++ get :: grab value by key
  1480. ~/ %get
  1481. |* b=*
  1482. => .(b `_?>(?=(^ a) p.n.a)`b)
  1483. |- ^- (unit _?>(?=(^ a) q.n.a))
  1484. ?~ a
  1485. ~
  1486. ?: =(b p.n.a)
  1487. (some q.n.a)
  1488. ?: (gor b p.n.a)
  1489. $(a l.a)
  1490. $(a r.a)
  1491. ::
  1492. ++ got :: need value by key
  1493. |* b=*
  1494. (need (get b))
  1495. ::
  1496. ++ gut :: fall value by key
  1497. |* [b=* c=*]
  1498. (fall (get b) c)
  1499. ::
  1500. ++ has :: key existence check
  1501. ~/ %has
  1502. |* b=*
  1503. !=(~ (get b))
  1504. ::
  1505. ++ int :: intersection
  1506. ~/ %int
  1507. |* b=_a
  1508. |- ^+ a
  1509. ?~ b
  1510. ~
  1511. ?~ a
  1512. ~
  1513. ?: (mor p.n.a p.n.b)
  1514. ?: =(p.n.b p.n.a)
  1515. b(l $(a l.a, b l.b), r $(a r.a, b r.b))
  1516. ?: (gor p.n.b p.n.a)
  1517. %- uni(a $(a l.a, r.b ~)) $(b r.b)
  1518. %- uni(a $(a r.a, l.b ~)) $(b l.b)
  1519. ?: =(p.n.a p.n.b)
  1520. b(l $(b l.b, a l.a), r $(b r.b, a r.a))
  1521. ?: (gor p.n.a p.n.b)
  1522. %- uni(a $(b l.b, r.a ~)) $(a r.a)
  1523. %- uni(a $(b r.b, l.a ~)) $(a l.a)
  1524. ::
  1525. ++ jab
  1526. ~/ %jab
  1527. |* [key=_?>(?=(^ a) p.n.a) fun=$-(_?>(?=(^ a) q.n.a) _?>(?=(^ a) q.n.a))]
  1528. ^+ a
  1529. ::
  1530. ?~ a !!
  1531. ::
  1532. ?: =(key p.n.a)
  1533. a(q.n (fun q.n.a))
  1534. ::
  1535. ?: (gor key p.n.a)
  1536. a(l $(a l.a))
  1537. ::
  1538. a(r $(a r.a))
  1539. ::
  1540. ++ mar :: add with validation
  1541. |* [b=* c=(unit *)]
  1542. ?~ c
  1543. (del b)
  1544. (put b u.c)
  1545. ::
  1546. ++ put :: adds key-value pair
  1547. ~/ %put
  1548. |* [b=* c=*]
  1549. |- ^+ a
  1550. ?~ a
  1551. [[b c] ~ ~]
  1552. ?: =(b p.n.a)
  1553. ?: =(c q.n.a)
  1554. a
  1555. a(n [b c])
  1556. ?: (gor b p.n.a)
  1557. =+ d=$(a l.a)
  1558. ?> ?=(^ d)
  1559. ?: (mor p.n.a p.n.d)
  1560. a(l d)
  1561. d(r a(l r.d))
  1562. =+ d=$(a r.a)
  1563. ?> ?=(^ d)
  1564. ?: (mor p.n.a p.n.d)
  1565. a(r d)
  1566. d(l a(r l.d))
  1567. ::
  1568. ++ rep :: reduce to product
  1569. ~/ %rep
  1570. |* b=_=>(~ |=([* *] +<+))
  1571. |-
  1572. ?~ a +<+.b
  1573. $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
  1574. ::
  1575. ++ rib :: transform + product
  1576. |* [b=* c=gate]
  1577. |- ^+ [b a]
  1578. ?~ a [b ~]
  1579. =+ d=(c n.a b)
  1580. =. n.a +.d
  1581. =+ e=$(a l.a, b -.d)
  1582. =+ f=$(a r.a, b -.e)
  1583. [-.f a(l +.e, r +.f)]
  1584. ::
  1585. ++ run :: apply gate to values
  1586. ~/ %run
  1587. |* b=gate
  1588. |-
  1589. ?~ a a
  1590. [n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)]
  1591. ::
  1592. ++ tap :: listify pairs
  1593. =< $
  1594. ~/ %tap
  1595. =+ b=`(list _?>(?=(^ a) n.a))`~
  1596. |. ^+ b
  1597. ?~ a
  1598. b
  1599. $(a r.a, b [n.a $(a l.a)])
  1600. ::
  1601. ++ uni :: union, merge
  1602. ~/ %uni
  1603. |* b=_a
  1604. |- ^+ a
  1605. ?~ b
  1606. a
  1607. ?~ a
  1608. b
  1609. ?: =(p.n.b p.n.a)
  1610. b(l $(a l.a, b l.b), r $(a r.a, b r.b))
  1611. ?: (mor p.n.a p.n.b)
  1612. ?: (gor p.n.b p.n.a)
  1613. $(l.a $(a l.a, r.b ~), b r.b)
  1614. $(r.a $(a r.a, l.b ~), b l.b)
  1615. ?: (gor p.n.a p.n.b)
  1616. $(l.b $(b l.b, r.a ~), a r.a)
  1617. $(r.b $(b r.b, l.a ~), a l.a)
  1618. ::
  1619. ++ uno :: general union
  1620. |* b=_a
  1621. |* meg=$-([* * *] *)
  1622. |- ^+ a
  1623. ?~ b
  1624. a
  1625. ?~ a
  1626. b
  1627. ?: =(p.n.b p.n.a)
  1628. :+ [p.n.a `_?>(?=(^ a) q.n.a)`(meg p.n.a q.n.a q.n.b)]
  1629. $(b l.b, a l.a)
  1630. $(b r.b, a r.a)
  1631. ?: (mor p.n.a p.n.b)
  1632. ?: (gor p.n.b p.n.a)
  1633. $(l.a $(a l.a, r.b ~), b r.b)
  1634. $(r.a $(a r.a, l.b ~), b l.b)
  1635. ?: (gor p.n.a p.n.b)
  1636. $(l.b $(b l.b, r.a ~), a r.a)
  1637. $(r.b $(b r.b, l.a ~), a l.a)
  1638. ::
  1639. ++ urn :: apply gate to nodes
  1640. ~/ %urn
  1641. |* b=$-([* *] *)
  1642. |-
  1643. ?~ a ~
  1644. a(n n.a(q (b p.n.a q.n.a)), l $(a l.a), r $(a r.a))
  1645. ::
  1646. ++ wyt :: depth of map
  1647. =< $
  1648. ~% %wyt + ~
  1649. |. ^- @
  1650. ?~(a 0 +((add $(a l.a) $(a r.a))))
  1651. ::
  1652. ++ key :: set of keys
  1653. =< $
  1654. ~/ %key
  1655. =+ b=`(set _?>(?=(^ a) p.n.a))`~
  1656. |. ^+ b
  1657. ?~ a b
  1658. $(a r.a, b $(a l.a, b (~(put in b) p.n.a)))
  1659. ::
  1660. ++ val :: list of vals
  1661. =+ b=`(list _?>(?=(^ a) q.n.a))`~
  1662. |- ^+ b
  1663. ?~ a b
  1664. $(a r.a, b [q.n.a $(a l.a)])
  1665. --
  1666. ::
  1667. :: 2j: jar and jug logic
  1668. +| %jar-and-jug-logic
  1669. ++ ja :: jar engine
  1670. =| a=(tree (pair * (list))) :: (jar)
  1671. |@
  1672. ++ get :: gets list by key
  1673. |* b=*
  1674. =+ c=(~(get by a) b)
  1675. ?~(c ~ u.c)
  1676. ::
  1677. ++ add :: adds key-list pair
  1678. |* [b=* c=*]
  1679. =+ d=(get b)
  1680. (~(put by a) b [c d])
  1681. ::
  1682. ++ zip :: listify jar
  1683. =< $
  1684. ~/ %zip
  1685. =+ b=`(list _?>(?=([[* ^] *] a) [p=p q=i.q]:n.a))`~
  1686. |. ^+ b
  1687. ?~ a b
  1688. %= $
  1689. a r.a
  1690. b |- ^+ b
  1691. ?~ q.n.a ^$(a l.a)
  1692. [[p i.q]:n.a $(q.n.a t.q.n.a)]
  1693. ==
  1694. --
  1695. ++ ju :: jug engine
  1696. =| a=(tree (pair * (tree))) :: (jug)
  1697. |@
  1698. ++ del :: del key-set pair
  1699. |* [b=* c=*]
  1700. ^+ a
  1701. =+ d=(get b)
  1702. =+ e=(~(del in d) c)
  1703. ?~ e
  1704. (~(del by a) b)
  1705. (~(put by a) b e)
  1706. ::
  1707. ++ gas :: concatenate
  1708. |* b=(list [p=* q=*])
  1709. => .(b `(list _?>(?=([[* ^] ^] a) [p=p q=n.q]:n.a))`b)
  1710. |- ^+ a
  1711. ?~ b
  1712. a
  1713. $(b t.b, a (put p.i.b q.i.b))
  1714. ::
  1715. ++ get :: gets set by key
  1716. |* b=*
  1717. =+ c=(~(get by a) b)
  1718. ?~(c ~ u.c)
  1719. ::
  1720. ++ has :: existence check
  1721. |* [b=* c=*]
  1722. ^- ?
  1723. (~(has in (get b)) c)
  1724. ::
  1725. ++ put :: add key-set pair
  1726. |* [b=* c=*]
  1727. ^+ a
  1728. =+ d=(get b)
  1729. (~(put by a) b (~(put in d) c))
  1730. --
  1731. ::
  1732. :: 2k: queue logic
  1733. +| %queue-logic
  1734. ::
  1735. ++ to :: queue engine
  1736. =| a=(tree) :: (qeu)
  1737. |@
  1738. ++ apt :: check correctness
  1739. |- ^- ?
  1740. ?~ a &
  1741. ?& ?~(l.a & ?&((mor n.a n.l.a) $(a l.a)))
  1742. ?~(r.a & ?&((mor n.a n.r.a) $(a r.a)))
  1743. ==
  1744. ::
  1745. ++ bal
  1746. |- ^+ a
  1747. ?~ a ~
  1748. ?. |(?=(~ l.a) (mor n.a n.l.a))
  1749. $(a l.a(r $(a a(l r.l.a))))
  1750. ?. |(?=(~ r.a) (mor n.a n.r.a))
  1751. $(a r.a(l $(a a(r l.r.a))))
  1752. a
  1753. ::
  1754. ++ dep :: max depth of queue
  1755. |- ^- @
  1756. ?~ a 0
  1757. +((max $(a l.a) $(a r.a)))
  1758. ::
  1759. ++ gas :: insert list to que
  1760. |= b=(list _?>(?=(^ a) n.a))
  1761. |- ^+ a
  1762. ?~(b a $(b t.b, a (put i.b)))
  1763. ::
  1764. ++ get :: head-rest pair
  1765. |- ^+ ?>(?=(^ a) [p=n.a q=*(tree _n.a)])
  1766. ?~ a
  1767. !!
  1768. ?~ r.a
  1769. [n.a l.a]
  1770. =+ b=$(a r.a)
  1771. :- p.b
  1772. ?: |(?=(~ q.b) (mor n.a n.q.b))
  1773. a(r q.b)
  1774. a(n n.q.b, l a(r l.q.b), r r.q.b)
  1775. ::
  1776. ++ nip :: removes root
  1777. |- ^+ a
  1778. ?~ a ~
  1779. ?~ l.a r.a
  1780. ?~ r.a l.a
  1781. ?: (mor n.l.a n.r.a)
  1782. l.a(r $(l.a r.l.a))
  1783. r.a(l $(r.a l.r.a))
  1784. ::
  1785. ++ nap :: removes root
  1786. ?> ?=(^ a)
  1787. ?: =(~ l.a) r.a
  1788. =+ b=get(a l.a)
  1789. bal(n.a p.b, l.a q.b)
  1790. ::
  1791. ++ put :: insert new tail
  1792. |* b=*
  1793. |- ^+ a
  1794. ?~ a
  1795. [b ~ ~]
  1796. bal(l.a $(a l.a))
  1797. ::
  1798. ++ run :: apply gate to values
  1799. |* b=gate
  1800. |-
  1801. ?~ a a
  1802. [n=(b n.a) l=$(a l.a) r=$(a r.a)]
  1803. ::
  1804. ++ tap :: adds list to end
  1805. =+ b=`(list _?>(?=(^ a) n.a))`~
  1806. |- ^+ b
  1807. =+ 0 :: hack for jet match
  1808. ?~ a
  1809. b
  1810. $(a r.a, b [n.a $(a l.a)])
  1811. ::
  1812. ++ top :: produces head
  1813. |- ^- (unit _?>(?=(^ a) n.a))
  1814. ?~ a ~
  1815. ?~(r.a [~ n.a] $(a r.a))
  1816. --
  1817. ::
  1818. :: 2l: container from container
  1819. +| %container-from-container
  1820. ::
  1821. ++ malt :: map from list
  1822. |* a=(list)
  1823. (molt `(list [p=_-<.a q=_->.a])`a)
  1824. ::
  1825. ++ molt :: map from pair list
  1826. |* a=(list (pair)) :: ^- =,(i.-.a (map _p _q))
  1827. (~(gas by `(tree [p=_p.i.-.a q=_q.i.-.a])`~) a)
  1828. ::
  1829. ++ silt :: set from list
  1830. |* a=(list) :: ^- (set _i.-.a)
  1831. =+ b=*(tree _?>(?=(^ a) i.a))
  1832. (~(gas in b) a)
  1833. ::
  1834. :: 2m: container from noun
  1835. +| %container-from-noun
  1836. ::
  1837. ++ ly :: list from raw noun
  1838. le:nl
  1839. ::
  1840. ++ my :: map from raw noun
  1841. my:nl
  1842. ::
  1843. ++ sy :: set from raw noun
  1844. si:nl
  1845. ::
  1846. ++ nl
  1847. |%
  1848. :: ::
  1849. ++ le :: construct list
  1850. |* a=(list)
  1851. ^+ =< $
  1852. |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
  1853. --
  1854. a
  1855. :: ::
  1856. ++ my :: construct map
  1857. |* a=(list (pair))
  1858. => .(a ^+((le a) a))
  1859. (~(gas by `(map _p.i.-.a _q.i.-.a)`~) a)
  1860. :: ::
  1861. ++ si :: construct set
  1862. |* a=(list)
  1863. => .(a ^+((le a) a))
  1864. (~(gas in `(set _i.-.a)`~) a)
  1865. :: ::
  1866. ++ snag :: index
  1867. |* [a=@ b=(list)]
  1868. ?~ b
  1869. ~_ leaf+"snag-fail"
  1870. !!
  1871. ?: =(0 a) i.b
  1872. $(b t.b, a (dec a))
  1873. :: ::
  1874. ++ weld :: concatenate
  1875. |* [a=(list) b=(list)]
  1876. => .(a ^+((le a) a), b ^+((le b) b))
  1877. =+ 42
  1878. |-
  1879. ?~ a b
  1880. [i=i.a t=$(a t.a)]
  1881. --
  1882. :: 2n: functional hacks
  1883. +| %functional-hacks
  1884. ::
  1885. ++ aftr |*(a=$-(* *) |*(b=$-(* *) (pair b a))) :: pair after
  1886. ++ cork |*([a=$-(* *) b=$-(* *)] (corl b a)) :: compose forward
  1887. ++ corl :: compose backwards
  1888. |* [a=$-(* *) b=$-(* *)]
  1889. =< +:|.((a (b))) :: type check
  1890. |* c=_,.+<.b
  1891. (a (b c))
  1892. ::
  1893. ++ cury :: curry left
  1894. |* [a=$-(^ *) b=*]
  1895. |* c=_,.+<+.a
  1896. (a b c)
  1897. ::
  1898. ++ curr :: curry right
  1899. |* [a=$-(^ *) c=*]
  1900. |* b=_,.+<-.a
  1901. (a b c)
  1902. ::
  1903. ++ fore |*(a=$-(* *) |*(b=$-(* *) (pair a b))) :: pair before
  1904. ::
  1905. ++ head |*(^ ,:+<-) :: get head
  1906. ++ same |*(* +<) :: identity
  1907. ::
  1908. ++ succ |=(@ +(+<)) :: successor
  1909. ::
  1910. ++ tail |*(^ ,:+<+) :: get tail
  1911. ++ test |=(^ =(+<- +<+)) :: equality
  1912. ::
  1913. ++ lead |*(* |*(* [+>+< +<])) :: put head
  1914. ++ late |*(* |*(* [+< +>+<])) :: put tail
  1915. ::
  1916. :: 2o: containers
  1917. +| %containers
  1918. ++ jar |$ [key value] (map key (list value)) :: map of lists
  1919. ++ jug |$ [key value] (map key (set value)) :: map of sets
  1920. ::
  1921. ++ map
  1922. |$ [key value] :: table
  1923. $| (tree (pair key value))
  1924. |=(a=(tree (pair)) ?:(=(~ a) & ~(apt by a)))
  1925. ::
  1926. ++ qeu
  1927. |$ [item] :: queue
  1928. $| (tree item)
  1929. |=(a=(tree) ?:(=(~ a) & ~(apt to a)))
  1930. ::
  1931. ++ set
  1932. |$ [item] :: set
  1933. $| (tree item)
  1934. |=(a=(tree) ?:(=(~ a) & ~(apt in a)))
  1935. ::
  1936. :: 2p: serialization
  1937. +| %serialization
  1938. ::
  1939. ++ cue :: unpack
  1940. ~/ %cue
  1941. |= a=@
  1942. ^- *
  1943. =+ b=0
  1944. =+ m=`(map @ *)`~
  1945. =< q
  1946. |- ^- [p=@ q=* r=(map @ *)]
  1947. ?: =(0 (cut 0 [b 1] a))
  1948. =+ c=(rub +(b) a)
  1949. [+(p.c) q.c (~(put by m) b q.c)]
  1950. =+ c=(add 2 b)
  1951. ?: =(0 (cut 0 [+(b) 1] a))
  1952. =+ u=$(b c)
  1953. =+ v=$(b (add p.u c), m r.u)
  1954. =+ w=[q.u q.v]
  1955. [(add 2 (add p.u p.v)) w (~(put by r.v) b w)]
  1956. =+ d=(rub c a)
  1957. [(add 2 p.d) (need (~(get by m) q.d)) m]
  1958. ::
  1959. ++ jam :: pack
  1960. ~/ %jam
  1961. |= a=*
  1962. ^- @
  1963. =+ b=0
  1964. =+ m=`(map * @)`~
  1965. =< q
  1966. |- ^- [p=@ q=@ r=(map * @)]
  1967. =+ c=(~(get by m) a)
  1968. ?~ c
  1969. => .(m (~(put by m) a b))
  1970. ?: ?=(@ a)
  1971. =+ d=(mat a)
  1972. [(add 1 p.d) (lsh 0 q.d) m]
  1973. => .(b (add 2 b))
  1974. =+ d=$(a -.a)
  1975. =+ e=$(a +.a, b (add b p.d), m r.d)
  1976. [(add 2 (add p.d p.e)) (mix 1 (lsh [0 2] (cat 0 q.d q.e))) r.e]
  1977. ?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c)))
  1978. =+ d=(mat a)
  1979. [(add 1 p.d) (lsh 0 q.d) m]
  1980. =+ d=(mat u.c)
  1981. [(add 2 p.d) (mix 3 (lsh [0 2] q.d)) m]
  1982. ::
  1983. ++ mat :: length-encode
  1984. ~/ %mat
  1985. |= a=@
  1986. ^- [p=@ q=@]
  1987. ?: =(0 a)
  1988. [1 1]
  1989. =+ b=(met 0 a)
  1990. =+ c=(met 0 b)
  1991. :- (add (add c c) b)
  1992. (cat 0 (bex c) (mix (end [0 (dec c)] b) (lsh [0 (dec c)] a)))
  1993. ::
  1994. ++ rub :: length-decode
  1995. ~/ %rub
  1996. |= [a=@ b=@]
  1997. ^- [p=@ q=@]
  1998. =+ ^= c
  1999. =+ [c=0 m=(met 0 b)]
  2000. |- ?< (gth c m)
  2001. ?. =(0 (cut 0 [(add a c) 1] b))
  2002. c
  2003. $(c +(c))
  2004. ?: =(0 c)
  2005. [1 0]
  2006. =+ d=(add a +(c))
  2007. =+ e=(add (bex (dec c)) (cut 0 [d (dec c)] b))
  2008. [(add (add c c) e) (cut 0 [(add d (dec c)) e] b)]
  2009. ::
  2010. ++ fn :: float, infinity, or NaN
  2011. ::
  2012. :: s=sign, e=exponent, a=arithmetic form
  2013. :: (-1)^s * a * 2^e
  2014. $% [%f s=? e=@s a=@u]
  2015. [%i s=?]
  2016. [%n ~]
  2017. ==
  2018. ::
  2019. ++ dn :: decimal float, infinity, or NaN
  2020. ::
  2021. :: (-1)^s * a * 10^e
  2022. $% [%d s=? e=@s a=@u]
  2023. [%i s=?]
  2024. [%n ~]
  2025. ==
  2026. ::
  2027. ++ rn :: parsed decimal float
  2028. ::
  2029. $% [%d a=? b=[c=@ [d=@ e=@] f=? i=@]]
  2030. [%i a=?]
  2031. [%n ~]
  2032. ==
  2033. ::
  2034. :: 2q: molds and mold builders
  2035. +| %molds-and-mold-builders
  2036. ::
  2037. +$ axis @ :: tree address
  2038. +$ bean ? :: 0=&=yes, 1=|=no
  2039. +$ flag ?
  2040. +$ char @t :: UTF8 byte
  2041. +$ cord @t :: UTF8, LSB first
  2042. +$ byts [wid=@ud dat=@] :: bytes, MSB first
  2043. +$ date [[a=? y=@ud] m=@ud t=tarp] :: parsed date
  2044. +$ knot @ta :: ASCII text
  2045. +$ noun * :: any noun
  2046. +$ path (list knot) :: like unix path
  2047. +$ pith (list iota) :: typed urbit path
  2048. +$ stud :: standard name
  2049. $@ mark=@tas :: auth=urbit
  2050. $: auth=@tas :: standards authority
  2051. type=path :: standard label
  2052. == ::
  2053. +$ tang (list tank) :: bottom-first error
  2054. :: ::
  2055. +$ iota :: typed path segment
  2056. $+ iota
  2057. $~ [%n ~]
  2058. $@ @tas
  2059. $% [%ub @ub] [%uc @uc] [%ud @ud] [%ui @ui]
  2060. [%ux @ux] [%uv @uv] [%uw @uw]
  2061. [%sb @sb] [%sc @sc] [%sd @sd] [%si @si]
  2062. [%sx @sx] [%sv @sv] [%sw @sw]
  2063. [%da @da] [%dr @dr]
  2064. [%f ?] [%n ~]
  2065. [%if @if] [%is @is]
  2066. [%t @t] [%ta @ta] :: @tas
  2067. [%p @p] [%q @q]
  2068. [%rs @rs] [%rd @rd] [%rh @rh] [%rq @rq]
  2069. ==
  2070. ::
  2071. :: $tank: formatted print tree
  2072. ::
  2073. :: just a cord, or
  2074. :: %leaf: just a tape
  2075. :: %palm: backstep list
  2076. :: flat-mid, open, flat-open, flat-close
  2077. :: %rose: flat list
  2078. :: flat-mid, open, close
  2079. ::
  2080. +$ tank
  2081. $+ tank
  2082. $~ leaf/~
  2083. $@ cord
  2084. $% [%leaf p=tape]
  2085. [%palm p=(qual tape tape tape tape) q=(list tank)]
  2086. [%rose p=(trel tape tape tape) q=(list tank)]
  2087. ==
  2088. ::
  2089. +$ tape (list @tD) :: utf8 string as list
  2090. +$ tour (list @c) :: utf32 clusters
  2091. +$ tarp [d=@ud h=@ud m=@ud s=@ud f=(list @ux)] :: parsed time
  2092. +$ term @tas :: ascii symbol
  2093. +$ wain (list cord) :: text lines
  2094. +$ wall (list tape) :: text lines
  2095. ::
  2096. -- =>
  2097. :: ::
  2098. ~% %tri +
  2099. ==
  2100. %year year
  2101. %yore yore
  2102. %ob ob
  2103. ==
  2104. :: layer-3
  2105. ::
  2106. |%
  2107. :: 3a: signed and modular ints
  2108. +| %signed-and-modular-ints
  2109. ::
  2110. ++ egcd :: schneier's egcd
  2111. |= [a=@ b=@]
  2112. =+ si
  2113. =+ [c=(sun a) d=(sun b)]
  2114. =+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]]
  2115. |- ^- [d=@ u=@s v=@s]
  2116. ?: =(--0 c)
  2117. [(abs d) d.u d.v]
  2118. :: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v)))
  2119. :: =(d (sum (pro (sun a) d.u) (pro (sun b) d.v)))
  2120. :: ==
  2121. =+ q=(fra d c)
  2122. %= $
  2123. c (dif d (pro q c))
  2124. d c
  2125. u [(dif d.u (pro q c.u)) c.u]
  2126. v [(dif d.v (pro q c.v)) c.v]
  2127. ==
  2128. ::
  2129. ++ fo :: modulo prime
  2130. ^|
  2131. |_ a=@
  2132. ++ dif
  2133. |= [b=@ c=@]
  2134. (sit (sub (add a b) (sit c)))
  2135. ::
  2136. ++ exp
  2137. |= [b=@ c=@]
  2138. ?: =(0 b)
  2139. 1
  2140. =+ d=$(b (rsh 0 b))
  2141. =+ e=(pro d d)
  2142. ?:(=(0 (end 0 b)) e (pro c e))
  2143. ::
  2144. ++ fra
  2145. |= [b=@ c=@]
  2146. (pro b (inv c))
  2147. ::
  2148. ++ inv
  2149. |= b=@
  2150. =+ c=(dul:si u:(egcd b a) a)
  2151. c
  2152. ::
  2153. ++ pro
  2154. |= [b=@ c=@]
  2155. (sit (mul b c))
  2156. ::
  2157. ++ sit
  2158. |= b=@
  2159. (mod b a)
  2160. ::
  2161. ++ sum
  2162. |= [b=@ c=@]
  2163. (sit (add b c))
  2164. --
  2165. ::
  2166. ++ si :: signed integer
  2167. ^?
  2168. |%
  2169. ++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value
  2170. ++ dif |= [a=@s b=@s] :: subtraction
  2171. (sum a (new !(syn b) (abs b)))
  2172. ++ dul |= [a=@s b=@] :: modulus
  2173. =+(c=(old a) ?:(-.c (mod +.c b) (sub b +.c)))
  2174. ++ fra |= [a=@s b=@s] :: divide
  2175. (new =(0 (mix (syn a) (syn b))) (div (abs a) (abs b)))
  2176. ++ new |= [a=? b=@] :: [sign value] to @s
  2177. `@s`?:(a (mul 2 b) ?:(=(0 b) 0 +((mul 2 (dec b)))))
  2178. ++ old |=(a=@s [(syn a) (abs a)]) :: [sign value]
  2179. ++ pro |= [a=@s b=@s] :: multiplication
  2180. (new =(0 (mix (syn a) (syn b))) (mul (abs a) (abs b)))
  2181. ++ rem |=([a=@s b=@s] (dif a (pro b (fra a b)))) :: remainder
  2182. ++ sum |= [a=@s b=@s] :: addition
  2183. =+ [c=(old a) d=(old b)]
  2184. ?: -.c
  2185. ?: -.d
  2186. (new & (add +.c +.d))
  2187. ?: (gte +.c +.d)
  2188. (new & (sub +.c +.d))
  2189. (new | (sub +.d +.c))
  2190. ?: -.d
  2191. ?: (gte +.c +.d)
  2192. (new | (sub +.c +.d))
  2193. (new & (sub +.d +.c))
  2194. (new | (add +.c +.d))
  2195. ++ sun |=(a=@u (mul 2 a)) :: @u to @s
  2196. ++ syn |=(a=@s =(0 (end 0 a))) :: sign test
  2197. ++ cmp |= [a=@s b=@s] :: compare
  2198. ^- @s
  2199. ?: =(a b)
  2200. --0
  2201. ?: (syn a)
  2202. ?: (syn b)
  2203. ?: (gth a b)
  2204. --1
  2205. -1
  2206. --1
  2207. ?: (syn b)
  2208. -1
  2209. ?: (gth a b)
  2210. -1
  2211. --1
  2212. --
  2213. ::
  2214. :: 3b: floating point
  2215. +| %floating-point
  2216. ::
  2217. ++ fl :: arb. precision fp
  2218. =/ [[p=@u v=@s w=@u] r=$?(%n %u %d %z %a) d=$?(%d %f %i)]
  2219. [[113 -16.494 32.765] %n %d]
  2220. :: p=precision: number of bits in arithmetic form; must be at least 2
  2221. :: v=min exponent: minimum value of e
  2222. :: w=width: max - min value of e, 0 is fixed point
  2223. :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero
  2224. :: d=behavior: return denormals, flush denormals to zero,
  2225. :: infinite exponent range
  2226. =>
  2227. ~% %cofl +> ~
  2228. :: cofl
  2229. ::
  2230. :: internal functions; mostly operating on [e=@s a=@u], in other words
  2231. :: positive numbers. many of these error out if a=0.
  2232. |%
  2233. ++ rou
  2234. |= [a=[e=@s a=@u]] ^- fn (rau a &)
  2235. ::
  2236. ++ rau
  2237. |= [a=[e=@s a=@u] t=?] ^- fn
  2238. ?- r
  2239. %z (lug %fl a t) %d (lug %fl a t)
  2240. %a (lug %ce a t) %u (lug %ce a t)
  2241. %n (lug %ne a t)
  2242. ==
  2243. ::
  2244. ++ add :: add; exact if e
  2245. |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
  2246. =+ q=(dif:si e.a e.b)
  2247. |- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp
  2248. ?: e
  2249. [%f & e.b (^add (lsh [0 (abs:si q)] a.a) a.b)]
  2250. =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
  2251. =+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a
  2252. ?: (gth prc ma) (^sub prc ma) 0
  2253. =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b
  2254. ?: =((cmp:si w x) --1) :: don't need to add
  2255. ?- r
  2256. %z (lug %fl a &) %d (lug %fl a &)
  2257. %a (lug %lg a &) %u (lug %lg a &)
  2258. %n (lug %na a &)
  2259. ==
  2260. (rou [e.b (^add (lsh [0 (abs:si q)] a.a) a.b)])
  2261. ::
  2262. ++ sub :: subtract; exact if e
  2263. |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
  2264. =+ q=(dif:si e.a e.b)
  2265. |- ?. (syn:si q)
  2266. (fli $(b a, a b, q +(q), r swr))
  2267. =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
  2268. =+ ^= w %+ dif:si e.a %- sun:si
  2269. ?: (gth prc ma) (^sub prc ma) 0
  2270. =+ ^= x %+ sum:si e.b (sun:si +(mb))
  2271. ?: &(!e =((cmp:si w x) --1))
  2272. ?- r
  2273. %z (lug %sm a &) %d (lug %sm a &)
  2274. %a (lug %ce a &) %u (lug %ce a &)
  2275. %n (lug %nt a &)
  2276. ==
  2277. =+ j=(lsh [0 (abs:si q)] a.a)
  2278. |- ?. (gte j a.b)
  2279. (fli $(a.b j, j a.b, r swr))
  2280. =+ i=(^sub j a.b)
  2281. ?~ i [%f & zer]
  2282. ?: e [%f & e.b i] (rou [e.b i])
  2283. ::
  2284. ++ mul :: multiply
  2285. |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
  2286. (rou (sum:si e.a e.b) (^mul a.a a.b))
  2287. ::
  2288. ++ div :: divide
  2289. |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
  2290. =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
  2291. =+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc))))
  2292. =. a ?: (syn:si v) a
  2293. a(e (sum:si v e.a), a (lsh [0 (abs:si v)] a.a))
  2294. =+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)]
  2295. (rau [j p.q] =(q.q 0))
  2296. ::
  2297. ++ sqt :: square root
  2298. |= [a=[e=@s a=@u]] ^- fn
  2299. =. a
  2300. =+ [w=(met 0 a.a) x=(^mul +(prc) 2)]
  2301. =+ ?:((^lth w x) (^sub x w) 0)
  2302. =+ ?: =((dis - 1) (dis (abs:si e.a) 1)) -
  2303. (^add - 1)
  2304. a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
  2305. =+ [y=(^sqt a.a) z=(fra:si e.a --2)]
  2306. (rau [z p.y] =(q.y 0))
  2307. ::
  2308. ++ lth :: less-than
  2309. |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
  2310. ?: =(e.a e.b) (^lth a.a a.b)
  2311. =+ c=(cmp:si (ibl a) (ibl b))
  2312. ?: =(c -1) & ?: =(c --1) |
  2313. ?: =((cmp:si e.a e.b) -1)
  2314. (^lth (rsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
  2315. (^lth (lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
  2316. ::
  2317. ++ equ :: equals
  2318. |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
  2319. ?. =((ibl a) (ibl b)) |
  2320. ?: =((cmp:si e.a e.b) -1)
  2321. =((lsh [0 (abs:si (dif:si e.a e.b))] a.b) a.a)
  2322. =((lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
  2323. ::
  2324. :: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1)
  2325. ++ ibl
  2326. |= [a=[e=@s a=@u]] ^- @s
  2327. (sum:si (sun:si (dec (met 0 a.a))) e.a)
  2328. ::
  2329. :: +uni
  2330. ::
  2331. :: change to a representation where a.a is odd
  2332. :: every fn has a unique representation of this kind
  2333. ++ uni
  2334. |= [a=[e=@s a=@u]]
  2335. |- ?: =((end 0 a.a) 1) a
  2336. $(a.a (rsh 0 a.a), e.a (sum:si e.a --1))
  2337. ::
  2338. :: +xpd: expands to either full precision or to denormalized
  2339. ++ xpd
  2340. |= [a=[e=@s a=@u]]
  2341. =+ ma=(met 0 a.a)
  2342. ?: (gte ma prc) a
  2343. =+ ?: =(den %i) (^sub prc ma)
  2344. =+ ^= q
  2345. =+ w=(dif:si e.a emn)
  2346. ?: (syn:si w) (abs:si w) 0
  2347. (min q (^sub prc ma))
  2348. a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
  2349. ::
  2350. :: +lug: central rounding mechanism
  2351. ::
  2352. :: can perform: floor, ceiling, smaller, larger,
  2353. :: nearest (round ties to: even, away from 0, toward 0)
  2354. :: s is sticky bit: represents a value less than ulp(a) = 2^(e.a)
  2355. ::
  2356. ++ lug
  2357. ~/ %lug
  2358. |= [t=$?(%fl %ce %sm %lg %ne %na %nt) a=[e=@s a=@u] s=?] ^- fn
  2359. ?< =(a.a 0)
  2360. =-
  2361. ?. =(den %f) - :: flush denormals
  2362. ?. ?=([%f *] -) -
  2363. ?: =((met 0 ->+>) prc) - [%f & zer]
  2364. ::
  2365. =+ m=(met 0 a.a)
  2366. ?> |(s (gth m prc)) :: require precision
  2367. =+ ^= q %+ max
  2368. ?: (gth m prc) (^sub m prc) 0 :: reduce precision
  2369. %- abs:si ?: =(den %i) --0 :: enforce min. exp
  2370. ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0
  2371. =^ b a :- (end [0 q] a.a)
  2372. a(e (sum:si e.a (sun:si q)), a (rsh [0 q] a.a))
  2373. ::
  2374. ?~ a.a
  2375. ?< =(den %i)
  2376. ?- t
  2377. %fl [%f & zer]
  2378. %sm [%f & zer]
  2379. %ce [%f & spd]
  2380. %lg [%f & spd]
  2381. %ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
  2382. [%f & ?:((^lth b (bex (dec q))) zer spd)]
  2383. %nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
  2384. [%f & ?:((^lth b (bex (dec q))) zer spd)]
  2385. %na [%f & ?:((^lth b (bex (dec q))) zer spd)]
  2386. ==
  2387. ::
  2388. =. a (xpd a)
  2389. ::
  2390. =. a
  2391. ?- t
  2392. %fl a
  2393. %lg a(a +(a.a))
  2394. %sm ?. &(=(b 0) s) a
  2395. ?: &(=(e.a emn) !=(den %i)) a(a (dec a.a))
  2396. =+ y=(dec (^mul a.a 2))
  2397. ?. (lte (met 0 y) prc) a(a (dec a.a))
  2398. [(dif:si e.a --1) y]
  2399. %ce ?: &(=(b 0) s) a a(a +(a.a))
  2400. %ne ?~ b a
  2401. =+ y=(bex (dec q))
  2402. ?: &(=(b y) s) :: round halfs to even
  2403. ?~ (dis a.a 1) a a(a +(a.a))
  2404. ?: (^lth b y) a a(a +(a.a))
  2405. %na ?~ b a
  2406. =+ y=(bex (dec q))
  2407. ?: (^lth b y) a a(a +(a.a))
  2408. %nt ?~ b a
  2409. =+ y=(bex (dec q))
  2410. ?: =(b y) ?: s a a(a +(a.a))
  2411. ?: (^lth b y) a a(a +(a.a))
  2412. ==
  2413. ::
  2414. =. a ?. =((met 0 a.a) +(prc)) a
  2415. a(a (rsh 0 a.a), e (sum:si e.a --1))
  2416. ?~ a.a [%f & zer]
  2417. ::
  2418. ?: =(den %i) [%f & a]
  2419. ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp
  2420. ::
  2421. ++ drg :: dragon4; get
  2422. ~/ %drg :: printable decimal;
  2423. |= [a=[e=@s a=@u]] ^- [@s @u] :: guaranteed accurate
  2424. ?< =(a.a 0) :: for rounded floats
  2425. =. a (xpd a)
  2426. =+ r=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] a.a)
  2427. =+ s=(lsh [0 ?.((syn:si e.a) (abs:si e.a) 0)] 1)
  2428. =+ mn=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] 1)
  2429. =+ mp=mn
  2430. => ?.
  2431. ?& =(a.a (bex (dec prc))) :: if next smallest
  2432. |(!=(e.a emn) =(den %i)) :: float is half ULP,
  2433. == :: tighten lower bound
  2434. .
  2435. %= .
  2436. mp (lsh 0 mp)
  2437. r (lsh 0 r)
  2438. s (lsh 0 s)
  2439. ==
  2440. =+ [k=--0 q=(^div (^add s 9) 10)]
  2441. |- ?: (^lth r q)
  2442. %= $
  2443. k (dif:si k --1)
  2444. r (^mul r 10)
  2445. mn (^mul mn 10)
  2446. mp (^mul mp 10)
  2447. ==
  2448. |- ?: (gte (^add (^mul r 2) mp) (^mul s 2))
  2449. $(s (^mul s 10), k (sum:si k --1))
  2450. =+ [u=0 o=0]
  2451. |- :: r/s+o = a*10^-k
  2452. =+ v=(dvr (^mul r 10) s)
  2453. => %= .
  2454. k (dif:si k --1)
  2455. u p.v
  2456. r q.v
  2457. mn (^mul mn 10)
  2458. mp (^mul mp 10)
  2459. ==
  2460. =+ l=(^lth (^mul r 2) mn) :: in lower bound
  2461. =+ ^= h :: in upper bound
  2462. ?| (^lth (^mul s 2) mp)
  2463. (gth (^mul r 2) (^sub (^mul s 2) mp))
  2464. ==
  2465. ?: &(!l !h)
  2466. $(o (^add (^mul o 10) u))
  2467. =+ q=&(h |(!l (gth (^mul r 2) s)))
  2468. =. o (^add (^mul o 10) ?:(q +(u) u))
  2469. [k o]
  2470. ::
  2471. ++ toj :: round to integer
  2472. |= [a=[e=@s a=@u]] ^- fn
  2473. ?. =((cmp:si e.a --0) -1) [%f & a]
  2474. =+ x=(abs:si e.a)
  2475. =+ y=(rsh [0 x] a.a)
  2476. ?: |(=(r %d) =(r %z)) [%f & --0 y]
  2477. =+ z=(end [0 x] a.a)
  2478. ?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))]
  2479. =+ i=(bex (dec x))
  2480. ?: &(=(z i) =((dis y 1) 0)) [%f & --0 y]
  2481. ?: (^lth z i) [%f & --0 y] [%f & --0 +(y)]
  2482. ::
  2483. ++ ned :: require ?=([%f *] a)
  2484. |= [a=fn] ^- [%f s=? e=@s a=@u]
  2485. ?: ?=([%f *] a) a
  2486. ~_ leaf+"need-float"
  2487. !!
  2488. ::
  2489. ++ shf :: a * 2^b; no rounding
  2490. |= [a=fn b=@s]
  2491. ?: |(?=([%n *] a) ?=([%i *] a)) a
  2492. a(e (sum:si e.a b))
  2493. ::
  2494. ++ fli :: flip sign
  2495. |= [a=fn] ^- fn
  2496. ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a)
  2497. ::
  2498. ++ swr ?+(r r %d %u, %u %d) :: flipped rounding
  2499. ++ prc ?>((gth p 1) p) :: force >= 2 precision
  2500. ++ den d :: denorm+flush+inf exp
  2501. ++ emn v :: minimum exponent
  2502. ++ emx (sum:si emn (sun:si w)) :: maximum exponent
  2503. ++ spd [e=emn a=1] :: smallest denormal
  2504. ++ spn [e=emn a=(bex (dec prc))] :: smallest normal
  2505. ++ lfn [e=emx a=(fil 0 prc 1)] :: largest
  2506. ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all
  2507. ++ zer [e=--0 a=0]
  2508. --
  2509. |%
  2510. ++ rou :: round
  2511. |= [a=fn] ^- fn
  2512. ?. ?=([%f *] a) a
  2513. ?~ a.a [%f s.a zer]
  2514. ?: s.a (^rou +>.a)
  2515. =.(r swr (fli (^rou +>.a)))
  2516. ::
  2517. ++ syn :: get sign
  2518. |= [a=fn] ^- ?
  2519. ?-(-.a %f s.a, %i s.a, %n &)
  2520. ::
  2521. ++ abs :: absolute value
  2522. |= [a=fn] ^- fn
  2523. ?: ?=([%f *] a) [%f & e.a a.a]
  2524. ?: ?=([%i *] a) [%i &] [%n ~]
  2525. ::
  2526. ++ add :: add
  2527. |= [a=fn b=fn] ^- fn
  2528. ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
  2529. ?: |(?=([%i *] a) ?=([%i *] b))
  2530. ?: &(?=([%i *] a) ?=([%i *] b))
  2531. ?: =(a b) a [%n ~]
  2532. ?: ?=([%i *] a) a b
  2533. ?: |(=(a.a 0) =(a.b 0))
  2534. ?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a)
  2535. [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
  2536. %- |= [a=fn]
  2537. ?. ?=([%f *] a) a
  2538. ?. =(a.a 0) a
  2539. [%f !=(r %d) zer]
  2540. ?: =(s.a s.b)
  2541. ?: s.a (^add +>.a +>.b |)
  2542. =.(r swr (fli (^add +>.a +>.b |)))
  2543. ?: s.a (^sub +>.a +>.b |)
  2544. (^sub +>.b +>.a |)
  2545. ::
  2546. ++ ead :: exact add
  2547. |= [a=fn b=fn] ^- fn
  2548. ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
  2549. ?: |(?=([%i *] a) ?=([%i *] b))
  2550. ?: &(?=([%i *] a) ?=([%i *] b))
  2551. ?: =(a b) a [%n ~]
  2552. ?: ?=([%i *] a) a b
  2553. ?: |(=(a.a 0) =(a.b 0))
  2554. ?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a)
  2555. [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
  2556. %- |= [a=fn]
  2557. ?. ?=([%f *] a) a
  2558. ?. =(a.a 0) a
  2559. [%f !=(r %d) zer]
  2560. ?: =(s.a s.b)
  2561. ?: s.a (^add +>.a +>.b &)
  2562. (fli (^add +>.a +>.b &))
  2563. ?: s.a (^sub +>.a +>.b &)
  2564. (^sub +>.b +>.a &)
  2565. ::
  2566. ++ sub :: subtract
  2567. |= [a=fn b=fn] ^- fn (add a (fli b))
  2568. ::
  2569. ++ mul :: multiply
  2570. |= [a=fn b=fn] ^- fn
  2571. ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
  2572. ?: ?=([%i *] a)
  2573. ?: ?=([%i *] b)
  2574. [%i =(s.a s.b)]
  2575. ?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
  2576. ?: ?=([%i *] b)
  2577. ?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
  2578. ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
  2579. ?: =(s.a s.b) (^mul +>.a +>.b)
  2580. =.(r swr (fli (^mul +>.a +>.b)))
  2581. ::
  2582. ++ emu :: exact multiply
  2583. |= [a=fn b=fn] ^- fn
  2584. ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
  2585. ?: ?=([%i *] a)
  2586. ?: ?=([%i *] b)
  2587. [%i =(s.a s.b)]
  2588. ?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
  2589. ?: ?=([%i *] b)
  2590. ?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
  2591. ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
  2592. [%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)]
  2593. ::
  2594. ++ div :: divide
  2595. |= [a=fn b=fn] ^- fn
  2596. ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
  2597. ?: ?=([%i *] a)
  2598. ?: ?=([%i *] b) [%n ~] [%i =(s.a s.b)]
  2599. ?: ?=([%i *] b) [%f =(s.a s.b) zer]
  2600. ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer]
  2601. ?: =(a.b 0) [%i =(s.a s.b)]
  2602. ?: =(s.a s.b) (^div +>.a +>.b)
  2603. =.(r swr (fli (^div +>.a +>.b)))
  2604. ::
  2605. ++ fma :: fused multiply-add
  2606. |= [a=fn b=fn c=fn] ^- fn :: (a * b) + c
  2607. (add (emu a b) c)
  2608. ::
  2609. ++ sqt :: square root
  2610. |= [a=fn] ^- fn
  2611. ?: ?=([%n *] a) [%n ~]
  2612. ?: ?=([%i *] a) ?:(s.a a [%n ~])
  2613. ?~ a.a [%f s.a zer]
  2614. ?: s.a (^sqt +>.a) [%n ~]
  2615. ::
  2616. ++ inv :: inverse
  2617. |= [a=fn] ^- fn
  2618. (div [%f & --0 1] a)
  2619. ::
  2620. ++ sun :: uns integer to float
  2621. |= [a=@u] ^- fn
  2622. (rou [%f & --0 a])
  2623. ::
  2624. ++ san :: sgn integer to float
  2625. |= [a=@s] ^- fn
  2626. =+ b=(old:si a)
  2627. (rou [%f -.b --0 +.b])
  2628. ::
  2629. ++ lth :: less-than
  2630. :: comparisons return ~ in the event of a NaN
  2631. |= [a=fn b=fn] ^- (unit ?)
  2632. ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~
  2633. ?: =(a b) |
  2634. ?: ?=([%i *] a) !s.a ?: ?=([%i *] b) s.b
  2635. ?: |(=(a.a 0) =(a.b 0))
  2636. ?: &(=(a.a 0) =(a.b 0)) |
  2637. ?: =(a.a 0) s.b !s.a
  2638. ?: !=(s.a s.b) s.b
  2639. ?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a)
  2640. ::
  2641. ++ lte :: less-equal
  2642. |= [a=fn b=fn] ^- (unit ?)
  2643. %+ bind (lth b a) |= a=? !a
  2644. ::
  2645. ++ equ :: equal
  2646. |= [a=fn b=fn] ^- (unit ?)
  2647. ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~
  2648. ?: =(a b) &
  2649. ?: |(?=([%i *] a) ?=([%i *] b)) |
  2650. ?: |(=(a.a 0) =(a.b 0))
  2651. ?: &(=(a.a 0) =(a.b 0)) & |
  2652. ?: |(=(e.a e.b) !=(s.a s.b)) |
  2653. (^equ +>.a +>.b)
  2654. ::
  2655. ++ gte :: greater-equal
  2656. |= [a=fn b=fn] ^- (unit ?) (lte b a)
  2657. ::
  2658. ++ gth :: greater-than
  2659. |= [a=fn b=fn] ^- (unit ?) (lth b a)
  2660. ::
  2661. ++ drg :: float to decimal
  2662. |= [a=fn] ^- dn
  2663. ?: ?=([%n *] a) [%n ~]
  2664. ?: ?=([%i *] a) [%i s.a]
  2665. ?~ a.a [%d s.a --0 0]
  2666. [%d s.a (^drg +>.a)]
  2667. ::
  2668. ++ grd :: decimal to float
  2669. |= [a=dn] ^- fn
  2670. ?: ?=([%n *] a) [%n ~]
  2671. ?: ?=([%i *] a) [%i s.a]
  2672. => .(r %n)
  2673. =+ q=(abs:si e.a)
  2674. ?: (syn:si e.a)
  2675. (mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)])
  2676. (div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)])
  2677. ::
  2678. ++ toi :: round to integer @s
  2679. |= [a=fn] ^- (unit @s)
  2680. =+ b=(toj a)
  2681. ?. ?=([%f *] b) ~ :- ~
  2682. =+ c=(^^mul (bex (abs:si e.b)) a.b)
  2683. (new:si s.b c)
  2684. ::
  2685. ++ toj :: round to integer fn
  2686. |= [a=fn] ^- fn
  2687. ?. ?=([%f *] a) a
  2688. ?~ a.a [%f s.a zer]
  2689. ?: s.a (^toj +>.a)
  2690. =.(r swr (fli (^toj +>.a)))
  2691. --
  2692. :: +ff
  2693. ::
  2694. :: this core has no use outside of the functionality
  2695. :: provided to ++rd, ++rs, ++rq, and ++rh
  2696. ::
  2697. :: w=width: bits in exponent field
  2698. :: p=precision: bits in fraction field
  2699. :: b=bias: added to exponent when storing
  2700. :: r=rounding mode: same as in ++fl
  2701. ++ ff :: ieee 754 format fp
  2702. |_ [[w=@u p=@u b=@s] r=$?(%n %u %d %z %a)]
  2703. ::
  2704. ++ sb (bex (^add w p)) :: sign bit
  2705. ++ me (dif:si (dif:si --1 b) (sun:si p)) :: minimum exponent
  2706. ::
  2707. ++ pa
  2708. %*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r)
  2709. ::
  2710. ++ sea :: @r to fn
  2711. |= [a=@r] ^- fn
  2712. =+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)]
  2713. =+ s=(sig a)
  2714. ?: =(e 0)
  2715. ?: =(f 0) [%f s --0 0] [%f s me f]
  2716. ?: =(e (fil 0 w 1))
  2717. ?: =(f 0) [%i s] [%n ~]
  2718. =+ q=:(sum:si (sun:si e) me -1)
  2719. =+ r=(^add f (bex p))
  2720. [%f s q r]
  2721. ::
  2722. ++ bit |= [a=fn] (bif (rou:pa a)) :: fn to @r w+ rounding
  2723. ::
  2724. ++ bif :: fn to @r no rounding
  2725. |= [a=fn] ^- @r
  2726. ?: ?=([%i *] a)
  2727. =+ q=(lsh [0 p] (fil 0 w 1))
  2728. ?: s.a q (^add q sb)
  2729. ?: ?=([%n *] a) (lsh [0 (dec p)] (fil 0 +(w) 1))
  2730. ?~ a.a ?: s.a `@r`0 sb
  2731. =+ ma=(met 0 a.a)
  2732. ?. =(ma +(p))
  2733. ?> =(e.a me)
  2734. ?> (^lth ma +(p))
  2735. ?: s.a `@r`a.a (^add a.a sb)
  2736. =+ q=(sum:si (dif:si e.a me) --1)
  2737. =+ r=(^add (lsh [0 p] (abs:si q)) (end [0 p] a.a))
  2738. ?: s.a r (^add r sb)
  2739. ::
  2740. ++ sig :: get sign
  2741. |= [a=@r] ^- ?
  2742. =(0 (cut 0 [(^add p w) 1] a))
  2743. ::
  2744. ++ exp :: get exponent
  2745. |= [a=@r] ^- @s
  2746. (dif:si (sun:si (cut 0 [p w] a)) b)
  2747. ::
  2748. ++ add :: add
  2749. |= [a=@r b=@r]
  2750. (bif (add:pa (sea a) (sea b)))
  2751. ::
  2752. ++ sub :: subtract
  2753. |= [a=@r b=@r]
  2754. (bif (sub:pa (sea a) (sea b)))
  2755. ::
  2756. ++ mul :: multiply
  2757. |= [a=@r b=@r]
  2758. (bif (mul:pa (sea a) (sea b)))
  2759. ::
  2760. ++ div :: divide
  2761. |= [a=@r b=@r]
  2762. (bif (div:pa (sea a) (sea b)))
  2763. ::
  2764. ++ fma :: fused multiply-add
  2765. |= [a=@r b=@r c=@r]
  2766. (bif (fma:pa (sea a) (sea b) (sea c)))
  2767. ::
  2768. ++ sqt :: square root
  2769. |= [a=@r]
  2770. (bif (sqt:pa (sea a)))
  2771. ::
  2772. ++ lth :: less-than
  2773. |= [a=@r b=@r] (fall (lth:pa (sea a) (sea b)) |)
  2774. ++ lte :: less-equals
  2775. |= [a=@r b=@r] (fall (lte:pa (sea a) (sea b)) |)
  2776. ++ equ :: equals
  2777. |= [a=@r b=@r] (fall (equ:pa (sea a) (sea b)) |)
  2778. ++ gte :: greater-equals
  2779. |= [a=@r b=@r] (fall (gte:pa (sea a) (sea b)) |)
  2780. ++ gth :: greater-than
  2781. |= [a=@r b=@r] (fall (gth:pa (sea a) (sea b)) |)
  2782. ++ sun :: uns integer to @r
  2783. |= [a=@u] (bit [%f & --0 a])
  2784. ++ san :: signed integer to @r
  2785. |= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)])
  2786. ++ toi :: round to integer
  2787. |= [a=@r] (toi:pa (sea a))
  2788. ++ drg :: @r to decimal float
  2789. |= [a=@r] (drg:pa (sea a))
  2790. ++ grd :: decimal float to @r
  2791. |= [a=dn] (bif (grd:pa a))
  2792. --
  2793. ::
  2794. ++ rlyd |= a=@rd ^- dn (drg:rd a) :: prep @rd for print
  2795. ++ rlys |= a=@rs ^- dn (drg:rs a) :: prep @rs for print
  2796. ++ rlyh |= a=@rh ^- dn (drg:rh a) :: prep @rh for print
  2797. ++ rlyq |= a=@rq ^- dn (drg:rq a) :: prep @rq for print
  2798. ++ ryld |= a=dn ^- @rd (grd:rd a) :: finish parsing @rd
  2799. ++ ryls |= a=dn ^- @rs (grd:rs a) :: finish parsing @rs
  2800. ++ rylh |= a=dn ^- @rh (grd:rh a) :: finish parsing @rh
  2801. ++ rylq |= a=dn ^- @rq (grd:rq a) :: finish parsing @rq
  2802. ::
  2803. ++ rd :: double precision fp
  2804. ^|
  2805. ~% %rd +> ~
  2806. |_ r=$?(%n %u %d %z)
  2807. :: round to nearest, round up, round down, round to zero
  2808. ::
  2809. ++ ma
  2810. %*(. ff w 11, p 52, b --1.023, r r)
  2811. ::
  2812. ++ sea :: @rd to fn
  2813. |= [a=@rd] (sea:ma a)
  2814. ::
  2815. ++ bit :: fn to @rd
  2816. |= [a=fn] ^- @rd (bit:ma a)
  2817. ::
  2818. ++ add ~/ %add :: add
  2819. |= [a=@rd b=@rd] ^- @rd
  2820. ~_ leaf+"rd-fail"
  2821. (add:ma a b)
  2822. ::
  2823. ++ sub ~/ %sub :: subtract
  2824. |= [a=@rd b=@rd] ^- @rd
  2825. ~_ leaf+"rd-fail"
  2826. (sub:ma a b)
  2827. ::
  2828. ++ mul ~/ %mul :: multiply
  2829. |= [a=@rd b=@rd] ^- @rd
  2830. ~_ leaf+"rd-fail"
  2831. (mul:ma a b)
  2832. ::
  2833. ++ div ~/ %div :: divide
  2834. |= [a=@rd b=@rd] ^- @rd
  2835. ~_ leaf+"rd-fail"
  2836. (div:ma a b)
  2837. ::
  2838. ++ fma ~/ %fma :: fused multiply-add
  2839. |= [a=@rd b=@rd c=@rd] ^- @rd
  2840. ~_ leaf+"rd-fail"
  2841. (fma:ma a b c)
  2842. ::
  2843. ++ sqt ~/ %sqt :: square root
  2844. |= [a=@rd] ^- @rd ~_ leaf+"rd-fail"
  2845. (sqt:ma a)
  2846. ::
  2847. ++ lth ~/ %lth :: less-than
  2848. |= [a=@rd b=@rd]
  2849. ~_ leaf+"rd-fail"
  2850. (lth:ma a b)
  2851. ::
  2852. ++ lte ~/ %lte :: less-equals
  2853. |= [a=@rd b=@rd]
  2854. ~_ leaf+"rd-fail"
  2855. (lte:ma a b)
  2856. ::
  2857. ++ equ ~/ %equ :: equals
  2858. |= [a=@rd b=@rd]
  2859. ~_ leaf+"rd-fail"
  2860. (equ:ma a b)
  2861. ::
  2862. ++ gte ~/ %gte :: greater-equals
  2863. |= [a=@rd b=@rd]
  2864. ~_ leaf+"rd-fail"
  2865. (gte:ma a b)
  2866. ::
  2867. ++ gth ~/ %gth :: greater-than
  2868. |= [a=@rd b=@rd]
  2869. ~_ leaf+"rd-fail"
  2870. (gth:ma a b)
  2871. ::
  2872. ++ sun |= [a=@u] ^- @rd (sun:ma a) :: uns integer to @rd
  2873. ++ san |= [a=@s] ^- @rd (san:ma a) :: sgn integer to @rd
  2874. ++ sig |= [a=@rd] ^- ? (sig:ma a) :: get sign
  2875. ++ exp |= [a=@rd] ^- @s (exp:ma a) :: get exponent
  2876. ++ toi |= [a=@rd] ^- (unit @s) (toi:ma a) :: round to integer
  2877. ++ drg |= [a=@rd] ^- dn (drg:ma a) :: @rd to decimal float
  2878. ++ grd |= [a=dn] ^- @rd (grd:ma a) :: decimal float to @rd
  2879. --
  2880. ::
  2881. ++ rs :: single precision fp
  2882. ~% %rs +> ~
  2883. ^|
  2884. :: round to nearest, round up, round down, round to zero
  2885. |_ r=$?(%n %u %d %z)
  2886. ::
  2887. ++ ma
  2888. %*(. ff w 8, p 23, b --127, r r)
  2889. ::
  2890. ++ sea :: @rs to fn
  2891. |= [a=@rs] (sea:ma a)
  2892. ::
  2893. ++ bit :: fn to @rs
  2894. |= [a=fn] ^- @rs (bit:ma a)
  2895. ::
  2896. ++ add ~/ %add :: add
  2897. |= [a=@rs b=@rs] ^- @rs
  2898. ~_ leaf+"rs-fail"
  2899. (add:ma a b)
  2900. ::
  2901. ++ sub ~/ %sub :: subtract
  2902. |= [a=@rs b=@rs] ^- @rs
  2903. ~_ leaf+"rs-fail"
  2904. (sub:ma a b)
  2905. ::
  2906. ++ mul ~/ %mul :: multiply
  2907. |= [a=@rs b=@rs] ^- @rs
  2908. ~_ leaf+"rs-fail"
  2909. (mul:ma a b)
  2910. ::
  2911. ++ div ~/ %div :: divide
  2912. |= [a=@rs b=@rs] ^- @rs
  2913. ~_ leaf+"rs-fail"
  2914. (div:ma a b)
  2915. ::
  2916. ++ fma ~/ %fma :: fused multiply-add
  2917. |= [a=@rs b=@rs c=@rs] ^- @rs
  2918. ~_ leaf+"rs-fail"
  2919. (fma:ma a b c)
  2920. ::
  2921. ++ sqt ~/ %sqt :: square root
  2922. |= [a=@rs] ^- @rs
  2923. ~_ leaf+"rs-fail"
  2924. (sqt:ma a)
  2925. ::
  2926. ++ lth ~/ %lth :: less-than
  2927. |= [a=@rs b=@rs]
  2928. ~_ leaf+"rs-fail"
  2929. (lth:ma a b)
  2930. ::
  2931. ++ lte ~/ %lte :: less-equals
  2932. |= [a=@rs b=@rs]
  2933. ~_ leaf+"rs-fail"
  2934. (lte:ma a b)
  2935. ::
  2936. ++ equ ~/ %equ :: equals
  2937. |= [a=@rs b=@rs]
  2938. ~_ leaf+"rs-fail"
  2939. (equ:ma a b)
  2940. ::
  2941. ++ gte ~/ %gte :: greater-equals
  2942. |= [a=@rs b=@rs]
  2943. ~_ leaf+"rs-fail"
  2944. (gte:ma a b)
  2945. ::
  2946. ++ gth ~/ %gth :: greater-than
  2947. |= [a=@rs b=@rs]
  2948. ~_ leaf+"rs-fail"
  2949. (gth:ma a b)
  2950. ::
  2951. ++ sun |= [a=@u] ^- @rs (sun:ma a) :: uns integer to @rs
  2952. ++ san |= [a=@s] ^- @rs (san:ma a) :: sgn integer to @rs
  2953. ++ sig |= [a=@rs] ^- ? (sig:ma a) :: get sign
  2954. ++ exp |= [a=@rs] ^- @s (exp:ma a) :: get exponent
  2955. ++ toi |= [a=@rs] ^- (unit @s) (toi:ma a) :: round to integer
  2956. ++ drg |= [a=@rs] ^- dn (drg:ma a) :: @rs to decimal float
  2957. ++ grd |= [a=dn] ^- @rs (grd:ma a) :: decimal float to @rs
  2958. --
  2959. ::
  2960. ++ rq :: quad precision fp
  2961. ~% %rq +> ~
  2962. ^|
  2963. :: round to nearest, round up, round down, round to zero
  2964. |_ r=$?(%n %u %d %z)
  2965. ::
  2966. ++ ma
  2967. %*(. ff w 15, p 112, b --16.383, r r)
  2968. ::
  2969. ++ sea :: @rq to fn
  2970. |= [a=@rq] (sea:ma a)
  2971. ::
  2972. ++ bit :: fn to @rq
  2973. |= [a=fn] ^- @rq (bit:ma a)
  2974. ::
  2975. ++ add ~/ %add :: add
  2976. |= [a=@rq b=@rq] ^- @rq
  2977. ~_ leaf+"rq-fail"
  2978. (add:ma a b)
  2979. ::
  2980. ++ sub ~/ %sub :: subtract
  2981. |= [a=@rq b=@rq] ^- @rq
  2982. ~_ leaf+"rq-fail"
  2983. (sub:ma a b)
  2984. ::
  2985. ++ mul ~/ %mul :: multiply
  2986. |= [a=@rq b=@rq] ^- @rq
  2987. ~_ leaf+"rq-fail"
  2988. (mul:ma a b)
  2989. ::
  2990. ++ div ~/ %div :: divide
  2991. |= [a=@rq b=@rq] ^- @rq
  2992. ~_ leaf+"rq-fail"
  2993. (div:ma a b)
  2994. ::
  2995. ++ fma ~/ %fma :: fused multiply-add
  2996. |= [a=@rq b=@rq c=@rq] ^- @rq
  2997. ~_ leaf+"rq-fail"
  2998. (fma:ma a b c)
  2999. ::
  3000. ++ sqt ~/ %sqt :: square root
  3001. |= [a=@rq] ^- @rq
  3002. ~_ leaf+"rq-fail"
  3003. (sqt:ma a)
  3004. ::
  3005. ++ lth ~/ %lth :: less-than
  3006. |= [a=@rq b=@rq]
  3007. ~_ leaf+"rq-fail"
  3008. (lth:ma a b)
  3009. ::
  3010. ++ lte ~/ %lte :: less-equals
  3011. |= [a=@rq b=@rq]
  3012. ~_ leaf+"rq-fail"
  3013. (lte:ma a b)
  3014. ::
  3015. ++ equ ~/ %equ :: equals
  3016. |= [a=@rq b=@rq]
  3017. ~_ leaf+"rq-fail"
  3018. (equ:ma a b)
  3019. ::
  3020. ++ gte ~/ %gte :: greater-equals
  3021. |= [a=@rq b=@rq]
  3022. ~_ leaf+"rq-fail"
  3023. (gte:ma a b)
  3024. ::
  3025. ++ gth ~/ %gth :: greater-than
  3026. |= [a=@rq b=@rq]
  3027. ~_ leaf+"rq-fail"
  3028. (gth:ma a b)
  3029. ::
  3030. ++ sun |= [a=@u] ^- @rq (sun:ma a) :: uns integer to @rq
  3031. ++ san |= [a=@s] ^- @rq (san:ma a) :: sgn integer to @rq
  3032. ++ sig |= [a=@rq] ^- ? (sig:ma a) :: get sign
  3033. ++ exp |= [a=@rq] ^- @s (exp:ma a) :: get exponent
  3034. ++ toi |= [a=@rq] ^- (unit @s) (toi:ma a) :: round to integer
  3035. ++ drg |= [a=@rq] ^- dn (drg:ma a) :: @rq to decimal float
  3036. ++ grd |= [a=dn] ^- @rq (grd:ma a) :: decimal float to @rq
  3037. --
  3038. ::
  3039. ++ rh :: half precision fp
  3040. ~% %rh +> ~
  3041. ^|
  3042. :: round to nearest, round up, round down, round to zero
  3043. |_ r=$?(%n %u %d %z)
  3044. ::
  3045. ++ ma
  3046. %*(. ff w 5, p 10, b --15, r r)
  3047. ::
  3048. ++ sea :: @rh to fn
  3049. |= [a=@rh] (sea:ma a)
  3050. ::
  3051. ++ bit :: fn to @rh
  3052. |= [a=fn] ^- @rh (bit:ma a)
  3053. ::
  3054. ++ add ~/ %add :: add
  3055. |= [a=@rh b=@rh] ^- @rh
  3056. ~_ leaf+"rh-fail"
  3057. (add:ma a b)
  3058. ::
  3059. ++ sub ~/ %sub :: subtract
  3060. |= [a=@rh b=@rh] ^- @rh
  3061. ~_ leaf+"rh-fail"
  3062. (sub:ma a b)
  3063. ::
  3064. ++ mul ~/ %mul :: multiply
  3065. |= [a=@rh b=@rh] ^- @rh
  3066. ~_ leaf+"rh-fail"
  3067. (mul:ma a b)
  3068. ::
  3069. ++ div ~/ %div :: divide
  3070. |= [a=@rh b=@rh] ^- @rh
  3071. ~_ leaf+"rh-fail"
  3072. (div:ma a b)
  3073. ::
  3074. ++ fma ~/ %fma :: fused multiply-add
  3075. |= [a=@rh b=@rh c=@rh] ^- @rh
  3076. ~_ leaf+"rh-fail"
  3077. (fma:ma a b c)
  3078. ::
  3079. ++ sqt ~/ %sqt :: square root
  3080. |= [a=@rh] ^- @rh
  3081. ~_ leaf+"rh-fail"
  3082. (sqt:ma a)
  3083. ::
  3084. ++ lth ~/ %lth :: less-than
  3085. |= [a=@rh b=@rh]
  3086. ~_ leaf+"rh-fail"
  3087. (lth:ma a b)
  3088. ::
  3089. ++ lte ~/ %lte :: less-equals
  3090. |= [a=@rh b=@rh]
  3091. ~_ leaf+"rh-fail"
  3092. (lte:ma a b)
  3093. ::
  3094. ++ equ ~/ %equ :: equals
  3095. |= [a=@rh b=@rh]
  3096. ~_ leaf+"rh-fail"
  3097. (equ:ma a b)
  3098. ::
  3099. ++ gte ~/ %gte :: greater-equals
  3100. |= [a=@rh b=@rh]
  3101. ~_ leaf+"rh-fail"
  3102. (gte:ma a b)
  3103. ::
  3104. ++ gth ~/ %gth :: greater-than
  3105. |= [a=@rh b=@rh]
  3106. ~_ leaf+"rh-fail"
  3107. (gth:ma a b)
  3108. ::
  3109. ++ tos :: @rh to @rs
  3110. |= [a=@rh] (bit:rs (sea a))
  3111. ::
  3112. ++ fos :: @rs to @rh
  3113. |= [a=@rs] (bit (sea:rs a))
  3114. ::
  3115. ++ sun |= [a=@u] ^- @rh (sun:ma a) :: uns integer to @rh
  3116. ++ san |= [a=@s] ^- @rh (san:ma a) :: sgn integer to @rh
  3117. ++ sig |= [a=@rh] ^- ? (sig:ma a) :: get sign
  3118. ++ exp |= [a=@rh] ^- @s (exp:ma a) :: get exponent
  3119. ++ toi |= [a=@rh] ^- (unit @s) (toi:ma a) :: round to integer
  3120. ++ drg |= [a=@rh] ^- dn (drg:ma a) :: @rh to decimal float
  3121. ++ grd |= [a=dn] ^- @rh (grd:ma a) :: decimal float to @rh
  3122. --
  3123. ::
  3124. :: 3c: urbit time
  3125. +| %urbit-time
  3126. ::
  3127. ++ year :: date to @d
  3128. |= det=date
  3129. ^- @da
  3130. =+ ^= yer
  3131. ?: a.det
  3132. (add 292.277.024.400 y.det)
  3133. (sub 292.277.024.400 (dec y.det))
  3134. =+ day=(yawn yer m.det d.t.det)
  3135. (yule day h.t.det m.t.det s.t.det f.t.det)
  3136. ::
  3137. ++ yore :: @d to date
  3138. |= now=@da
  3139. ^- date
  3140. =+ rip=(yell now)
  3141. =+ ger=(yall d.rip)
  3142. :- ?: (gth y.ger 292.277.024.400)
  3143. [a=& y=(sub y.ger 292.277.024.400)]
  3144. [a=| y=+((sub 292.277.024.400 y.ger))]
  3145. [m.ger d.ger h.rip m.rip s.rip f.rip]
  3146. ::
  3147. ++ yell :: tarp from @d
  3148. |= now=@d
  3149. ^- tarp
  3150. =+ sec=(rsh 6 now)
  3151. =+ ^= fan
  3152. =+ [muc=4 raw=(end 6 now)]
  3153. |- ^- (list @ux)
  3154. ?: |(=(0 raw) =(0 muc))
  3155. ~
  3156. => .(muc (dec muc))
  3157. [(cut 4 [muc 1] raw) $(raw (end [4 muc] raw))]
  3158. =+ day=(div sec day:yo)
  3159. => .(sec (mod sec day:yo))
  3160. =+ hor=(div sec hor:yo)
  3161. => .(sec (mod sec hor:yo))
  3162. =+ mit=(div sec mit:yo)
  3163. => .(sec (mod sec mit:yo))
  3164. [day hor mit sec fan]
  3165. ::
  3166. ++ yule :: time atom
  3167. |= rip=tarp
  3168. ^- @d
  3169. =+ ^= sec ;: add
  3170. (mul d.rip day:yo)
  3171. (mul h.rip hor:yo)
  3172. (mul m.rip mit:yo)
  3173. s.rip
  3174. ==
  3175. =+ ^= fac =+ muc=4
  3176. |- ^- @
  3177. ?~ f.rip
  3178. 0
  3179. => .(muc (dec muc))
  3180. (add (lsh [4 muc] i.f.rip) $(f.rip t.f.rip))
  3181. (con (lsh 6 sec) fac)
  3182. ::
  3183. ++ yall :: day / to day of year
  3184. |= day=@ud
  3185. ^- [y=@ud m=@ud d=@ud]
  3186. =+ [era=0 cet=0 lep=*?]
  3187. => .(era (div day era:yo), day (mod day era:yo))
  3188. => ^+ .
  3189. ?: (lth day +(cet:yo))
  3190. .(lep &, cet 0)
  3191. => .(lep |, cet 1, day (sub day +(cet:yo)))
  3192. .(cet (add cet (div day cet:yo)), day (mod day cet:yo))
  3193. =+ yer=(add (mul 400 era) (mul 100 cet))
  3194. |- ^- [y=@ud m=@ud d=@ud]
  3195. =+ dis=?:(lep 366 365)
  3196. ?. (lth day dis)
  3197. =+ ner=+(yer)
  3198. $(yer ner, day (sub day dis), lep =(0 (end [0 2] ner)))
  3199. |- ^- [y=@ud m=@ud d=@ud]
  3200. =+ [mot=0 cah=?:(lep moy:yo moh:yo)]
  3201. |- ^- [y=@ud m=@ud d=@ud]
  3202. =+ zis=(snag mot cah)
  3203. ?: (lth day zis)
  3204. [yer +(mot) +(day)]
  3205. $(mot +(mot), day (sub day zis))
  3206. ::
  3207. ++ yawn :: days since Jesus
  3208. |= [yer=@ud mot=@ud day=@ud]
  3209. ^- @ud
  3210. => .(mot (dec mot), day (dec day))
  3211. => ^+ .
  3212. %= .
  3213. day
  3214. =+ cah=?:((yelp yer) moy:yo moh:yo)
  3215. |- ^- @ud
  3216. ?: =(0 mot)
  3217. day
  3218. $(mot (dec mot), cah (slag 1 cah), day (add day (snag 0 cah)))
  3219. ==
  3220. |- ^- @ud
  3221. ?. =(0 (mod yer 4))
  3222. =+ ney=(dec yer)
  3223. $(yer ney, day (add day ?:((yelp ney) 366 365)))
  3224. ?. =(0 (mod yer 100))
  3225. =+ nef=(sub yer 4)
  3226. $(yer nef, day (add day ?:((yelp nef) 1.461 1.460)))
  3227. ?. =(0 (mod yer 400))
  3228. =+ nec=(sub yer 100)
  3229. $(yer nec, day (add day ?:((yelp nec) 36.525 36.524)))
  3230. (add day (mul (div yer 400) (add 1 (mul 4 36.524))))
  3231. ::
  3232. ++ yelp :: leap year
  3233. |= yer=@ud ^- ?
  3234. &(=(0 (mod yer 4)) |(!=(0 (mod yer 100)) =(0 (mod yer 400))))
  3235. ::
  3236. ++ yo :: time constants
  3237. |% ++ cet 36.524 :: (add 24 (mul 100 365))
  3238. ++ day 86.400 :: (mul 24 hor)
  3239. ++ era 146.097 :: (add 1 (mul 4 cet))
  3240. ++ hor 3.600 :: (mul 60 mit)
  3241. ++ jes 106.751.991.084.417 :: (mul 730.692.561 era)
  3242. ++ mit 60
  3243. ++ moh `(list @ud)`[31 28 31 30 31 30 31 31 30 31 30 31 ~]
  3244. ++ moy `(list @ud)`[31 29 31 30 31 30 31 31 30 31 30 31 ~]
  3245. ++ qad 126.144.001 :: (add 1 (mul 4 yer))
  3246. ++ yer 31.536.000 :: (mul 365 day)
  3247. --
  3248. ::
  3249. :: 3d: SHA hash family
  3250. +| %sha-hash-family
  3251. ::
  3252. ++ shad |=(ruz=@ (shax (shax ruz))) :: double sha-256
  3253. ++ shaf :: half sha-256
  3254. |= [sal=@ ruz=@]
  3255. =+ haz=(shas sal ruz)
  3256. (mix (end 7 haz) (rsh 7 haz))
  3257. ::
  3258. ++ sham :: 128bit noun hash
  3259. |= yux=* ^- @uvH ^- @
  3260. ?@ yux
  3261. (shaf %mash yux)
  3262. (shaf %sham (jam yux))
  3263. ::
  3264. ++ shas :: salted hash
  3265. ~/ %shas
  3266. |= [sal=@ ruz=@]
  3267. =/ len (max 32 (met 3 sal))
  3268. (shay len (mix sal (shax ruz)))
  3269. ::
  3270. ++ shax :: sha-256
  3271. ~/ %shax
  3272. |= ruz=@ ^- @
  3273. (shay [(met 3 ruz) ruz])
  3274. ::
  3275. ++ shay :: sha-256 with length
  3276. ~/ %shay
  3277. |= [len=@u ruz=@] ^- @
  3278. => .(ruz (cut 3 [0 len] ruz))
  3279. =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
  3280. =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
  3281. =+ ral=(lsh [0 3] len)
  3282. =+ ^= ful
  3283. %+ can 0
  3284. :~ [ral ruz]
  3285. [8 128]
  3286. [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
  3287. [64 (~(net fe 6) ral)]
  3288. ==
  3289. =+ lex=(met 9 ful)
  3290. =+ ^= kbx 0xc671.78f2.bef9.a3f7.a450.6ceb.90be.fffa.
  3291. 8cc7.0208.84c8.7814.78a5.636f.748f.82ee.
  3292. 682e.6ff3.5b9c.ca4f.4ed8.aa4a.391c.0cb3.
  3293. 34b0.bcb5.2748.774c.1e37.6c08.19a4.c116.
  3294. 106a.a070.f40e.3585.d699.0624.d192.e819.
  3295. c76c.51a3.c24b.8b70.a81a.664b.a2bf.e8a1.
  3296. 9272.2c85.81c2.c92e.766a.0abb.650a.7354.
  3297. 5338.0d13.4d2c.6dfc.2e1b.2138.27b7.0a85.
  3298. 1429.2967.06ca.6351.d5a7.9147.c6e0.0bf3.
  3299. bf59.7fc7.b003.27c8.a831.c66d.983e.5152.
  3300. 76f9.88da.5cb0.a9dc.4a74.84aa.2de9.2c6f.
  3301. 240c.a1cc.0fc1.9dc6.efbe.4786.e49b.69c1.
  3302. c19b.f174.9bdc.06a7.80de.b1fe.72be.5d74.
  3303. 550c.7dc3.2431.85be.1283.5b01.d807.aa98.
  3304. ab1c.5ed5.923f.82a4.59f1.11f1.3956.c25b.
  3305. e9b5.dba5.b5c0.fbcf.7137.4491.428a.2f98
  3306. =+ ^= hax 0x5be0.cd19.1f83.d9ab.9b05.688c.510e.527f.
  3307. a54f.f53a.3c6e.f372.bb67.ae85.6a09.e667
  3308. =+ i=0
  3309. |- ^- @
  3310. ?: =(i lex)
  3311. (run 5 hax net)
  3312. =+ ^= wox
  3313. =+ dux=(cut 9 [i 1] ful)
  3314. =+ wox=(run 5 dux net)
  3315. =+ j=16
  3316. |- ^- @
  3317. ?: =(64 j)
  3318. wox
  3319. =+ :* l=(wac (sub j 15) wox)
  3320. m=(wac (sub j 2) wox)
  3321. n=(wac (sub j 16) wox)
  3322. o=(wac (sub j 7) wox)
  3323. ==
  3324. =+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh [0 3] l))
  3325. =+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh [0 10] m))
  3326. =+ z=:(sum n x o y)
  3327. $(wox (con (lsh [5 j] z) wox), j +(j))
  3328. =+ j=0
  3329. =+ :* a=(wac 0 hax)
  3330. b=(wac 1 hax)
  3331. c=(wac 2 hax)
  3332. d=(wac 3 hax)
  3333. e=(wac 4 hax)
  3334. f=(wac 5 hax)
  3335. g=(wac 6 hax)
  3336. h=(wac 7 hax)
  3337. ==
  3338. |- ^- @
  3339. ?: =(64 j)
  3340. %= ^$
  3341. i +(i)
  3342. hax %+ rep 5
  3343. :~ (sum a (wac 0 hax))
  3344. (sum b (wac 1 hax))
  3345. (sum c (wac 2 hax))
  3346. (sum d (wac 3 hax))
  3347. (sum e (wac 4 hax))
  3348. (sum f (wac 5 hax))
  3349. (sum g (wac 6 hax))
  3350. (sum h (wac 7 hax))
  3351. ==
  3352. ==
  3353. =+ l=:(mix (ror 0 2 a) (ror 0 13 a) (ror 0 22 a)) :: s0
  3354. =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
  3355. =+ n=(sum l m) :: t2
  3356. =+ o=:(mix (ror 0 6 e) (ror 0 11 e) (ror 0 25 e)) :: s1
  3357. =+ p=(mix (dis e f) (dis (inv e) g)) :: ch
  3358. =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
  3359. $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
  3360. ::
  3361. ++ shaw :: hash to nbits
  3362. |= [sal=@ len=@ ruz=@]
  3363. (~(raw og (shas sal (mix len ruz))) len)
  3364. ::
  3365. ++ shaz :: sha-512
  3366. |= ruz=@ ^- @
  3367. (shal [(met 3 ruz) ruz])
  3368. ::
  3369. ++ shal :: sha-512 with length
  3370. ~/ %shal
  3371. |= [len=@ ruz=@] ^- @
  3372. => .(ruz (cut 3 [0 len] ruz))
  3373. =+ [few==>(fe .(a 6)) wac=|=([a=@ b=@] (cut 6 [a 1] b))]
  3374. =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
  3375. =+ ral=(lsh [0 3] len)
  3376. =+ ^= ful
  3377. %+ can 0
  3378. :~ [ral ruz]
  3379. [8 128]
  3380. [(mod (sub 1.920 (mod (add 8 ral) 1.024)) 1.024) 0]
  3381. [128 (~(net fe 7) ral)]
  3382. ==
  3383. =+ lex=(met 10 ful)
  3384. =+ ^= kbx 0x6c44.198c.4a47.5817.5fcb.6fab.3ad6.faec.
  3385. 597f.299c.fc65.7e2a.4cc5.d4be.cb3e.42b6.
  3386. 431d.67c4.9c10.0d4c.3c9e.be0a.15c9.bebc.
  3387. 32ca.ab7b.40c7.2493.28db.77f5.2304.7d84.
  3388. 1b71.0b35.131c.471b.113f.9804.bef9.0dae.
  3389. 0a63.7dc5.a2c8.98a6.06f0.67aa.7217.6fba.
  3390. f57d.4f7f.ee6e.d178.eada.7dd6.cde0.eb1e.
  3391. d186.b8c7.21c0.c207.ca27.3ece.ea26.619c.
  3392. c671.78f2.e372.532b.bef9.a3f7.b2c6.7915.
  3393. a450.6ceb.de82.bde9.90be.fffa.2363.1e28.
  3394. 8cc7.0208.1a64.39ec.84c8.7814.a1f0.ab72.
  3395. 78a5.636f.4317.2f60.748f.82ee.5def.b2fc.
  3396. 682e.6ff3.d6b2.b8a3.5b9c.ca4f.7763.e373.
  3397. 4ed8.aa4a.e341.8acb.391c.0cb3.c5c9.5a63.
  3398. 34b0.bcb5.e19b.48a8.2748.774c.df8e.eb99.
  3399. 1e37.6c08.5141.ab53.19a4.c116.b8d2.d0c8.
  3400. 106a.a070.32bb.d1b8.f40e.3585.5771.202a.
  3401. d699.0624.5565.a910.d192.e819.d6ef.5218.
  3402. c76c.51a3.0654.be30.c24b.8b70.d0f8.9791.
  3403. a81a.664b.bc42.3001.a2bf.e8a1.4cf1.0364.
  3404. 9272.2c85.1482.353b.81c2.c92e.47ed.aee6.
  3405. 766a.0abb.3c77.b2a8.650a.7354.8baf.63de.
  3406. 5338.0d13.9d95.b3df.4d2c.6dfc.5ac4.2aed.
  3407. 2e1b.2138.5c26.c926.27b7.0a85.46d2.2ffc.
  3408. 1429.2967.0a0e.6e70.06ca.6351.e003.826f.
  3409. d5a7.9147.930a.a725.c6e0.0bf3.3da8.8fc2.
  3410. bf59.7fc7.beef.0ee4.b003.27c8.98fb.213f.
  3411. a831.c66d.2db4.3210.983e.5152.ee66.dfab.
  3412. 76f9.88da.8311.53b5.5cb0.a9dc.bd41.fbd4.
  3413. 4a74.84aa.6ea6.e483.2de9.2c6f.592b.0275.
  3414. 240c.a1cc.77ac.9c65.0fc1.9dc6.8b8c.d5b5.
  3415. efbe.4786.384f.25e3.e49b.69c1.9ef1.4ad2.
  3416. c19b.f174.cf69.2694.9bdc.06a7.25c7.1235.
  3417. 80de.b1fe.3b16.96b1.72be.5d74.f27b.896f.
  3418. 550c.7dc3.d5ff.b4e2.2431.85be.4ee4.b28c.
  3419. 1283.5b01.4570.6fbe.d807.aa98.a303.0242.
  3420. ab1c.5ed5.da6d.8118.923f.82a4.af19.4f9b.
  3421. 59f1.11f1.b605.d019.3956.c25b.f348.b538.
  3422. e9b5.dba5.8189.dbbc.b5c0.fbcf.ec4d.3b2f.
  3423. 7137.4491.23ef.65cd.428a.2f98.d728.ae22
  3424. =+ ^= hax 0x5be0.cd19.137e.2179.1f83.d9ab.fb41.bd6b.
  3425. 9b05.688c.2b3e.6c1f.510e.527f.ade6.82d1.
  3426. a54f.f53a.5f1d.36f1.3c6e.f372.fe94.f82b.
  3427. bb67.ae85.84ca.a73b.6a09.e667.f3bc.c908
  3428. =+ i=0
  3429. |- ^- @
  3430. ?: =(i lex)
  3431. (run 6 hax net)
  3432. =+ ^= wox
  3433. =+ dux=(cut 10 [i 1] ful)
  3434. =+ wox=(run 6 dux net)
  3435. =+ j=16
  3436. |- ^- @
  3437. ?: =(80 j)
  3438. wox
  3439. =+ :* l=(wac (sub j 15) wox)
  3440. m=(wac (sub j 2) wox)
  3441. n=(wac (sub j 16) wox)
  3442. o=(wac (sub j 7) wox)
  3443. ==
  3444. =+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh [0 7] l))
  3445. =+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh [0 6] m))
  3446. =+ z=:(sum n x o y)
  3447. $(wox (con (lsh [6 j] z) wox), j +(j))
  3448. =+ j=0
  3449. =+ :* a=(wac 0 hax)
  3450. b=(wac 1 hax)
  3451. c=(wac 2 hax)
  3452. d=(wac 3 hax)
  3453. e=(wac 4 hax)
  3454. f=(wac 5 hax)
  3455. g=(wac 6 hax)
  3456. h=(wac 7 hax)
  3457. ==
  3458. |- ^- @
  3459. ?: =(80 j)
  3460. %= ^$
  3461. i +(i)
  3462. hax %+ rep 6
  3463. :~ (sum a (wac 0 hax))
  3464. (sum b (wac 1 hax))
  3465. (sum c (wac 2 hax))
  3466. (sum d (wac 3 hax))
  3467. (sum e (wac 4 hax))
  3468. (sum f (wac 5 hax))
  3469. (sum g (wac 6 hax))
  3470. (sum h (wac 7 hax))
  3471. ==
  3472. ==
  3473. =+ l=:(mix (ror 0 28 a) (ror 0 34 a) (ror 0 39 a)) :: S0
  3474. =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
  3475. =+ n=(sum l m) :: t2
  3476. =+ o=:(mix (ror 0 14 e) (ror 0 18 e) (ror 0 41 e)) :: S1
  3477. =+ p=(mix (dis e f) (dis (inv e) g)) :: ch
  3478. =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
  3479. $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
  3480. ::
  3481. ++ shan :: sha-1 (deprecated)
  3482. |= ruz=@
  3483. =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
  3484. =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
  3485. =+ ral=(lsh [0 3] (met 3 ruz))
  3486. =+ ^= ful
  3487. %+ can 0
  3488. :~ [ral ruz]
  3489. [8 128]
  3490. [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
  3491. [64 (~(net fe 6) ral)]
  3492. ==
  3493. =+ lex=(met 9 ful)
  3494. =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
  3495. =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
  3496. =+ i=0
  3497. |-
  3498. ?: =(i lex)
  3499. (rep 5 (flop (rip 5 hax)))
  3500. =+ ^= wox
  3501. =+ dux=(cut 9 [i 1] ful)
  3502. =+ wox=(rep 5 (turn (rip 5 dux) net))
  3503. =+ j=16
  3504. |- ^- @
  3505. ?: =(80 j)
  3506. wox
  3507. =+ :* l=(wac (sub j 3) wox)
  3508. m=(wac (sub j 8) wox)
  3509. n=(wac (sub j 14) wox)
  3510. o=(wac (sub j 16) wox)
  3511. ==
  3512. =+ z=(rol 0 1 :(mix l m n o))
  3513. $(wox (con (lsh [5 j] z) wox), j +(j))
  3514. =+ j=0
  3515. =+ :* a=(wac 0 hax)
  3516. b=(wac 1 hax)
  3517. c=(wac 2 hax)
  3518. d=(wac 3 hax)
  3519. e=(wac 4 hax)
  3520. ==
  3521. |- ^- @
  3522. ?: =(80 j)
  3523. %= ^$
  3524. i +(i)
  3525. hax %+ rep 5
  3526. :~
  3527. (sum a (wac 0 hax))
  3528. (sum b (wac 1 hax))
  3529. (sum c (wac 2 hax))
  3530. (sum d (wac 3 hax))
  3531. (sum e (wac 4 hax))
  3532. ==
  3533. ==
  3534. =+ fx=(con (dis b c) (dis (not 5 1 b) d))
  3535. =+ fy=:(mix b c d)
  3536. =+ fz=:(con (dis b c) (dis b d) (dis c d))
  3537. =+ ^= tem
  3538. ?: &((gte j 0) (lte j 19))
  3539. :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
  3540. ?: &((gte j 20) (lte j 39))
  3541. :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
  3542. ?: &((gte j 40) (lte j 59))
  3543. :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
  3544. :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
  3545. $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
  3546. ::
  3547. :: NEVER USE: broken piece of trash
  3548. ++ og :: shax-powered rng
  3549. |_ a=@
  3550. ++ rad :: random in range
  3551. |= b=@ ^- @
  3552. !!
  3553. ::
  3554. ++ rads :: random continuation
  3555. |= b=@
  3556. !!
  3557. ::
  3558. ++ raw :: random bits
  3559. |= b=@ ^- @
  3560. !!
  3561. ::
  3562. ++ raws :: random bits
  3563. |= b=@ :: continuation
  3564. !!
  3565. --
  3566. ::
  3567. ++ sha :: correct byte-order
  3568. ~% %sha ..sha ~
  3569. => |%
  3570. ++ flin |=(a=@ (swp 3 a)) :: flip input
  3571. ++ flim |=(byts [wid (rev 3 wid dat)]) :: flip input w= length
  3572. ++ flip |=(w=@u (cury (cury rev 3) w)) :: flip output of size
  3573. ++ meet |=(a=@ [(met 3 a) a]) :: measure input size
  3574. --
  3575. |%
  3576. ::
  3577. :: use with @
  3578. ::
  3579. ++ sha-1 (cork meet sha-1l)
  3580. ++ sha-256 :(cork flin shax (flip 32))
  3581. ++ sha-512 :(cork flin shaz (flip 64))
  3582. ::
  3583. :: use with byts
  3584. ::
  3585. ++ sha-256l :(cork flim shay (flip 32))
  3586. ++ sha-512l :(cork flim shal (flip 64))
  3587. ::
  3588. ++ sha-1l
  3589. ~/ %sha1
  3590. |= byts
  3591. ^- @
  3592. =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
  3593. =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
  3594. =+ ral=(lsh [0 3] wid)
  3595. =+ ^= ful
  3596. %+ can 0
  3597. :~ [ral (rev 3 wid dat)]
  3598. [8 128]
  3599. [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
  3600. [64 (~(net fe 6) ral)]
  3601. ==
  3602. =+ lex=(met 9 ful)
  3603. =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
  3604. =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
  3605. =+ i=0
  3606. |-
  3607. ?: =(i lex)
  3608. (rep 5 (flop (rip 5 hax)))
  3609. =+ ^= wox
  3610. =+ dux=(cut 9 [i 1] ful)
  3611. =+ wox=(rep 5 (turn (rip 5 dux) net))
  3612. =+ j=16
  3613. |- ^- @
  3614. ?: =(80 j)
  3615. wox
  3616. =+ :* l=(wac (sub j 3) wox)
  3617. m=(wac (sub j 8) wox)
  3618. n=(wac (sub j 14) wox)
  3619. o=(wac (sub j 16) wox)
  3620. ==
  3621. =+ z=(rol 0 1 :(mix l m n o))
  3622. $(wox (con (lsh [5 j] z) wox), j +(j))
  3623. =+ j=0
  3624. =+ :* a=(wac 0 hax)
  3625. b=(wac 1 hax)
  3626. c=(wac 2 hax)
  3627. d=(wac 3 hax)
  3628. e=(wac 4 hax)
  3629. ==
  3630. |- ^- @
  3631. ?: =(80 j)
  3632. %= ^$
  3633. i +(i)
  3634. hax %+ rep 5
  3635. :~
  3636. (sum a (wac 0 hax))
  3637. (sum b (wac 1 hax))
  3638. (sum c (wac 2 hax))
  3639. (sum d (wac 3 hax))
  3640. (sum e (wac 4 hax))
  3641. ==
  3642. ==
  3643. =+ fx=(con (dis b c) (dis (not 5 1 b) d))
  3644. =+ fy=:(mix b c d)
  3645. =+ fz=:(con (dis b c) (dis b d) (dis c d))
  3646. =+ ^= tem
  3647. ?: &((gte j 0) (lte j 19))
  3648. :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
  3649. ?: &((gte j 20) (lte j 39))
  3650. :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
  3651. ?: &((gte j 40) (lte j 59))
  3652. :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
  3653. :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
  3654. $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
  3655. --
  3656. :: 3f: scrambling
  3657. +| %scrambling
  3658. ::
  3659. ++ un :: =(x (wred (wren x)))
  3660. |%
  3661. ++ wren :: conceal structure
  3662. |= pyn=@ ^- @
  3663. =+ len=(met 3 pyn)
  3664. ?: =(0 len)
  3665. 0
  3666. => .(len (dec len))
  3667. =+ mig=(zaft (xafo len (cut 3 [len 1] pyn)))
  3668. %+ can 3
  3669. %- flop ^- (list [@ @])
  3670. :- [1 mig]
  3671. |- ^- (list [@ @])
  3672. ?: =(0 len)
  3673. ~
  3674. => .(len (dec len))
  3675. =+ mog=(zyft :(mix mig (end 3 len) (cut 3 [len 1] pyn)))
  3676. [[1 mog] $(mig mog)]
  3677. ::
  3678. ++ wred :: restore structure
  3679. |= cry=@ ^- @
  3680. =+ len=(met 3 cry)
  3681. ?: =(0 len)
  3682. 0
  3683. => .(len (dec len))
  3684. =+ mig=(cut 3 [len 1] cry)
  3685. %+ can 3
  3686. %- flop ^- (list [@ @])
  3687. :- [1 (xaro len (zart mig))]
  3688. |- ^- (list [@ @])
  3689. ?: =(0 len)
  3690. ~
  3691. => .(len (dec len))
  3692. =+ mog=(cut 3 [len 1] cry)
  3693. [[1 :(mix mig (end 3 len) (zyrt mog))] $(mig mog)]
  3694. ::
  3695. ++ xafo |=([a=@ b=@] +((mod (add (dec b) a) 255)))
  3696. ++ xaro |=([a=@ b=@] +((mod (add (dec b) (sub 255 (mod a 255))) 255)))
  3697. ::
  3698. ++ zaft :: forward 255-sbox
  3699. |= a=@D
  3700. =+ ^= b
  3701. 0xcc.75bc.86c8.2fb1.9a42.f0b3.79a0.92ca.21f6.1e41.cde5.fcc0.
  3702. 7e85.51ae.1005.c72d.1246.07e8.7c64.a914.8d69.d9f4.59c2.8038.
  3703. 1f4a.dca2.6fdf.66f9.f561.a12e.5a16.f7b0.a39f.364e.cb70.7318.
  3704. 1de1.ad31.63d1.abd4.db68.6a33.134d.a760.edee.5434.493a.e323.
  3705. 930d.8f3d.3562.bb81.0b24.43cf.bea5.a6eb.52b4.0229.06b2.6704.
  3706. 78c9.45ec.d75e.58af.c577.b7b9.c40e.017d.90c3.87f8.96fa.1153.
  3707. 0372.7f30.1c32.ac83.ff17.c6e4.d36d.6b55.e2ce.8c71.8a5b.b6f3.
  3708. 9d4b.eab5.8b3c.e7f2.a8fe.9574.5de0.bf20.3f15.9784.9939.5f9c.
  3709. e609.564f.d8a4.b825.9819.94aa.2c08.8e4c.9b22.477a.2840.3ed6.
  3710. 3750.6ef1.44dd.89ef.6576.d00a.fbda.9ed2.3b6c.7b0c.bde9.2ade.
  3711. 5c88.c182.481a.1b0f.2bfd.d591.2726.57ba
  3712. (cut 3 [(dec a) 1] b)
  3713. ::
  3714. ++ zart :: reverse 255-sbox
  3715. |= a=@D
  3716. =+ ^= b
  3717. 0x68.4f07.ea1c.73c9.75c2.efc8.d559.5125.f621.a7a8.8591.5613.
  3718. dd52.40eb.65a2.60b7.4bcb.1123.ceb0.1bd6.3c84.2906.b164.19b3.
  3719. 1e95.5fec.ffbc.f187.fbe2.6680.7c77.d30e.e94a.9414.fd9a.017d.
  3720. 3a7e.5a55.8ff5.8bf9.c181.e5b6.6ab2.35da.50aa.9293.3bc0.cdc6.
  3721. f3bf.1a58.4130.f844.3846.744e.36a0.f205.789e.32d8.5e54.5c22.
  3722. 0f76.fce7.4569.0d99.d26e.e879.dc16.2df4.887f.1ffe.4dba.6f5d.
  3723. bbcc.2663.1762.aed7.af8a.ca20.dbb4.9bc7.a942.834c.105b.c4d4.
  3724. 8202.3e61.a671.90e6.273d.bdab.3157.cfa4.0c2e.df86.2496.f7ed.
  3725. 2b48.2a9d.5318.a343.d128.be9c.a5ad.6bb5.6dfa.c5e1.3408.128d.
  3726. 2c04.0339.97a1.2ff0.49d0.eeb8.6c0a.0b37.b967.c347.d9ac.e072.
  3727. e409.7b9f.1598.1d3f.33de.8ce3.8970.8e7a
  3728. (cut 3 [(dec a) 1] b)
  3729. ::
  3730. ++ zyft :: forward 256-sbox
  3731. |= a=@D
  3732. =+ ^= b
  3733. 0xbb49.b71f.b881.b402.17e4.6b86.69b5.1647.115f.dddb.7ca5.
  3734. 8371.4bd5.19a9.b092.605d.0d9b.e030.a0cc.78ba.5706.4d2d.
  3735. 986a.768c.f8e8.c4c7.2f1c.effe.3cae.01c0.253e.65d3.3872.
  3736. ce0e.7a74.8ac6.daac.7e5c.6479.44ec.4143.3d20.4af0.ee6c.
  3737. c828.deca.0377.249f.ffcd.7b4f.eb7d.66f2.8951.042e.595a.
  3738. 8e13.f9c3.a79a.f788.6199.9391.7fab.6200.4ce5.0758.e2f1.
  3739. 7594.c945.d218.4248.afa1.e61a.54fb.1482.bea4.96a2.3473.
  3740. 63c2.e7cb.155b.120a.4ed7.bfd8.b31b.4008.f329.fca3.5380.
  3741. 9556.0cb2.8722.2bea.e96e.3ac5.d1bc.10e3.2c52.a62a.b1d6.
  3742. 35aa.d05e.f6a8.0f3b.31ed.559d.09ad.f585.6d21.fd1d.8d67.
  3743. 370b.26f4.70c1.b923.4684.6fbd.cf8b.5036.0539.9cdc.d93f.
  3744. 9068.1edf.8f33.b632.d427.97fa.9ee1
  3745. (cut 3 [a 1] b)
  3746. ::
  3747. ++ zyrt :: reverse 256-sbox
  3748. |= a=@D
  3749. =+ ^= b
  3750. 0x9fc8.2753.6e02.8fcf.8b35.2b20.5598.7caa.c9a9.30b0.9b48.
  3751. 47ce.6371.80f6.407d.00dd.0aa5.ed10.ecb7.0f5a.5c3a.e605.
  3752. c077.4337.17bd.9eda.62a4.79a7.ccb8.44cd.8e64.1ec4.5b6b.
  3753. 1842.ffd8.1dfb.fd07.f2f9.594c.3be3.73c6.2cb6.8438.e434.
  3754. 8d3d.ea6a.5268.72db.a001.2e11.de8c.88d3.0369.4f7a.87e2.
  3755. 860d.0991.25d0.16b9.978a.4bf4.2a1a.e96c.fa50.85b5.9aeb.
  3756. 9dbb.b2d9.a2d1.7bba.66be.e81f.1946.29a8.f5d2.f30c.2499.
  3757. c1b3.6583.89e1.ee36.e0b4.6092.937e.d74e.2f6f.513e.9615.
  3758. 9c5d.d581.e7ab.fe74.f01b.78b1.ae75.af57.0ec2.adc7.3245.
  3759. 12bf.2314.3967.0806.31dc.cb94.d43f.493c.54a6.0421.c3a1.
  3760. 1c4a.28ac.fc0b.26ca.5870.e576.f7f1.616d.905f.ef41.33bc.
  3761. df4d.225e.2d56.7fd6.1395.a3f8.c582
  3762. (cut 3 [a 1] b)
  3763. --
  3764. ::
  3765. ++ ob
  3766. ~% %ob ..ob
  3767. ==
  3768. %fein fein
  3769. %fynd fynd
  3770. ==
  3771. |%
  3772. ::
  3773. :: +fein: conceal structure, v3.
  3774. ::
  3775. :: +fein conceals planet-sized atoms. The idea is that it should not be
  3776. :: trivial to tell which planet a star has spawned under.
  3777. ::
  3778. ++ fein
  3779. ~/ %fein
  3780. |= pyn=@ ^- @
  3781. ?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff))
  3782. (add 0x1.0000 (feis (sub pyn 0x1.0000)))
  3783. ?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff))
  3784. =/ lo (dis pyn 0xffff.ffff)
  3785. =/ hi (dis pyn 0xffff.ffff.0000.0000)
  3786. %+ con hi
  3787. $(pyn lo)
  3788. pyn
  3789. ::
  3790. :: +fynd: restore structure, v3.
  3791. ::
  3792. :: Restores obfuscated values that have been enciphered with +fein.
  3793. ::
  3794. ++ fynd
  3795. ~/ %fynd
  3796. |= cry=@ ^- @
  3797. ?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff))
  3798. (add 0x1.0000 (tail (sub cry 0x1.0000)))
  3799. ?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff))
  3800. =/ lo (dis cry 0xffff.ffff)
  3801. =/ hi (dis cry 0xffff.ffff.0000.0000)
  3802. %+ con hi
  3803. $(cry lo)
  3804. cry
  3805. :: +feis: a four-round generalised Feistel cipher over the domain
  3806. :: [0, 2^32 - 2^16 - 1].
  3807. ::
  3808. :: See: Black & Rogaway (2002), Ciphers for arbitrary finite domains.
  3809. ::
  3810. ++ feis
  3811. |= m=@
  3812. ^- @
  3813. (fee 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
  3814. ::
  3815. :: +tail: reverse +feis.
  3816. ::
  3817. ++ tail
  3818. |= m=@
  3819. ^- @
  3820. (feen 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
  3821. ::
  3822. :: +fee: "Fe" in B&R (2002).
  3823. ::
  3824. :: A Feistel cipher given the following parameters:
  3825. ::
  3826. :: r: number of Feistel rounds
  3827. :: a, b: parameters such that ab >= k
  3828. :: k: value such that the domain of the cipher is [0, k - 1]
  3829. :: prf: a gate denoting a family of pseudorandom functions indexed by
  3830. :: its first argument and taking its second argument as input
  3831. :: m: an input value in the domain [0, k - 1]
  3832. ::
  3833. ++ fee
  3834. |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
  3835. ^- @
  3836. =/ c (fe r a b prf m)
  3837. ?: (lth c k)
  3838. c
  3839. (fe r a b prf c)
  3840. ::
  3841. :: +feen: "Fe^-1" in B&R (2002).
  3842. ::
  3843. :: Reverses a Feistel cipher constructed with parameters as described in
  3844. :: +fee.
  3845. ::
  3846. ++ feen
  3847. |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
  3848. ^- @
  3849. =/ c (fen r a b prf m)
  3850. ?: (lth c k)
  3851. c
  3852. (fen r a b prf c)
  3853. ::
  3854. :: +fe: "fe" in B&R (2002).
  3855. ::
  3856. :: An internal function to +fee.
  3857. ::
  3858. :: Note that this implementation differs slightly from the reference paper
  3859. :: to support some legacy behaviour. See urbit/arvo#1105.
  3860. ::
  3861. ++ fe
  3862. |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
  3863. =/ j 1
  3864. =/ ell (mod m a)
  3865. =/ arr (div m a)
  3866. |- ^- @
  3867. ::
  3868. ?: (gth j r)
  3869. ?. =((mod r 2) 0)
  3870. (add (mul arr a) ell)
  3871. ::
  3872. :: Note that +fe differs from B&R (2002)'s "fe" below, as a previous
  3873. :: implementation of this cipher contained a bug such that certain inputs
  3874. :: could encipher to the same output.
  3875. ::
  3876. :: To correct these problem cases while also preserving the cipher's
  3877. :: legacy behaviour on most inputs, we check for a problem case (which
  3878. :: occurs when 'arr' is equal to 'a') and, if detected, use an alternate
  3879. :: permutation instead.
  3880. ::
  3881. ?: =(arr a)
  3882. (add (mul arr a) ell)
  3883. (add (mul ell a) arr)
  3884. ::
  3885. =/ f (prf (sub j 1) arr)
  3886. ::
  3887. =/ tmp
  3888. ?. =((mod j 2) 0)
  3889. (mod (add f ell) a)
  3890. (mod (add f ell) b)
  3891. ::
  3892. $(j +(j), ell arr, arr tmp)
  3893. ::
  3894. :: +fen: "fe^-1" in B&R (2002).
  3895. ::
  3896. :: Note that this implementation differs slightly from the reference paper
  3897. :: to support some legacy behaviour. See urbit/arvo#1105.
  3898. ::
  3899. ++ fen
  3900. |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
  3901. =/ j r
  3902. ::
  3903. =/ ahh
  3904. ?. =((mod r 2) 0)
  3905. (div m a)
  3906. (mod m a)
  3907. ::
  3908. =/ ale
  3909. ?. =((mod r 2) 0)
  3910. (mod m a)
  3911. (div m a)
  3912. ::
  3913. :: Similar to the comment in +fe, +fen differs from B&R (2002)'s "fe^-1"
  3914. :: here in order to preserve the legacy cipher's behaviour on most inputs.
  3915. ::
  3916. :: Here problem cases can be identified by 'ahh' equating with 'a'; we
  3917. :: correct those cases by swapping the values of 'ahh' and 'ale'.
  3918. ::
  3919. =/ ell
  3920. ?: =(ale a)
  3921. ahh
  3922. ale
  3923. ::
  3924. =/ arr
  3925. ?: =(ale a)
  3926. ale
  3927. ahh
  3928. ::
  3929. |- ^- @
  3930. ?: (lth j 1)
  3931. (add (mul arr a) ell)
  3932. =/ f (prf (sub j 1) ell)
  3933. ::
  3934. :: Note that there is a slight deviation here to avoid dealing with
  3935. :: negative values. We add 'a' or 'b' to arr as appropriate and reduce
  3936. :: 'f' modulo the same number before performing subtraction.
  3937. ::
  3938. =/ tmp
  3939. ?. =((mod j 2) 0)
  3940. (mod (sub (add arr a) (mod f a)) a)
  3941. (mod (sub (add arr b) (mod f b)) b)
  3942. ::
  3943. $(j (sub j 1), ell tmp, arr ell)
  3944. ::
  3945. :: +eff: a murmur3-based pseudorandom function. 'F' in B&R (2002).
  3946. ::
  3947. ++ eff
  3948. |= [j=@ r=@]
  3949. ^- @
  3950. (muk (snag j raku) 2 r)
  3951. ::
  3952. :: +raku: seeds for eff.
  3953. ::
  3954. ++ raku
  3955. ^- (list @ux)
  3956. :~ 0xb76d.5eed
  3957. 0xee28.1300
  3958. 0x85bc.ae01
  3959. 0x4b38.7af7
  3960. ==
  3961. ::
  3962. --
  3963. ::
  3964. :: 3g: molds and mold builders
  3965. +| %molds-and-mold-builders
  3966. ::
  3967. +$ coin $~ [%$ %ud 0] :: print format
  3968. $% [%$ p=dime] ::
  3969. [%blob p=*] ::
  3970. [%many p=(list coin)] ::
  3971. == ::
  3972. +$ dime [p=@ta q=@] ::
  3973. +$ edge [p=hair q=(unit [p=* q=nail])] :: parsing output
  3974. +$ hair [p=@ud q=@ud] :: parsing trace
  3975. ++ like |* a=$-(* *) :: generic edge
  3976. |: b=`*`[(hair) ~] ::
  3977. :- p=(hair -.b) ::
  3978. ^= q ::
  3979. ?@ +.b ~ ::
  3980. :- ~ ::
  3981. u=[p=(a +>-.b) q=[p=(hair -.b) q=(tape +.b)]] ::
  3982. +$ nail [p=hair q=tape] :: parsing input
  3983. +$ pint [p=[p=@ q=@] q=[p=@ q=@]] :: line+column range
  3984. +$ rule _|:($:nail $:edge) :: parsing rule
  3985. +$ spot [p=path q=pint] :: range in file
  3986. +$ tone $% [%0 product=*] :: success
  3987. [%1 block=*] :: single block
  3988. [%2 trace=(list [@ta *])] :: error report
  3989. == ::
  3990. +$ toon $% [%0 p=*] :: success
  3991. [%1 p=*] :: block
  3992. [%2 p=(list tank)] :: stack trace
  3993. == ::
  3994. ++ wonk |* veq=_$:edge :: product from edge
  3995. ?~(q.veq !! p.u.q.veq) ::
  3996. -- =>
  3997. ::
  3998. ~% %qua
  3999. +
  4000. ==
  4001. %mure mure
  4002. %mute mute
  4003. %show show
  4004. ==
  4005. :: layer-4
  4006. ::
  4007. |%
  4008. ::
  4009. :: 4a: exotic bases
  4010. +| %exotic-bases
  4011. ::
  4012. ++ po :: phonetic base
  4013. ~/ %po
  4014. =+ :- ^= sis :: prefix syllables
  4015. 'dozmarbinwansamlitsighidfidlissogdirwacsabwissib\
  4016. /rigsoldopmodfoglidhopdardorlorhodfolrintogsilmir\
  4017. /holpaslacrovlivdalsatlibtabhanticpidtorbolfosdot\
  4018. /losdilforpilramtirwintadbicdifrocwidbisdasmidlop\
  4019. /rilnardapmolsanlocnovsitnidtipsicropwitnatpanmin\
  4020. /ritpodmottamtolsavposnapnopsomfinfonbanmorworsip\
  4021. /ronnorbotwicsocwatdolmagpicdavbidbaltimtasmallig\
  4022. /sivtagpadsaldivdactansidfabtarmonranniswolmispal\
  4023. /lasdismaprabtobrollatlonnodnavfignomnibpagsopral\
  4024. /bilhaddocridmocpacravripfaltodtiltinhapmicfanpat\
  4025. /taclabmogsimsonpinlomrictapfirhasbosbatpochactid\
  4026. /havsaplindibhosdabbitbarracparloddosbortochilmac\
  4027. /tomdigfilfasmithobharmighinradmashalraglagfadtop\
  4028. /mophabnilnosmilfopfamdatnoldinhatnacrisfotribhoc\
  4029. /nimlarfitwalrapsarnalmoslandondanladdovrivbacpol\
  4030. /laptalpitnambonrostonfodponsovnocsorlavmatmipfip'
  4031. ^= dex :: suffix syllables
  4032. 'zodnecbudwessevpersutletfulpensytdurwepserwylsun\
  4033. /rypsyxdyrnuphebpeglupdepdysputlughecryttyvsydnex\
  4034. /lunmeplutseppesdelsulpedtemledtulmetwenbynhexfeb\
  4035. /pyldulhetmevruttylwydtepbesdexsefwycburderneppur\
  4036. /rysrebdennutsubpetrulsynregtydsupsemwynrecmegnet\
  4037. /secmulnymtevwebsummutnyxrextebfushepbenmuswyxsym\
  4038. /selrucdecwexsyrwetdylmynmesdetbetbeltuxtugmyrpel\
  4039. /syptermebsetdutdegtexsurfeltudnuxruxrenwytnubmed\
  4040. /lytdusnebrumtynseglyxpunresredfunrevrefmectedrus\
  4041. /bexlebduxrynnumpyxrygryxfeptyrtustyclegnemfermer\
  4042. /tenlusnussyltecmexpubrymtucfyllepdebbermughuttun\
  4043. /bylsudpemdevlurdefbusbeprunmelpexdytbyttyplevmyl\
  4044. /wedducfurfexnulluclennerlexrupnedlecrydlydfenwel\
  4045. /nydhusrelrudneshesfetdesretdunlernyrsebhulryllud\
  4046. /remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\
  4047. /lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes'
  4048. |%
  4049. ++ ins ~/ %ins :: parse prefix
  4050. |= a=@tas
  4051. =+ b=0
  4052. |- ^- (unit @)
  4053. ?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b))))
  4054. ++ ind ~/ %ind :: parse suffix
  4055. |= a=@tas
  4056. =+ b=0
  4057. |- ^- (unit @)
  4058. ?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b))))
  4059. ++ tos ~/ %tos :: fetch prefix
  4060. |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis)))
  4061. ++ tod ~/ %tod :: fetch suffix
  4062. |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex)))
  4063. --
  4064. ::
  4065. ++ fa :: base58check
  4066. =+ key='123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz'
  4067. =/ yek=@ux ~+
  4068. =- yek:(roll (rip 3 key) -)
  4069. =+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)]
  4070. |.
  4071. [+(b) (mix yek (lsh [3 `@u`a] (~(inv fe 3) b)))]
  4072. |%
  4073. ++ cha |=(a=char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b)))
  4074. ++ tok
  4075. |= a=@ux ^- @ux
  4076. =+ b=(pad a)
  4077. =- (~(net fe 5) (end [3 4] (shay 32 -)))
  4078. (shay (add b (met 3 a)) (lsh [3 b] (swp 3 a)))
  4079. ::
  4080. ++ pad |=(a=@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b))))
  4081. ++ enc |=(a=@ux `@ux`(mix (lsh [3 4] a) (tok a)))
  4082. ++ den
  4083. |= a=@ux ^- (unit @ux)
  4084. =+ b=(rsh [3 4] a)
  4085. ?. =((tok b) (end [3 4] a))
  4086. ~
  4087. `b
  4088. --
  4089. :: 4b: text processing
  4090. +| %text-processing
  4091. ::
  4092. ++ at :: basic printing
  4093. |_ a=@
  4094. ++ r
  4095. ?: ?& (gte (met 3 a) 2)
  4096. |-
  4097. ?: =(0 a)
  4098. &
  4099. =+ vis=(end 3 a)
  4100. ?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z')))
  4101. $(a (rsh 3 a))
  4102. ==
  4103. ==
  4104. rtam
  4105. ?: (lte (met 3 a) 2)
  4106. rud
  4107. rux
  4108. ::
  4109. ++ rf `tape`[?-(a %& '&', %| '|', * !!) ~]
  4110. ++ rn `tape`[?>(=(0 a) '~') ~]
  4111. ++ rt `tape`['\'' (weld (mesc (trip a)) `tape`['\'' ~])]
  4112. ++ rta rt
  4113. ++ rtam `tape`['%' (trip a)]
  4114. ++ rub `tape`['0' 'b' (rum 2 ~ |=(b=@ (add '0' b)))]
  4115. ++ rud (rum 10 ~ |=(b=@ (add '0' b)))
  4116. ++ rum
  4117. |= [b=@ c=tape d=$-(@ @)]
  4118. ^- tape
  4119. ?: =(0 a)
  4120. [(d 0) c]
  4121. =+ e=0
  4122. |- ^- tape
  4123. ?: =(0 a)
  4124. c
  4125. =+ f=&(!=(0 e) =(0 (mod e ?:(=(10 b) 3 4))))
  4126. %= $
  4127. a (div a b)
  4128. c [(d (mod a b)) ?:(f [?:(=(10 b) ',' '-') c] c)]
  4129. e +(e)
  4130. ==
  4131. ::
  4132. ++ rup
  4133. =+ b=(met 3 a)
  4134. ^- tape
  4135. :- '-'
  4136. |- ^- tape
  4137. ?: (gth (met 5 a) 1)
  4138. %+ weld
  4139. $(a (rsh 5 a), b (sub b 4))
  4140. `tape`['-' '-' $(a (end 5 a), b 4)]
  4141. ?: =(0 b)
  4142. ['~' ~]
  4143. ?: (lte b 1)
  4144. (trip (tos:po a))
  4145. |- ^- tape
  4146. ?: =(2 b)
  4147. =+ c=(rsh 3 a)
  4148. =+ d=(end 3 a)
  4149. (weld (trip (tod:po c)) (trip (tos:po (mix c d))))
  4150. =+ c=(rsh [3 2] a)
  4151. =+ d=(end [3 2] a)
  4152. (weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)])
  4153. ::
  4154. ++ ruv
  4155. ^- tape
  4156. :+ '0'
  4157. 'v'
  4158. %^ rum
  4159. 64
  4160. ~
  4161. |= b=@
  4162. ?: =(63 b)
  4163. '+'
  4164. ?: =(62 b)
  4165. '-'
  4166. ?:((lth b 26) (add 65 b) ?:((lth b 52) (add 71 b) (sub b 4)))
  4167. ::
  4168. ++ rux `tape`['0' 'x' (rum 16 ~ |=(b=@ (add b ?:((lth b 10) 48 87))))]
  4169. --
  4170. ++ cass :: lowercase
  4171. |= vib=tape
  4172. ^- tape
  4173. (turn vib |=(a=@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a))))
  4174. ::
  4175. ++ cuss :: uppercase
  4176. |= vib=tape
  4177. ^- tape
  4178. (turn vib |=(a=@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32))))
  4179. ::
  4180. ++ crip |=(a=tape `@t`(rap 3 a)) :: tape to cord
  4181. ::
  4182. ++ mesc :: ctrl code escape
  4183. |= vib=tape
  4184. ^- tape
  4185. ?~ vib
  4186. ~
  4187. ?: =('\\' i.vib)
  4188. ['\\' '\\' $(vib t.vib)]
  4189. ?: ?|((gth i.vib 126) (lth i.vib 32) =(`@`39 i.vib))
  4190. ['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))]
  4191. [i.vib $(vib t.vib)]
  4192. ::
  4193. ++ runt :: prepend repeatedly
  4194. |= [[a=@ b=@] c=tape]
  4195. ^- tape
  4196. ?: =(0 a)
  4197. c
  4198. [b $(a (dec a))]
  4199. ::
  4200. ++ sand :: atom sanity
  4201. |= a=@ta
  4202. (flit (sane a))
  4203. ::
  4204. ++ sane :: atom sanity
  4205. |= a=@ta
  4206. |= b=@ ^- ?
  4207. ?. =(%t (end 3 a))
  4208. :: XX more and better sanity
  4209. ::
  4210. &
  4211. =+ [inx=0 len=(met 3 b)]
  4212. ?: =(%tas a)
  4213. |- ^- ?
  4214. ?: =(inx len) &
  4215. =+ cur=(cut 3 [inx 1] b)
  4216. ?& ?| &((gte cur 'a') (lte cur 'z'))
  4217. &(=('-' cur) !=(0 inx) !=(len inx))
  4218. &(&((gte cur '0') (lte cur '9')) !=(0 inx))
  4219. ==
  4220. $(inx +(inx))
  4221. ==
  4222. ?: =(%ta a)
  4223. |- ^- ?
  4224. ?: =(inx len) &
  4225. =+ cur=(cut 3 [inx 1] b)
  4226. ?& ?| &((gte cur 'a') (lte cur 'z'))
  4227. &((gte cur '0') (lte cur '9'))
  4228. |(=('-' cur) =('~' cur) =('_' cur) =('.' cur))
  4229. ==
  4230. $(inx +(inx))
  4231. ==
  4232. |- ^- ?
  4233. ?: =(inx len) &
  4234. =+ cur=(cut 3 [inx 1] b)
  4235. ?: &((lth cur 32) !=(10 cur)) |
  4236. =+ tef=(teff cur)
  4237. ?& ?| =(1 tef)
  4238. =+ i=1
  4239. |- ^- ?
  4240. ?| =(i tef)
  4241. ?& (gte (cut 3 [(add i inx) 1] b) 128)
  4242. $(i +(i))
  4243. == == ==
  4244. $(inx (add inx tef))
  4245. ==
  4246. ::
  4247. ++ ruth :: biblical sanity
  4248. |= [a=@ta b=*]
  4249. ^- @
  4250. ?^ b !!
  4251. :: ?. ((sane a) b) !!
  4252. b
  4253. ::
  4254. ++ trim :: tape split
  4255. |= [a=@ b=tape]
  4256. ^- [p=tape q=tape]
  4257. ?~ b
  4258. [~ ~]
  4259. ?: =(0 a)
  4260. [~ b]
  4261. =+ c=$(a (dec a), b t.b)
  4262. [[i.b p.c] q.c]
  4263. ::
  4264. ++ trip :: cord to tape
  4265. ~/ %trip
  4266. |= a=@ ^- tape
  4267. ?: =(0 (met 3 a))
  4268. ~
  4269. [^-(@ta (end 3 a)) $(a (rsh 3 a))]
  4270. ::
  4271. ++ teff :: length utf8
  4272. |= a=@t ^- @
  4273. =+ b=(end 3 a)
  4274. ?: =(0 b)
  4275. ?>(=(`@`0 a) 0)
  4276. ?> |((gte b 32) =(10 b))
  4277. ?:((lte b 127) 1 ?:((lte b 223) 2 ?:((lte b 239) 3 4)))
  4278. ::
  4279. ++ taft :: utf8 to utf32
  4280. |= a=@t
  4281. ^- @c
  4282. %+ rap 5
  4283. |- ^- (list @c)
  4284. =+ b=(teff a)
  4285. ?: =(0 b) ~
  4286. =+ ^= c
  4287. %+ can 0
  4288. %+ turn
  4289. ^- (list [p=@ q=@])
  4290. ?+ b !!
  4291. %1 [[0 7] ~]
  4292. %2 [[8 6] [0 5] ~]
  4293. %3 [[16 6] [8 6] [0 4] ~]
  4294. %4 [[24 6] [16 6] [8 6] [0 3] ~]
  4295. ==
  4296. |=([p=@ q=@] [q (cut 0 [p q] a)])
  4297. ?> =((tuft c) (end [3 b] a))
  4298. [c $(a (rsh [3 b] a))]
  4299. ::
  4300. ++ tuba :: utf8 to utf32 tape
  4301. |= a=tape
  4302. ^- (list @c)
  4303. (rip 5 (taft (rap 3 a))) :: XX horrible
  4304. ::
  4305. ++ tufa :: utf32 to utf8 tape
  4306. |= a=(list @c)
  4307. ^- tape
  4308. ?~ a ""
  4309. (weld (rip 3 (tuft i.a)) $(a t.a))
  4310. ::
  4311. ++ tuft :: utf32 to utf8 text
  4312. |= a=@c
  4313. ^- @t
  4314. %+ rap 3
  4315. |- ^- (list @)
  4316. ?: =(`@`0 a)
  4317. ~
  4318. =+ b=(end 5 a)
  4319. =+ c=$(a (rsh 5 a))
  4320. ?: (lte b 0x7f)
  4321. [b c]
  4322. ?: (lte b 0x7ff)
  4323. :* (mix 0b1100.0000 (cut 0 [6 5] b))
  4324. (mix 0b1000.0000 (end [0 6] b))
  4325. c
  4326. ==
  4327. ?: (lte b 0xffff)
  4328. :* (mix 0b1110.0000 (cut 0 [12 4] b))
  4329. (mix 0b1000.0000 (cut 0 [6 6] b))
  4330. (mix 0b1000.0000 (end [0 6] b))
  4331. c
  4332. ==
  4333. :* (mix 0b1111.0000 (cut 0 [18 3] b))
  4334. (mix 0b1000.0000 (cut 0 [12 6] b))
  4335. (mix 0b1000.0000 (cut 0 [6 6] b))
  4336. (mix 0b1000.0000 (end [0 6] b))
  4337. c
  4338. ==
  4339. ::
  4340. ++ wack :: knot escape
  4341. |= a=@ta
  4342. ^- @ta
  4343. =+ b=(rip 3 a)
  4344. %+ rap 3
  4345. |- ^- tape
  4346. ?~ b
  4347. ~
  4348. ?: =('~' i.b) ['~' '~' $(b t.b)]
  4349. ?: =('_' i.b) ['~' '-' $(b t.b)]
  4350. [i.b $(b t.b)]
  4351. ::
  4352. ++ wick :: knot unescape
  4353. |= a=@
  4354. ^- (unit @ta)
  4355. =+ b=(rip 3 a)
  4356. =- ?^(b ~ (some (rap 3 (flop c))))
  4357. =| c=tape
  4358. |- ^- [b=tape c=tape]
  4359. ?~ b [~ c]
  4360. ?. =('~' i.b)
  4361. $(b t.b, c [i.b c])
  4362. ?~ t.b [b ~]
  4363. ?- i.t.b
  4364. %'~' $(b t.t.b, c ['~' c])
  4365. %'-' $(b t.t.b, c ['_' c])
  4366. @ [b ~]
  4367. ==
  4368. ::
  4369. ++ woad :: cord unescape
  4370. |= a=@ta
  4371. ^- @t
  4372. %+ rap 3
  4373. |- ^- (list @)
  4374. ?: =(`@`0 a)
  4375. ~
  4376. =+ b=(end 3 a)
  4377. =+ c=(rsh 3 a)
  4378. ?: =('.' b)
  4379. [' ' $(a c)]
  4380. ?. =('~' b)
  4381. [b $(a c)]
  4382. => .(b (end 3 c), c (rsh 3 c))
  4383. ?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d))
  4384. ^= d
  4385. =+ d=0
  4386. |- ^- [p=@ q=@]
  4387. ?: =('.' b)
  4388. [d c]
  4389. ?< =(0 c)
  4390. %= $
  4391. b (end 3 c)
  4392. c (rsh 3 c)
  4393. d %+ add (mul 16 d)
  4394. %+ sub b
  4395. ?: &((gte b '0') (lte b '9')) 48
  4396. ?>(&((gte b 'a') (lte b 'z')) 87)
  4397. ==
  4398. %'.' ['.' $(a c)]
  4399. %'~' ['~' $(a c)]
  4400. ==
  4401. ::
  4402. ++ wood :: cord escape
  4403. |= a=@t
  4404. ^- @ta
  4405. %+ rap 3
  4406. |- ^- (list @)
  4407. ?: =(`@`0 a)
  4408. ~
  4409. =+ b=(teff a)
  4410. =+ c=(taft (end [3 b] a))
  4411. =+ d=$(a (rsh [3 b] a))
  4412. ?: ?| &((gte c 'a') (lte c 'z'))
  4413. &((gte c '0') (lte c '9'))
  4414. =(`@`'-' c)
  4415. ==
  4416. [c d]
  4417. ?+ c
  4418. :- '~'
  4419. =+ e=(met 2 c)
  4420. |- ^- tape
  4421. ?: =(0 e)
  4422. ['.' d]
  4423. =. e (dec e)
  4424. =+ f=(rsh [2 e] c)
  4425. [(add ?:((lte f 9) 48 87) f) $(c (end [2 e] c))]
  4426. ::
  4427. %' ' ['.' d]
  4428. %'.' ['~' '.' d]
  4429. %'~' ['~' '~' d]
  4430. ==
  4431. ::
  4432. :: 4c: tank printer
  4433. +| %tank-printer
  4434. ::
  4435. ++ wash :: render tank at width
  4436. |= [[tab=@ edg=@] tac=tank] ^- wall
  4437. (~(win re tac) tab edg)
  4438. ::
  4439. :: +re: tank renderer
  4440. ::
  4441. ++ re
  4442. |_ tac=tank
  4443. :: +ram: render a tank to one line (flat)
  4444. ::
  4445. ++ ram
  4446. ^- tape
  4447. ?@ tac
  4448. (trip tac)
  4449. ?- -.tac
  4450. %leaf p.tac
  4451. ::
  4452. :: flat %palm rendered as %rose with welded openers
  4453. ::
  4454. %palm
  4455. =* mid p.p.tac
  4456. =* for (weld q.p.tac r.p.tac)
  4457. =* end s.p.tac
  4458. ram(tac [%rose [mid for end] q.tac])
  4459. ::
  4460. :: flat %rose rendered with open/mid/close
  4461. ::
  4462. %rose
  4463. =* mid p.p.tac
  4464. =* for q.p.tac
  4465. =* end r.p.tac
  4466. =* lit q.tac
  4467. %+ weld
  4468. for
  4469. |- ^- tape
  4470. ?~ lit
  4471. end
  4472. %+ weld
  4473. ram(tac i.lit)
  4474. =* voz $(lit t.lit)
  4475. ?~(t.lit voz (weld mid voz))
  4476. ==
  4477. :: +win: render a tank to multiple lines (tall)
  4478. ::
  4479. :: indented by .tab, soft-wrapped at .edg
  4480. ::
  4481. ++ win
  4482. |= [tab=@ud edg=@ud]
  4483. :: output stack
  4484. ::
  4485. =| lug=wall
  4486. |^ ^- wall
  4487. ?@ tac
  4488. (rig (trip tac))
  4489. ?- -.tac
  4490. %leaf (rig p.tac)
  4491. ::
  4492. %palm
  4493. =/ hom ram
  4494. ?: (lte (lent hom) (sub edg tab))
  4495. (rig hom)
  4496. ::
  4497. =* for q.p.tac
  4498. =* lit q.tac
  4499. ?~ lit
  4500. (rig for)
  4501. ?~ t.lit
  4502. =: tab (add 2 tab)
  4503. lug $(tac i.lit)
  4504. ==
  4505. (rig for)
  4506. ::
  4507. => .(lit `(list tank)`lit)
  4508. =/ lyn (mul 2 (lent lit))
  4509. =. lug
  4510. |- ^- wall
  4511. ?~ lit
  4512. lug
  4513. =/ nyl (sub lyn 2)
  4514. %= ^$
  4515. tac i.lit
  4516. tab (add tab nyl)
  4517. lug $(lit t.lit, lyn nyl)
  4518. ==
  4519. (wig for)
  4520. ::
  4521. %rose
  4522. =/ hom ram
  4523. ?: (lte (lent hom) (sub edg tab))
  4524. (rig hom)
  4525. ::
  4526. =* for q.p.tac
  4527. =* end r.p.tac
  4528. =* lit q.tac
  4529. =. lug
  4530. |- ^- wall
  4531. ?~ lit
  4532. ?~(end lug (rig end))
  4533. %= ^$
  4534. tac i.lit
  4535. tab (mod (add 2 tab) (mul 2 (div edg 3)))
  4536. lug $(lit t.lit)
  4537. ==
  4538. ?~(for lug (wig for))
  4539. ==
  4540. :: +rig: indent tape and cons with output stack
  4541. ::
  4542. ++ rig
  4543. |= hom=tape
  4544. ^- wall
  4545. [(runt [tab ' '] hom) lug]
  4546. :: +wig: indent tape and cons with output stack
  4547. ::
  4548. :: joined with the top line if whitespace/indentation allow
  4549. ::
  4550. ++ wig
  4551. |= hom=tape
  4552. ^- wall
  4553. ?~ lug
  4554. (rig hom)
  4555. =/ wug :(add 1 tab (lent hom))
  4556. ?. =+ mir=i.lug
  4557. |- ^- ?
  4558. ?~ mir |
  4559. ?| =(0 wug)
  4560. ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug)))
  4561. ==
  4562. (rig hom) :: ^ XX regular form?
  4563. :_ t.lug
  4564. %+ runt [tab ' ']
  4565. (weld hom `tape`[' ' (slag wug i.lug)])
  4566. --
  4567. --
  4568. ++ show :: XX deprecated!
  4569. |= vem=*
  4570. |^ ^- tank
  4571. ?: ?=(@ vem)
  4572. [%leaf (mesc (trip vem))]
  4573. ?- vem
  4574. [s=~ c=*]
  4575. [%leaf '\'' (weld (mesc (tape +.vem)) `tape`['\'' ~])]
  4576. ::
  4577. [s=%a c=@] [%leaf (mesc (trip c.vem))]
  4578. [s=%b c=*] (shop c.vem |=(a=@ ~(rub at a)))
  4579. [s=[%c p=@] c=*]
  4580. :+ %palm
  4581. [['.' ~] ['-' ~] ~ ~]
  4582. [[%leaf (mesc (trip p.s.vem))] $(vem c.vem) ~]
  4583. ::
  4584. [s=%d c=*] (shop c.vem |=(a=@ ~(rud at a)))
  4585. [s=%k c=*] (tank c.vem)
  4586. [s=%h c=*]
  4587. :+ %rose
  4588. [['/' ~] ['/' ~] ~]
  4589. =+ yol=((list @ta) c.vem)
  4590. (turn yol |=(a=@ta [%leaf (trip a)]))
  4591. ::
  4592. [s=%l c=*] (shol c.vem)
  4593. [s=%o c=*]
  4594. %= $
  4595. vem
  4596. :- [%m '%h::[%d %d].[%d %d]>']
  4597. [-.c.vem +<-.c.vem +<+.c.vem +>-.c.vem +>+.c.vem ~]
  4598. ==
  4599. ::
  4600. [s=%p c=*] (shop c.vem |=(a=@ ~(rup at a)))
  4601. [s=%q c=*] (shop c.vem |=(a=@ ~(r at a)))
  4602. [s=%r c=*] $(vem [[%r ' ' '{' '}'] c.vem])
  4603. [s=%t c=*] (shop c.vem |=(a=@ ~(rt at a)))
  4604. [s=%v c=*] (shop c.vem |=(a=@ ~(ruv at a)))
  4605. [s=%x c=*] (shop c.vem |=(a=@ ~(rux at a)))
  4606. [s=[%m p=@] c=*] (shep p.s.vem c.vem)
  4607. [s=[%r p=@] c=*]
  4608. $(vem [[%r ' ' (cut 3 [0 1] p.s.vem) (cut 3 [1 1] p.s.vem)] c.vem])
  4609. ::
  4610. [s=[%r p=@ q=@ r=@] c=*]
  4611. :+ %rose
  4612. :* p=(mesc (trip p.s.vem))
  4613. q=(mesc (trip q.s.vem))
  4614. r=(mesc (trip r.s.vem))
  4615. ==
  4616. |- ^- (list tank)
  4617. ?@ c.vem
  4618. ~
  4619. [^$(vem -.c.vem) $(c.vem +.c.vem)]
  4620. ::
  4621. [s=%z c=*] $(vem [[%r %$ %$ %$] c.vem])
  4622. * !!
  4623. ==
  4624. ++ shep
  4625. |= [fom=@ gar=*]
  4626. ^- tank
  4627. =+ l=(met 3 fom)
  4628. =+ i=0
  4629. :- %leaf
  4630. |- ^- tape
  4631. ?: (gte i l)
  4632. ~
  4633. =+ c=(cut 3 [i 1] fom)
  4634. ?. =(37 c)
  4635. (weld (mesc [c ~]) $(i +(i)))
  4636. =+ d=(cut 3 [+(i) 1] fom)
  4637. ?. .?(gar)
  4638. ['\\' '#' $(i (add 2 i))]
  4639. (weld ~(ram re (show d -.gar)) $(i (add 2 i), gar +.gar))
  4640. ::
  4641. ++ shop
  4642. |= [aug=* vel=$-(a=@ tape)]
  4643. ^- tank
  4644. ?: ?=(@ aug)
  4645. [%leaf (vel aug)]
  4646. :+ %rose
  4647. [[' ' ~] ['[' ~] [']' ~]]
  4648. => .(aug `*`aug)
  4649. |- ^- (list tank)
  4650. ?: ?=(@ aug)
  4651. [^$ ~]
  4652. [^$(aug -.aug) $(aug +.aug)]
  4653. ::
  4654. ++ shol
  4655. |= lim=*
  4656. :+ %rose
  4657. [['.' ~] ~ ~]
  4658. |- ^- (list tank)
  4659. ?: ?=(@ lim) ~
  4660. :_ $(lim +.lim)
  4661. ?+ -.lim (show '#')
  4662. ~ (show '$')
  4663. c=@ (show c.lim)
  4664. [%& %1] (show '.')
  4665. [%& c=@]
  4666. [%leaf '+' ~(rud at c.lim)]
  4667. ::
  4668. [%| @ ~] (show ',')
  4669. [%| n=@ ~ c=@]
  4670. [%leaf (weld (reap n.lim '^') ?~(c.lim "$" (trip c.lim)))]
  4671. ==
  4672. --
  4673. ::
  4674. :: 4d: parsing (tracing)
  4675. +| %parsing-tracing
  4676. ::
  4677. ++ last |= [zyc=hair naz=hair] :: farther trace
  4678. ^- hair
  4679. ?: =(p.zyc p.naz)
  4680. ?:((gth q.zyc q.naz) zyc naz)
  4681. ?:((gth p.zyc p.naz) zyc naz)
  4682. ::
  4683. ++ lust |= [weq=char naz=hair] :: detect newline
  4684. ^- hair
  4685. ?:(=(`@`10 weq) [+(p.naz) 1] [p.naz +(q.naz)])
  4686. ::
  4687. :: 4e: parsing (combinators)
  4688. +| %parsing-combinators
  4689. ::
  4690. ++ bend :: conditional comp
  4691. ~/ %bend
  4692. |* raq=_|*([a=* b=*] [~ u=[a b]])
  4693. ~/ %fun
  4694. |* [vex=edge sab=rule]
  4695. ?~ q.vex
  4696. vex
  4697. =+ yit=(sab q.u.q.vex)
  4698. =+ yur=(last p.vex p.yit)
  4699. ?~ q.yit
  4700. [p=yur q=q.vex]
  4701. =+ vux=(raq p.u.q.vex p.u.q.yit)
  4702. ?~ vux
  4703. [p=yur q=q.vex]
  4704. [p=yur q=[~ u=[p=u.vux q=q.u.q.yit]]]
  4705. ::
  4706. ++ comp
  4707. ~/ %comp
  4708. |* raq=_|*([a=* b=*] [a b]) :: arbitrary compose
  4709. ~/ %fun
  4710. |* [vex=edge sab=rule]
  4711. ~! +<
  4712. ?~ q.vex
  4713. vex
  4714. =+ yit=(sab q.u.q.vex)
  4715. =+ yur=(last p.vex p.yit)
  4716. ?~ q.yit
  4717. [p=yur q=q.yit]
  4718. [p=yur q=[~ u=[p=(raq p.u.q.vex p.u.q.yit) q=q.u.q.yit]]]
  4719. ::
  4720. ++ fail |=(tub=nail [p=p.tub q=~]) :: never parse
  4721. ++ glue :: add rule
  4722. ~/ %glue
  4723. |* bus=rule
  4724. ~/ %fun
  4725. |* [vex=edge sab=rule]
  4726. (plug vex ;~(pfix bus sab))
  4727. ::
  4728. ++ less :: no first and second
  4729. |* [vex=edge sab=rule]
  4730. ?~ q.vex
  4731. =+ roq=(sab)
  4732. [p=(last p.vex p.roq) q=q.roq]
  4733. (fail +<.sab)
  4734. ::
  4735. ++ pfix :: discard first rule
  4736. ~/ %pfix
  4737. |* sam=[vex=edge sab=rule]
  4738. %. sam
  4739. (comp |*([a=* b=*] b))
  4740. ::
  4741. ++ plug :: first then second
  4742. ~/ %plug
  4743. |* [vex=edge sab=rule]
  4744. ?~ q.vex
  4745. vex
  4746. =+ yit=(sab q.u.q.vex)
  4747. =+ yur=(last p.vex p.yit)
  4748. ?~ q.yit
  4749. [p=yur q=q.yit]
  4750. [p=yur q=[~ u=[p=[p.u.q.vex p.u.q.yit] q=q.u.q.yit]]]
  4751. ::
  4752. ++ pose :: first or second
  4753. ~/ %pose
  4754. |* [vex=edge sab=rule]
  4755. ?~ q.vex
  4756. =+ roq=(sab)
  4757. [p=(last p.vex p.roq) q=q.roq]
  4758. vex
  4759. ::
  4760. ++ simu :: first and second
  4761. |* [vex=edge sab=rule]
  4762. ?~ q.vex
  4763. vex
  4764. =+ roq=(sab)
  4765. roq
  4766. ::
  4767. ++ sfix :: discard second rule
  4768. ~/ %sfix
  4769. |* sam=[vex=edge sab=rule]
  4770. %. sam
  4771. (comp |*([a=* b=*] a))
  4772. ::
  4773. :: 4f: parsing (rule builders)
  4774. +| %parsing-rule-builders
  4775. ::
  4776. ++ bass :: leftmost base
  4777. |* [wuc=@ tyd=rule]
  4778. %+ cook
  4779. |= waq=(list @)
  4780. %+ roll
  4781. waq
  4782. =|([p=@ q=@] |.((add p (mul wuc q))))
  4783. tyd
  4784. ::
  4785. ++ boss :: rightmost base
  4786. |* [wuc=@ tyd=rule]
  4787. %+ cook
  4788. |= waq=(list @)
  4789. %+ reel
  4790. waq
  4791. =|([p=@ q=@] |.((add p (mul wuc q))))
  4792. tyd
  4793. ::
  4794. ++ cold :: replace w+ constant
  4795. ~/ %cold
  4796. |* [cus=* sef=rule]
  4797. ~/ %fun
  4798. |= tub=nail
  4799. =+ vex=(sef tub)
  4800. ?~ q.vex
  4801. vex
  4802. [p=p.vex q=[~ u=[p=cus q=q.u.q.vex]]]
  4803. ::
  4804. ++ cook :: apply gate
  4805. ~/ %cook
  4806. |* [poq=gate sef=rule]
  4807. ~/ %fun
  4808. |= tub=nail
  4809. =+ vex=(sef tub)
  4810. ?~ q.vex
  4811. vex
  4812. [p=p.vex q=[~ u=[p=(poq p.u.q.vex) q=q.u.q.vex]]]
  4813. ::
  4814. ++ easy :: always parse
  4815. ~/ %easy
  4816. |* huf=*
  4817. ~/ %fun
  4818. |= tub=nail
  4819. ^- (like _huf)
  4820. [p=p.tub q=[~ u=[p=huf q=tub]]]
  4821. ::
  4822. ++ fuss
  4823. |= [sic=@t non=@t]
  4824. ;~(pose (cold %& (jest sic)) (cold %| (jest non)))
  4825. ::
  4826. ++ full :: has to fully parse
  4827. |* sef=rule
  4828. |= tub=nail
  4829. =+ vex=(sef tub)
  4830. ?~(q.vex vex ?:(=(~ q.q.u.q.vex) vex [p=p.vex q=~]))
  4831. ::
  4832. ++ funk :: add to tape first
  4833. |* [pre=tape sef=rule]
  4834. |= tub=nail
  4835. (sef p.tub (weld pre q.tub))
  4836. ::
  4837. ++ here :: place-based apply
  4838. ~/ %here
  4839. |* [hez=_|=([a=pint b=*] [a b]) sef=rule]
  4840. ~/ %fun
  4841. |= tub=nail
  4842. =+ vex=(sef tub)
  4843. ?~ q.vex
  4844. vex
  4845. [p=p.vex q=[~ u=[p=(hez [p.tub p.q.u.q.vex] p.u.q.vex) q=q.u.q.vex]]]
  4846. ::
  4847. ++ inde |* sef=rule :: indentation block
  4848. |= nail ^+ (sef)
  4849. =+ [har tap]=[p q]:+<
  4850. =+ lev=(fil 3 (dec q.har) ' ')
  4851. =+ eol=(just `@t`10)
  4852. =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
  4853. ;~(simu ;~(plug eol eol) eol)
  4854. ?~ q.roq roq
  4855. =+ vex=(sef har(q 1) p.u.q.roq)
  4856. =+ fur=p.vex(q (add (dec q.har) q.p.vex))
  4857. ?~ q.vex vex(p fur)
  4858. =- vex(p fur, u.q -)
  4859. :+ &3.vex
  4860. &4.vex(q.p (add (dec q.har) q.p.&4.vex))
  4861. =+ res=|4.vex
  4862. |- ?~ res |4.roq
  4863. ?. =(10 -.res) [-.res $(res +.res)]
  4864. (welp [`@t`10 (trip lev)] $(res +.res))
  4865. ::
  4866. ++ ifix
  4867. |* [fel=[rule rule] hof=rule]
  4868. ~! +<
  4869. ~! +<:-.fel
  4870. ~! +<:+.fel
  4871. ;~(pfix -.fel ;~(sfix hof +.fel))
  4872. ::
  4873. ++ jest :: match a cord
  4874. |= daf=@t
  4875. |= tub=nail
  4876. =+ fad=daf
  4877. |- ^- (like @t)
  4878. ?: =(`@`0 daf)
  4879. [p=p.tub q=[~ u=[p=fad q=tub]]]
  4880. ?: |(?=(~ q.tub) !=((end 3 daf) i.q.tub))
  4881. (fail tub)
  4882. $(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 daf))
  4883. ::
  4884. ++ just :: XX redundant, jest
  4885. ~/ %just :: match a char
  4886. |= daf=char
  4887. ~/ %fun
  4888. |= tub=nail
  4889. ^- (like char)
  4890. ?~ q.tub
  4891. (fail tub)
  4892. ?. =(daf i.q.tub)
  4893. (fail tub)
  4894. (next tub)
  4895. ::
  4896. ++ knee :: callbacks
  4897. |* [gar=* sef=_|.(*rule)]
  4898. |= tub=nail
  4899. ^- (like _gar)
  4900. ((sef) tub)
  4901. ::
  4902. ++ mask :: match char in set
  4903. ~/ %mask
  4904. |= bud=(list char)
  4905. ~/ %fun
  4906. |= tub=nail
  4907. ^- (like char)
  4908. ?~ q.tub
  4909. (fail tub)
  4910. ?. (lien bud |=(a=char =(i.q.tub a)))
  4911. (fail tub)
  4912. (next tub)
  4913. ::
  4914. ++ more :: separated, *
  4915. |* [bus=rule fel=rule]
  4916. ;~(pose (most bus fel) (easy ~))
  4917. ::
  4918. ++ most :: separated, +
  4919. |* [bus=rule fel=rule]
  4920. ;~(plug fel (star ;~(pfix bus fel)))
  4921. ::
  4922. ++ next :: consume a char
  4923. |= tub=nail
  4924. ^- (like char)
  4925. ?~ q.tub
  4926. (fail tub)
  4927. =+ zac=(lust i.q.tub p.tub)
  4928. [zac [~ i.q.tub [zac t.q.tub]]]
  4929. ::
  4930. ++ perk :: parse cube fork
  4931. |* a=(pole @tas)
  4932. ?~ a fail
  4933. ;~ pose
  4934. (cold -.a (jest -.a))
  4935. $(a +.a)
  4936. ==
  4937. ::
  4938. ++ pick :: rule for ++each
  4939. |* [a=rule b=rule]
  4940. ;~ pose
  4941. (stag %& a)
  4942. (stag %| b)
  4943. ==
  4944. ++ plus |*(fel=rule ;~(plug fel (star fel))) ::
  4945. ++ punt |*([a=rule] ;~(pose (stag ~ a) (easy ~))) ::
  4946. ++ sear :: conditional cook
  4947. |* [pyq=$-(* (unit)) sef=rule]
  4948. |= tub=nail
  4949. =+ vex=(sef tub)
  4950. ?~ q.vex
  4951. vex
  4952. =+ gey=(pyq p.u.q.vex)
  4953. ?~ gey
  4954. [p=p.vex q=~]
  4955. [p=p.vex q=[~ u=[p=u.gey q=q.u.q.vex]]]
  4956. ::
  4957. ++ shim :: match char in range
  4958. ~/ %shim
  4959. |= [les=@ mos=@]
  4960. ~/ %fun
  4961. |= tub=nail
  4962. ^- (like char)
  4963. ?~ q.tub
  4964. (fail tub)
  4965. ?. ?&((gte i.q.tub les) (lte i.q.tub mos))
  4966. (fail tub)
  4967. (next tub)
  4968. ::
  4969. ++ stag :: add a label
  4970. ~/ %stag
  4971. |* [gob=* sef=rule]
  4972. ~/ %fun
  4973. |= tub=nail
  4974. =+ vex=(sef tub)
  4975. ?~ q.vex
  4976. vex
  4977. [p=p.vex q=[~ u=[p=[gob p.u.q.vex] q=q.u.q.vex]]]
  4978. ::
  4979. ++ stet ::
  4980. |* leh=(list [?(@ [@ @]) rule])
  4981. |-
  4982. ?~ leh
  4983. ~
  4984. [i=[p=-.i.leh q=+.i.leh] t=$(leh t.leh)]
  4985. ::
  4986. ++ stew :: switch by first char
  4987. ~/ %stew
  4988. |* leh=(list [p=?(@ [@ @]) q=rule]) :: char+range keys
  4989. =+ ^= wor :: range complete lth
  4990. |= [ort=?(@ [@ @]) wan=?(@ [@ @])]
  4991. ?@ ort
  4992. ?@(wan (lth ort wan) (lth ort -.wan))
  4993. ?@(wan (lth +.ort wan) (lth +.ort -.wan))
  4994. =+ ^= hel :: build parser map
  4995. =+ hel=`(tree _?>(?=(^ leh) i.leh))`~
  4996. |- ^+ hel
  4997. ?~ leh
  4998. ~
  4999. =+ yal=$(leh t.leh)
  5000. |- ^+ hel
  5001. ?~ yal
  5002. [i.leh ~ ~]
  5003. ?: (wor p.i.leh p.n.yal)
  5004. =+ nuc=$(yal l.yal)
  5005. ?> ?=(^ nuc)
  5006. ?: (mor p.n.yal p.n.nuc)
  5007. [n.yal nuc r.yal]
  5008. [n.nuc l.nuc [n.yal r.nuc r.yal]]
  5009. =+ nuc=$(yal r.yal)
  5010. ?> ?=(^ nuc)
  5011. ?: (mor p.n.yal p.n.nuc)
  5012. [n.yal l.yal nuc]
  5013. [n.nuc [n.yal l.yal l.nuc] r.nuc]
  5014. ~% %fun ..^$ ~
  5015. |= tub=nail
  5016. ?~ q.tub
  5017. (fail tub)
  5018. |-
  5019. ?~ hel
  5020. (fail tub)
  5021. ?: ?@ p.n.hel
  5022. =(p.n.hel i.q.tub)
  5023. ?&((gte i.q.tub -.p.n.hel) (lte i.q.tub +.p.n.hel))
  5024. :: (q.n.hel [(lust i.q.tub p.tub) t.q.tub])
  5025. (q.n.hel tub)
  5026. ?: (wor i.q.tub p.n.hel)
  5027. $(hel l.hel)
  5028. $(hel r.hel)
  5029. ::
  5030. ++ slug ::
  5031. |* raq=_=>(~ |*([a=* b=*] [a b]))
  5032. |* [bus=rule fel=rule]
  5033. ;~((comp raq) fel (stir +<+.raq raq ;~(pfix bus fel)))
  5034. ::
  5035. ++ star :: 0 or more times
  5036. |* fel=rule
  5037. (stir `(list _(wonk *fel))`~ |*([a=* b=*] [a b]) fel)
  5038. ::
  5039. ++ stir
  5040. ~/ %stir
  5041. |* [rud=* raq=_=>(~ |*([a=* b=*] [a b])) fel=rule]
  5042. ~/ %fun
  5043. |= tub=nail
  5044. ^- (like _rud)
  5045. ::
  5046. :: lef: successful interim parse results (per .fel)
  5047. :: wag: initial accumulator (.rud in .tub at farthest success)
  5048. ::
  5049. =+ ^= [lef wag]
  5050. =| lef=(list _(fel tub))
  5051. |- ^- [_lef (pair hair [~ u=(pair _rud nail)])]
  5052. =+ vex=(fel tub)
  5053. ?~ q.vex
  5054. :- lef
  5055. [p.vex [~ rud tub]]
  5056. $(lef [vex lef], tub q.u.q.vex)
  5057. ::
  5058. :: fold .lef into .wag, combining results with .raq
  5059. ::
  5060. %+ roll lef
  5061. |= _[vex=(fel tub) wag=wag] :: q.vex is always (some)
  5062. ^+ wag
  5063. :- (last p.vex p.wag)
  5064. [~ (raq p.u.+.q.vex p.u.q.wag) q.u.q.wag]
  5065. ::
  5066. ++ stun :: parse several times
  5067. ~/ %stun
  5068. |* [lig=[@ @] fel=rule]
  5069. |= tub=nail
  5070. ^- (like (list _(wonk (fel))))
  5071. ?: =(0 +.lig)
  5072. [p.tub [~ ~ tub]]
  5073. =+ vex=(fel tub)
  5074. ?~ q.vex
  5075. ?: =(0 -.lig)
  5076. [p.vex [~ ~ tub]]
  5077. vex
  5078. =+ ^= wag %= $
  5079. -.lig ?:(=(0 -.lig) 0 (dec -.lig))
  5080. +.lig ?:(=(0 +.lig) 0 (dec +.lig))
  5081. tub q.u.q.vex
  5082. ==
  5083. ?~ q.wag
  5084. wag
  5085. [p.wag [~ [p.u.q.vex p.u.q.wag] q.u.q.wag]]
  5086. ::
  5087. :: 4g: parsing (outside caller)
  5088. +| %parsing-outside-caller
  5089. ::
  5090. ++ rash |*([naf=@ sab=rule] (scan (trip naf) sab))
  5091. ++ rose |* [los=tape sab=rule]
  5092. =+ vex=(sab [[1 1] los])
  5093. =+ len=(lent los)
  5094. ?. =(+(len) q.p.vex) [%| p=(dec q.p.vex)]
  5095. ?~ q.vex
  5096. [%& p=~]
  5097. [%& p=[~ u=p.u.q.vex]]
  5098. ++ rush |*([naf=@ sab=rule] (rust (trip naf) sab))
  5099. ++ rust |* [los=tape sab=rule]
  5100. =+ vex=((full sab) [[1 1] los])
  5101. ?~(q.vex ~ [~ u=p.u.q.vex])
  5102. ++ scan |* [los=tape sab=rule]
  5103. =+ vex=((full sab) [[1 1] los])
  5104. ?~ q.vex
  5105. ~_ (show [%m '{%d %d}'] p.p.vex q.p.vex ~)
  5106. ~_(leaf+"syntax error" !!)
  5107. p.u.q.vex
  5108. ::
  5109. :: 4h: parsing (ascii glyphs)
  5110. +| %parsing-ascii-glyphs
  5111. ::
  5112. ++ ace (just ' ') :: spACE
  5113. ++ bar (just '|') :: vertical BAR
  5114. ++ bas (just '\\') :: Back Slash (escaped)
  5115. ++ buc (just '$') :: dollars BUCks
  5116. ++ cab (just '_') :: CABoose
  5117. ++ cen (just '%') :: perCENt
  5118. ++ col (just ':') :: COLon
  5119. ++ com (just ',') :: COMma
  5120. ++ doq (just '"') :: Double Quote
  5121. ++ dot (just '.') :: dot dot dot ...
  5122. ++ fas (just '/') :: Forward Slash
  5123. ++ gal (just '<') :: Greater Left
  5124. ++ gar (just '>') :: Greater Right
  5125. ++ hax (just '#') :: Hash
  5126. ++ hep (just '-') :: HyPhen
  5127. ++ kel (just '{') :: Curly Left
  5128. ++ ker (just '}') :: Curly Right
  5129. ++ ket (just '^') :: CareT
  5130. ++ lus (just '+') :: pLUS
  5131. ++ mic (just ';') :: seMIColon
  5132. ++ pal (just '(') :: Paren Left
  5133. ++ pam (just '&') :: AMPersand pampersand
  5134. ++ par (just ')') :: Paren Right
  5135. ++ pat (just '@') :: AT pat
  5136. ++ sel (just '[') :: Square Left
  5137. ++ ser (just ']') :: Square Right
  5138. ++ sig (just '~') :: SIGnature squiggle
  5139. ++ soq (just '\'') :: Single Quote
  5140. ++ tar (just '*') :: sTAR
  5141. ++ tic (just '`') :: backTiCk
  5142. ++ tis (just '=') :: 'tis tis, it is
  5143. ++ wut (just '?') :: wut, what?
  5144. ++ zap (just '!') :: zap! bang! crash!!
  5145. ::
  5146. :: 4i: parsing (useful idioms)
  5147. +| %parsing-useful-idioms
  5148. ::
  5149. ++ alf ;~(pose low hig) :: alphabetic
  5150. ++ aln ;~(pose low hig nud) :: alphanumeric
  5151. ++ alp ;~(pose low hig nud hep) :: alphanumeric and -
  5152. ++ bet ;~(pose (cold 2 hep) (cold 3 lus)) :: axis syntax - +
  5153. ++ bin (bass 2 (most gon but)) :: binary to atom
  5154. ++ but (cook |=(a=@ (sub a '0')) (shim '0' '1')) :: binary digit
  5155. ++ cit (cook |=(a=@ (sub a '0')) (shim '0' '7')) :: octal digit
  5156. ++ dem (bass 10 (most gon dit)) :: decimal to atom
  5157. ++ dit (cook |=(a=@ (sub a '0')) (shim '0' '9')) :: decimal digit
  5158. ++ dog ;~(plug dot gay) :: . number separator
  5159. ++ dof ;~(plug hep gay) :: - @q separator
  5160. ++ doh ;~(plug ;~(plug hep hep) gay) :: -- phon separator
  5161. ++ dun (cold ~ ;~(plug hep hep)) :: -- (stop) to ~
  5162. ++ duz (cold ~ ;~(plug tis tis)) :: == (stet) to ~
  5163. ++ gah (mask [`@`10 ' ' ~]) :: newline or ace
  5164. ++ gap (cold ~ ;~(plug gaq (star ;~(pose vul gah)))) :: plural space
  5165. ++ gaq ;~ pose :: end of line
  5166. (just `@`10)
  5167. ;~(plug gah ;~(pose gah vul))
  5168. vul
  5169. ==
  5170. ++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white
  5171. ++ gay ;~(pose gap (easy ~)) ::
  5172. ++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ /
  5173. ++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < >
  5174. ++ hex (bass 16 (most gon hit)) :: hex to atom
  5175. ++ hig (shim 'A' 'Z') :: uppercase
  5176. ++ hit ;~ pose :: hex digits
  5177. dit
  5178. (cook |=(a=char (sub a 87)) (shim 'a' 'f'))
  5179. (cook |=(a=char (sub a 55)) (shim 'A' 'F'))
  5180. ==
  5181. ++ iny :: indentation block
  5182. |* sef=rule
  5183. |= nail ^+ (sef)
  5184. =+ [har tap]=[p q]:+<
  5185. =+ lev=(fil 3 (dec q.har) ' ')
  5186. =+ eol=(just `@t`10)
  5187. =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
  5188. ;~(simu ;~(plug eol eol) eol)
  5189. ?~ q.roq roq
  5190. =+ vex=(sef har(q 1) p.u.q.roq)
  5191. =+ fur=p.vex(q (add (dec q.har) q.p.vex))
  5192. ?~ q.vex vex(p fur)
  5193. =- vex(p fur, u.q -)
  5194. :+ &3.vex
  5195. &4.vex(q.p (add (dec q.har) q.p.&4.vex))
  5196. =+ res=|4.vex
  5197. |- ?~ res |4.roq
  5198. ?. =(10 -.res) [-.res $(res +.res)]
  5199. (welp [`@t`10 (trip lev)] $(res +.res))
  5200. ::
  5201. ++ low (shim 'a' 'z') :: lowercase
  5202. ++ mes %+ cook :: hexbyte
  5203. |=([a=@ b=@] (add (mul 16 a) b))
  5204. ;~(plug hit hit)
  5205. ++ nix (boss 256 (star ;~(pose aln cab))) ::
  5206. ++ nud (shim '0' '9') :: numeric
  5207. ++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control
  5208. ++ qat ;~ pose :: chars in blockcord
  5209. prn
  5210. ;~(less ;~(plug (just `@`10) soz) (just `@`10))
  5211. ==
  5212. ++ qit ;~ pose :: chars in a cord
  5213. ;~(less bas soq prn)
  5214. ;~(pfix bas ;~(pose bas soq mes)) :: escape chars
  5215. ==
  5216. ++ qut ;~ simu soq :: cord
  5217. ;~ pose
  5218. ;~ less soz
  5219. (ifix [soq soq] (boss 256 (more gon qit)))
  5220. ==
  5221. =+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a'))
  5222. %- iny %+ ifix
  5223. :- ;~(plug soz hed)
  5224. ;~(plug (just '\0a') soz)
  5225. (boss 256 (star qat))
  5226. ==
  5227. ==
  5228. ++ soz ;~(plug soq soq soq) :: delimiting '''
  5229. ++ sym :: symbol
  5230. %+ cook
  5231. |=(a=tape (rap 3 ^-((list @) a)))
  5232. ;~(plug low (star ;~(pose nud low hep)))
  5233. ::
  5234. ++ mixed-case-symbol
  5235. %+ cook
  5236. |=(a=tape (rap 3 ^-((list @) a)))
  5237. ;~(plug alf (star alp))
  5238. ::
  5239. ++ ven ;~ (comp |=([a=@ b=@] (peg a b))) :: +>- axis syntax
  5240. bet
  5241. =+ hom=`?`|
  5242. |= tub=nail
  5243. ^- (like @)
  5244. =+ vex=?:(hom (bet tub) (gul tub))
  5245. ?~ q.vex
  5246. [p.tub [~ 1 tub]]
  5247. =+ wag=$(p.tub p.vex, hom !hom, tub q.u.q.vex)
  5248. ?> ?=(^ q.wag)
  5249. [p.wag [~ (peg p.u.q.vex p.u.q.wag) q.u.q.wag]]
  5250. ==
  5251. ++ vit :: base64 digit
  5252. ;~ pose
  5253. (cook |=(a=@ (sub a 65)) (shim 'A' 'Z'))
  5254. (cook |=(a=@ (sub a 71)) (shim 'a' 'z'))
  5255. (cook |=(a=@ (add a 4)) (shim '0' '9'))
  5256. (cold 62 (just '-'))
  5257. (cold 63 (just '+'))
  5258. ==
  5259. ++ vul %+ cold ~ :: comments
  5260. ;~ plug col col
  5261. (star prn)
  5262. (just `@`10)
  5263. ==
  5264. ::
  5265. :: 4j: parsing (bases and base digits)
  5266. +| %parsing-bases-and-base-digits
  5267. ::
  5268. ++ ab
  5269. |%
  5270. ++ bix (bass 16 (stun [2 2] six))
  5271. ++ fem (sear |=(a=@ (cha:fa a)) aln)
  5272. ++ haf (bass 256 ;~(plug tep tiq (easy ~)))
  5273. ++ hef %+ sear |=(a=@ ?:(=(a 0) ~ (some a)))
  5274. %+ bass 256
  5275. ;~(plug tip tiq (easy ~))
  5276. ++ hif (bass 256 ;~(plug tip tiq (easy ~)))
  5277. ++ hof (bass 0x1.0000 ;~(plug hef (stun [1 3] ;~(pfix hep hif))))
  5278. ++ huf (bass 0x1.0000 ;~(plug hef (stun [0 3] ;~(pfix hep hif))))
  5279. ++ hyf (bass 0x1.0000 ;~(plug hif (stun [3 3] ;~(pfix hep hif))))
  5280. ++ pev (bass 32 ;~(plug sev (stun [0 4] siv)))
  5281. ++ pew (bass 64 ;~(plug sew (stun [0 4] siw)))
  5282. ++ piv (bass 32 (stun [5 5] siv))
  5283. ++ piw (bass 64 (stun [5 5] siw))
  5284. ++ qeb (bass 2 ;~(plug seb (stun [0 3] sib)))
  5285. ++ qex (bass 16 ;~(plug sex (stun [0 3] hit)))
  5286. ++ qib (bass 2 (stun [4 4] sib))
  5287. ++ qix (bass 16 (stun [4 4] six))
  5288. ++ seb (cold 1 (just '1'))
  5289. ++ sed (cook |=(a=@ (sub a '0')) (shim '1' '9'))
  5290. ++ sev ;~(pose sed sov)
  5291. ++ sew ;~(pose sed sow)
  5292. ++ sex ;~(pose sed sox)
  5293. ++ sib (cook |=(a=@ (sub a '0')) (shim '0' '1'))
  5294. ++ sid (cook |=(a=@ (sub a '0')) (shim '0' '9'))
  5295. ++ siv ;~(pose sid sov)
  5296. ++ siw ;~(pose sid sow)
  5297. ++ six ;~(pose sid sox)
  5298. ++ sov (cook |=(a=@ (sub a 87)) (shim 'a' 'v'))
  5299. ++ sow ;~ pose
  5300. (cook |=(a=@ (sub a 87)) (shim 'a' 'z'))
  5301. (cook |=(a=@ (sub a 29)) (shim 'A' 'Z'))
  5302. (cold 62 (just '-'))
  5303. (cold 63 (just '~'))
  5304. ==
  5305. ++ sox (cook |=(a=@ (sub a 87)) (shim 'a' 'f'))
  5306. ++ ted (bass 10 ;~(plug sed (stun [0 2] sid)))
  5307. ++ tep (sear |=(a=@ ?:(=(a 'doz') ~ (ins:po a))) til)
  5308. ++ tip (sear |=(a=@ (ins:po a)) til)
  5309. ++ tiq (sear |=(a=@ (ind:po a)) til)
  5310. ++ tid (bass 10 (stun [3 3] sid))
  5311. ++ til (boss 256 (stun [3 3] low))
  5312. ++ urs %+ cook
  5313. |=(a=tape (rap 3 ^-((list @) a)))
  5314. (star ;~(pose nud low hep dot sig cab))
  5315. ++ urt %+ cook
  5316. |=(a=tape (rap 3 ^-((list @) a)))
  5317. (star ;~(pose nud low hep dot sig))
  5318. ++ urx %+ cook
  5319. |=(a=tape (rap 3 ^-((list @) a)))
  5320. %- star
  5321. ;~ pose
  5322. nud
  5323. low
  5324. hep
  5325. cab
  5326. (cold ' ' dot)
  5327. (cook tuft (ifix [sig dot] hex))
  5328. ;~(pfix sig ;~(pose sig dot))
  5329. ==
  5330. ++ voy ;~(pfix bas ;~(pose bas soq bix))
  5331. --
  5332. ++ ag
  5333. |%
  5334. ++ ape |*(fel=rule ;~(pose (cold `@`0 (just '0')) fel))
  5335. ++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab)))))
  5336. ++ bip =+ tod=(ape qex:ab)
  5337. (bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod))))
  5338. ++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab)))))
  5339. ++ dim (ape dip)
  5340. ++ dip (bass 10 ;~(plug sed:ab (star sid:ab)))
  5341. ++ dum (bass 10 (plus sid:ab))
  5342. ++ fed %+ cook fynd:ob
  5343. ;~ pose
  5344. %+ bass 0x1.0000.0000.0000.0000 :: oversized
  5345. ;~ plug
  5346. huf:ab
  5347. (plus ;~(pfix doh hyf:ab))
  5348. ==
  5349. hof:ab :: planet or moon
  5350. haf:ab :: star
  5351. tiq:ab :: galaxy
  5352. ==
  5353. ++ feq %+ cook |=(a=(list @) (rep 4 (flop a)))
  5354. ;~ plug
  5355. ;~(pose hif:ab tiq:ab)
  5356. (star ;~(pfix dof hif:ab))
  5357. ==
  5358. ++ fim (sear den:fa (bass 58 (plus fem:ab)))
  5359. ++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab)))))
  5360. ++ lip =+ tod=(ape ted:ab)
  5361. (bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod))))
  5362. ++ mot ;~ pose
  5363. ;~ pfix
  5364. (just '1')
  5365. (cook |=(a=@ (add 10 (sub a '0'))) (shim '0' '2'))
  5366. ==
  5367. sed:ab
  5368. ==
  5369. ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab)))))
  5370. ++ vum (bass 32 (plus siv:ab))
  5371. ++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab)))))
  5372. --
  5373. ++ mu
  5374. |_ [top=@ bot=@]
  5375. ++ zag [p=(end 4 (add top bot)) q=bot]
  5376. ++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot]
  5377. ++ zug (mix (lsh 4 top) bot)
  5378. --
  5379. ++ ne
  5380. |_ tig=@
  5381. ++ c (cut 3 [tig 1] key:fa)
  5382. ++ d (add tig '0')
  5383. ++ x ?:((gte tig 10) (add tig 87) d)
  5384. ++ v ?:((gte tig 10) (add tig 87) d)
  5385. ++ w ?:(=(tig 63) '~' ?:(=(tig 62) '-' ?:((gte tig 36) (add tig 29) x)))
  5386. --
  5387. ::
  5388. :: 4k: atom printing
  5389. +| %atom-printing
  5390. ::
  5391. ++ co
  5392. !:
  5393. ~% %co ..co ~
  5394. =< |_ lot=coin
  5395. ++ rear |=(rom=tape rend(rep rom))
  5396. ++ rent ~+ `@ta`(rap 3 rend)
  5397. ++ rend
  5398. ^- tape
  5399. ~+
  5400. ?: ?=(%blob -.lot)
  5401. ['~' '0' ((v-co 1) (jam p.lot))]
  5402. ?: ?=(%many -.lot)
  5403. :- '.'
  5404. |- ^- tape
  5405. ?~ p.lot
  5406. ['_' '_' rep]
  5407. ['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))]
  5408. =+ [yed=(end 3 p.p.lot) hay=(cut 3 [1 1] p.p.lot)]
  5409. |- ^- tape
  5410. ?+ yed (z-co q.p.lot)
  5411. %c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)]
  5412. %d
  5413. ?+ hay (z-co q.p.lot)
  5414. %a
  5415. =+ yod=(yore q.p.lot)
  5416. =? rep ?=(^ f.t.yod) ['.' (s-co f.t.yod)]
  5417. =? rep !&(?=(~ f) =(0 h) =(0 m) =(0 s)):t.yod
  5418. =. rep ['.' (y-co s.t.yod)]
  5419. =. rep ['.' (y-co m.t.yod)]
  5420. ['.' '.' (y-co h.t.yod)]
  5421. =. rep ['.' (a-co d.t.yod)]
  5422. =. rep ['.' (a-co m.yod)]
  5423. =? rep !a.yod ['-' rep]
  5424. ['~' (a-co y.yod)]
  5425. ::
  5426. %r
  5427. =+ yug=(yell q.p.lot)
  5428. =? rep ?=(^ f.yug) ['.' (s-co f.yug)]
  5429. :- '~'
  5430. ?: &(=(0 d.yug) =(0 m.yug) =(0 h.yug) =(0 s.yug))
  5431. ['s' '0' rep]
  5432. =? rep !=(0 s.yug) ['.' 's' (a-co s.yug)]
  5433. =? rep !=(0 m.yug) ['.' 'm' (a-co m.yug)]
  5434. =? rep !=(0 h.yug) ['.' 'h' (a-co h.yug)]
  5435. =? rep !=(0 d.yug) ['.' 'd' (a-co d.yug)]
  5436. +.rep
  5437. ==
  5438. ::
  5439. %f
  5440. ?: =(& q.p.lot)
  5441. ['.' 'y' rep]
  5442. ?:(=(| q.p.lot) ['.' 'n' rep] (z-co q.p.lot))
  5443. ::
  5444. %n ['~' rep]
  5445. %i
  5446. ?+ hay (z-co q.p.lot)
  5447. %f ((ro-co [3 10 4] |=(a=@ ~(d ne a))) q.p.lot)
  5448. %s ((ro-co [4 16 8] |=(a=@ ~(x ne a))) q.p.lot)
  5449. ==
  5450. ::
  5451. %p
  5452. =+ sxz=(fein:ob q.p.lot)
  5453. =+ dyx=(met 3 sxz)
  5454. :- '~'
  5455. ?: (lte dyx 1)
  5456. (weld (trip (tod:po sxz)) rep)
  5457. =+ dyy=(met 4 sxz)
  5458. =| imp=@ud
  5459. |- ^- tape
  5460. ?: =(imp dyy)
  5461. rep
  5462. %= $
  5463. imp +(imp)
  5464. rep =/ log (cut 4 [imp 1] sxz)
  5465. ;: weld
  5466. (trip (tos:po (rsh 3 log)))
  5467. (trip (tod:po (end 3 log)))
  5468. ?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-")
  5469. rep
  5470. == ==
  5471. ::
  5472. %q
  5473. :+ '.' '~'
  5474. =; res=(pair ? tape)
  5475. (weld q.res rep)
  5476. %+ roll
  5477. =* val q.p.lot
  5478. ?:(=(0 val) ~[0] (rip 3 val))
  5479. |= [q=@ s=? r=tape]
  5480. :- !s
  5481. %+ weld
  5482. (trip (?:(s tod:po tos:po) q))
  5483. ?.(&(s !=(r "")) r ['-' r])
  5484. ::
  5485. %r
  5486. ?+ hay (z-co q.p.lot)
  5487. %d ['.' '~' (r-co (rlyd q.p.lot))]
  5488. %h ['.' '~' '~' (r-co (rlyh q.p.lot))]
  5489. %q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))]
  5490. %s ['.' (r-co (rlys q.p.lot))]
  5491. ==
  5492. ::
  5493. %u
  5494. ?: ?=(%c hay)
  5495. %+ welp ['0' 'c' (reap (pad:fa q.p.lot) '1')]
  5496. (c-co (enc:fa q.p.lot))
  5497. ::
  5498. =; gam=(pair tape tape)
  5499. (weld p.gam ?:(=(0 q.p.lot) `tape`['0' ~] q.gam))
  5500. ?+ hay [~ ((ox-co [10 3] |=(a=@ ~(d ne a))) q.p.lot)]
  5501. %b [['0' 'b' ~] ((ox-co [2 4] |=(a=@ ~(d ne a))) q.p.lot)]
  5502. %i [['0' 'i' ~] ((d-co 1) q.p.lot)]
  5503. %x [['0' 'x' ~] ((ox-co [16 4] |=(a=@ ~(x ne a))) q.p.lot)]
  5504. %v [['0' 'v' ~] ((ox-co [32 5] |=(a=@ ~(x ne a))) q.p.lot)]
  5505. %w [['0' 'w' ~] ((ox-co [64 5] |=(a=@ ~(w ne a))) q.p.lot)]
  5506. ==
  5507. ::
  5508. %s
  5509. %+ weld
  5510. ?:((syn:si q.p.lot) "--" "-")
  5511. $(yed 'u', q.p.lot (abs:si q.p.lot))
  5512. ::
  5513. %t
  5514. ?: =('a' hay)
  5515. ?: =('s' (cut 3 [2 1] p.p.lot))
  5516. (weld (rip 3 q.p.lot) rep)
  5517. ['~' '.' (weld (rip 3 q.p.lot) rep)]
  5518. ['~' '~' (weld (rip 3 (wood q.p.lot)) rep)]
  5519. ==
  5520. --
  5521. =| rep=tape
  5522. =< |%
  5523. :: rendering idioms, output zero-padded to minimum lengths
  5524. ::
  5525. :: +a-co: decimal
  5526. :: +c-co: base58check
  5527. :: +d-co: decimal, takes minimum output digits
  5528. :: +r-co: floating point
  5529. :: +s-co: list of '.'-prefixed base16, 4 digit minimum
  5530. :: +v-co: base32, takes minimum output digits
  5531. :: +w-co: base64, takes minimum output digits
  5532. :: +x-co: base16, takes minimum output digits
  5533. :: +y-co: decimal, 2 digit minimum
  5534. :: +z-co: '0x'-prefixed base16
  5535. ::
  5536. ++ a-co |=(dat=@ ((d-co 1) dat))
  5537. ++ c-co (em-co [58 1] |=([? b=@ c=tape] [~(c ne b) c]))
  5538. ++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c])))
  5539. ::
  5540. ++ r-co
  5541. |= a=dn
  5542. ?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rep)
  5543. ?: ?=([%n *] a) (weld "nan" rep)
  5544. =; rep ?:(s.a rep ['-' rep])
  5545. =/ f ((d-co 1) a.a)
  5546. =^ e e.a
  5547. =/ e=@s (sun:si (lent f))
  5548. =/ sci :(sum:si e.a e -1)
  5549. ?: (syn:si (dif:si e.a --3)) [--1 sci] :: 12000 -> 12e3 e>+2
  5550. ?: !(syn:si (dif:si sci -2)) [--1 sci] :: 0.001 -> 1e-3 e<-2
  5551. [(sum:si sci --1) --0] :: 1.234e2 -> '.'@3 -> 123 .4
  5552. =? rep !=(--0 e.a)
  5553. :(weld ?:((syn:si e.a) "e" "e-") ((d-co 1) (abs:si e.a)))
  5554. (weld (ed-co e f) rep)
  5555. ::
  5556. ++ s-co
  5557. |= esc=(list @) ^- tape
  5558. ?~ esc rep
  5559. ['.' =>(.(rep $(esc t.esc)) ((x-co 4) i.esc))]
  5560. ::
  5561. ++ v-co |=(min=@ (em-co [32 min] |=([? b=@ c=tape] [~(v ne b) c])))
  5562. ++ w-co |=(min=@ (em-co [64 min] |=([? b=@ c=tape] [~(w ne b) c])))
  5563. ++ x-co |=(min=@ (em-co [16 min] |=([? b=@ c=tape] [~(x ne b) c])))
  5564. ++ y-co |=(dat=@ ((d-co 2) dat))
  5565. ++ z-co |=(dat=@ `tape`['0' 'x' ((x-co 1) dat)])
  5566. --
  5567. |%
  5568. :: +em-co: format in numeric base
  5569. ::
  5570. :: in .bas, format .min digits of .hol with .par
  5571. ::
  5572. :: - .hol is processed least-significant digit first
  5573. :: - all available digits in .hol will be processed, but
  5574. :: .min digits can exceed the number available in .hol
  5575. :: - .par handles all accumulated output on each call,
  5576. :: and can edit it, prepend or append digits, &c
  5577. :: - until .hol is exhausted, .par's sample is [| digit output],
  5578. :: subsequently, it's [& 0 output]
  5579. ::
  5580. ++ em-co
  5581. |= [[bas=@ min=@] par=$-([? @ tape] tape)]
  5582. |= hol=@
  5583. ^- tape
  5584. ?: &(=(0 hol) =(0 min))
  5585. rep
  5586. =/ [dar=@ rad=@] (dvr hol bas)
  5587. %= $
  5588. min ?:(=(0 min) 0 (dec min))
  5589. hol dar
  5590. rep (par =(0 dar) rad rep)
  5591. ==
  5592. ::
  5593. :: +ed-co: format in numeric base, with output length
  5594. ::
  5595. :: - like +em-co, but .par's sample will be [| digit output]
  5596. :: on the first call, regardless of the available digits in .hol
  5597. :: - used only for @r* floats
  5598. ::
  5599. ++ ed-co
  5600. |= [exp=@s int=tape] ^- tape
  5601. =/ [pos=? dig=@u] [=(--1 (cmp:si exp --0)) (abs:si exp)]
  5602. ?. pos
  5603. (into (weld (reap +(dig) '0') int) 1 '.')
  5604. =/ len (lent int)
  5605. ?: (lth dig len) (into int dig '.')
  5606. (weld int (reap (sub dig len) '0'))
  5607. ::
  5608. :: +ox-co: format '.'-separated digit sequences in numeric base
  5609. ::
  5610. :: in .bas, format each digit of .hol with .dug,
  5611. :: with '.' separators every .gop digits.
  5612. ::
  5613. :: - .hol is processed least-significant digit first
  5614. :: - .dug handles individual digits, output is prepended
  5615. :: - every segment but the last is zero-padded to .gop
  5616. ::
  5617. ++ ox-co
  5618. |= [[bas=@ gop=@] dug=$-(@ @)]
  5619. %+ em-co
  5620. [(pow bas gop) 0]
  5621. |= [top=? seg=@ res=tape]
  5622. %+ weld
  5623. ?:(top ~ `tape`['.' ~])
  5624. %. seg
  5625. %+ em-co(rep res)
  5626. [bas ?:(top 0 gop)]
  5627. |=([? b=@ c=tape] [(dug b) c])
  5628. ::
  5629. :: +ro-co: format '.'-prefixed bloqs in numeric base
  5630. ::
  5631. :: in .bas, for .buz bloqs 0 to .dop, format at least one
  5632. :: digit of .hol, prefixed with '.'
  5633. ::
  5634. :: - used only for @i* addresses
  5635. ::
  5636. ++ ro-co
  5637. |= [[buz=@ bas=@ dop=@] dug=$-(@ @)]
  5638. |= hol=@
  5639. ^- tape
  5640. ?: =(0 dop)
  5641. rep
  5642. :- '.'
  5643. =/ pod (dec dop)
  5644. %. (cut buz [pod 1] hol)
  5645. %+ em-co(rep $(dop pod))
  5646. [bas 1]
  5647. |=([? b=@ c=tape] [(dug b) c])
  5648. --
  5649. ::
  5650. :: 4l: atom parsing
  5651. +| %atom-parsing
  5652. ::
  5653. ++ so
  5654. ~% %so + ~
  5655. |%
  5656. ++ bisk
  5657. ~+
  5658. ;~ pose
  5659. ;~ pfix (just '0')
  5660. ;~ pose
  5661. (stag %ub ;~(pfix (just 'b') bay:ag))
  5662. (stag %uc ;~(pfix (just 'c') fim:ag))
  5663. (stag %ui ;~(pfix (just 'i') dim:ag))
  5664. (stag %ux ;~(pfix (just 'x') hex:ag))
  5665. (stag %uv ;~(pfix (just 'v') viz:ag))
  5666. (stag %uw ;~(pfix (just 'w') wiz:ag))
  5667. ==
  5668. ==
  5669. (stag %ud dem:ag)
  5670. ==
  5671. ++ crub
  5672. ~+
  5673. ;~ pose
  5674. (cook |=(det=date `dime`[%da (year det)]) when)
  5675. ::
  5676. %+ cook
  5677. |= [a=(list [p=?(%d %h %m %s) q=@]) b=(list @)]
  5678. =+ rop=`tarp`[0 0 0 0 b]
  5679. |- ^- dime
  5680. ?~ a
  5681. [%dr (yule rop)]
  5682. ?- p.i.a
  5683. %d $(a t.a, d.rop (add q.i.a d.rop))
  5684. %h $(a t.a, h.rop (add q.i.a h.rop))
  5685. %m $(a t.a, m.rop (add q.i.a m.rop))
  5686. %s $(a t.a, s.rop (add q.i.a s.rop))
  5687. ==
  5688. ;~ plug
  5689. %+ most
  5690. dot
  5691. ;~ pose
  5692. ;~(pfix (just 'd') (stag %d dim:ag))
  5693. ;~(pfix (just 'h') (stag %h dim:ag))
  5694. ;~(pfix (just 'm') (stag %m dim:ag))
  5695. ;~(pfix (just 's') (stag %s dim:ag))
  5696. ==
  5697. ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
  5698. ==
  5699. ::
  5700. (stag %p fed:ag)
  5701. ;~(pfix dot (stag %ta urs:ab))
  5702. ;~(pfix sig (stag %t urx:ab))
  5703. ;~(pfix hep (stag %c (cook taft urx:ab)))
  5704. ==
  5705. ++ nuck
  5706. ~/ %nuck |= a=nail %. a
  5707. %+ knee *coin |. ~+
  5708. %- stew
  5709. ^. stet ^. limo
  5710. :~ :- ['a' 'z'] (cook |=(a=@ta [%$ %tas a]) sym)
  5711. :- ['0' '9'] (stag %$ bisk)
  5712. :- '-' (stag %$ tash)
  5713. :- '.' ;~(pfix dot perd)
  5714. :- '~' ;~(pfix sig ;~(pose twid (easy [%$ %n 0])))
  5715. ==
  5716. ++ nusk
  5717. ~+
  5718. :(sear |=(a=@ta (rush a nuck)) wick urt:ab)
  5719. ++ perd
  5720. ~+
  5721. ;~ pose
  5722. (stag %$ zust)
  5723. (stag %many (ifix [cab ;~(plug cab cab)] (more cab nusk)))
  5724. ==
  5725. ++ royl
  5726. ~+
  5727. ;~ pose
  5728. (stag %rh royl-rh)
  5729. (stag %rq royl-rq)
  5730. (stag %rd royl-rd)
  5731. (stag %rs royl-rs)
  5732. ==
  5733. ::
  5734. ++ royl-rh (cook rylh ;~(pfix ;~(plug sig sig) (cook royl-cell royl-rn)))
  5735. ++ royl-rq (cook rylq ;~(pfix ;~(plug sig sig sig) (cook royl-cell royl-rn)))
  5736. ++ royl-rd (cook ryld ;~(pfix sig (cook royl-cell royl-rn)))
  5737. ++ royl-rs (cook ryls (cook royl-cell royl-rn))
  5738. ::
  5739. ++ royl-rn
  5740. =/ moo
  5741. |= a=tape
  5742. :- (lent a)
  5743. (scan a (bass 10 (plus sid:ab)))
  5744. ;~ pose
  5745. ;~ plug
  5746. (easy %d)
  5747. ;~(pose (cold | hep) (easy &))
  5748. ;~ plug dim:ag
  5749. ;~ pose
  5750. ;~(pfix dot (cook moo (plus (shim '0' '9'))))
  5751. (easy [0 0])
  5752. ==
  5753. ;~ pose
  5754. ;~ pfix
  5755. (just 'e')
  5756. ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag)
  5757. ==
  5758. (easy [& 0])
  5759. ==
  5760. ==
  5761. ==
  5762. ::
  5763. ;~ plug
  5764. (easy %i)
  5765. ;~ sfix
  5766. ;~(pose (cold | hep) (easy &))
  5767. (jest 'inf')
  5768. ==
  5769. ==
  5770. ::
  5771. ;~ plug
  5772. (easy %n)
  5773. (cold ~ (jest 'nan'))
  5774. ==
  5775. ==
  5776. ::
  5777. ++ royl-cell
  5778. |= rn
  5779. ^- dn
  5780. ?. ?=([%d *] +<) +<
  5781. =+ ^= h
  5782. (dif:si (new:si f.b i.b) (sun:si d.b))
  5783. [%d a h (add (mul c.b (pow 10 d.b)) e.b)]
  5784. ::
  5785. ++ tash
  5786. ~+
  5787. =+ ^= neg
  5788. |= [syn=? mol=dime] ^- dime
  5789. ?> =('u' (end 3 p.mol))
  5790. [(cat 3 's' (rsh 3 p.mol)) (new:si syn q.mol)]
  5791. ;~ pfix hep
  5792. ;~ pose
  5793. (cook |=(a=dime (neg | a)) bisk)
  5794. ;~(pfix hep (cook |=(a=dime (neg & a)) bisk))
  5795. ==
  5796. ==
  5797. ::
  5798. ++ twid
  5799. ~+
  5800. ;~ pose
  5801. %+ stag %blob
  5802. %+ sear |=(a=@ (mole |.((cue a))))
  5803. ;~(pfix (just '0') vum:ag)
  5804. ::
  5805. (stag %$ crub)
  5806. ==
  5807. ::
  5808. ++ when
  5809. ~+
  5810. ;~ plug
  5811. %+ cook
  5812. |=([a=@ b=?] [b a])
  5813. ;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
  5814. ;~(pfix dot mot:ag) :: month
  5815. ;~(pfix dot dip:ag) :: day
  5816. ;~ pose
  5817. ;~ pfix
  5818. ;~(plug dot dot)
  5819. ;~ plug
  5820. dum:ag
  5821. ;~(pfix dot dum:ag)
  5822. ;~(pfix dot dum:ag)
  5823. ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
  5824. ==
  5825. ==
  5826. (easy [0 0 0 ~])
  5827. ==
  5828. ==
  5829. ::
  5830. ++ zust
  5831. ~+
  5832. ;~ pose
  5833. (stag %is bip:ag)
  5834. (stag %if lip:ag)
  5835. royl
  5836. (stag %f ;~(pose (cold & (just 'y')) (cold | (just 'n'))))
  5837. (stag %q ;~(pfix sig feq:ag))
  5838. ==
  5839. --
  5840. ::
  5841. :: 4m: formatting functions
  5842. +| %formatting-functions
  5843. ++ scot
  5844. ~/ %scot
  5845. |=(mol=dime ~(rent co %$ mol))
  5846. ++ scow
  5847. ~/ %scow
  5848. |=(mol=dime ~(rend co %$ mol))
  5849. ++ slat |=(mod=@tas |=(txt=@ta (slaw mod txt)))
  5850. ++ slav |=([mod=@tas txt=@ta] (need (slaw mod txt)))
  5851. ++ slaw
  5852. ~/ %slaw
  5853. |= [mod=@tas txt=@ta]
  5854. ^- (unit @)
  5855. ?+ mod
  5856. :: slow fallback case to the full slay
  5857. ::
  5858. =+ con=(slay txt)
  5859. ?.(&(?=([~ %$ @ @] con) =(p.p.u.con mod)) ~ [~ q.p.u.con])
  5860. ::
  5861. %da
  5862. (rush txt ;~(pfix sig (cook year when:so)))
  5863. ::
  5864. %p
  5865. (rush txt ;~(pfix sig fed:ag))
  5866. ::
  5867. %ud
  5868. (rush txt dem:ag)
  5869. ::
  5870. %ux
  5871. (rush txt ;~(pfix (jest '0x') hex:ag))
  5872. ::
  5873. %uv
  5874. (rush txt ;~(pfix (jest '0v') viz:ag))
  5875. ::
  5876. %ta
  5877. (rush txt ;~(pfix ;~(plug sig dot) urs:ab))
  5878. ::
  5879. %tas
  5880. (rush txt sym)
  5881. ==
  5882. ::
  5883. ++ slay
  5884. |= txt=@ta ^- (unit coin)
  5885. =+ ^= vex
  5886. ?: (gth 0x7fff.ffff txt) :: XX petty cache
  5887. ~+ ((full nuck:so) [[1 1] (trip txt)])
  5888. ((full nuck:so) [[1 1] (trip txt)])
  5889. ?~ q.vex
  5890. ~
  5891. [~ p.u.q.vex]
  5892. ::
  5893. ++ smyt :: pretty print path
  5894. |= bon=path ^- tank
  5895. :+ %rose [['/' ~] ['/' ~] ~]
  5896. (turn bon |=(a=@ [%leaf (trip a)]))
  5897. ::
  5898. ++ spat |=(pax=path (crip (spud pax))) :: render path to cord
  5899. ++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape
  5900. ++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path
  5901. ++ stap :: path parser
  5902. %+ sear
  5903. |= p=path
  5904. ^- (unit path)
  5905. ?: ?=([~ ~] p) `~
  5906. ?. =(~ (rear p)) `p
  5907. ~
  5908. ;~(pfix fas (most fas urs:ab))
  5909. ::
  5910. ++ stip :: typed path parser
  5911. =< swot
  5912. |%
  5913. ++ swot |=(n=nail (;~(pfix fas (more fas spot)) n))
  5914. ::
  5915. ++ spot
  5916. %+ sear (soft iota)
  5917. %- stew
  5918. ^. stet ^. limo
  5919. :~ :- 'a'^'z' (stag %tas sym)
  5920. :- '$' (cold [%tas %$] buc)
  5921. :- '0'^'9' bisk:so
  5922. :- '-' tash:so
  5923. :- '.' zust:so
  5924. :- '~' ;~(pfix sig ;~(pose crub:so (easy [%n ~])))
  5925. :- '\'' (stag %t qut)
  5926. ==
  5927. --
  5928. ::
  5929. ++ pout
  5930. |= =pith
  5931. ^- path
  5932. %+ turn pith
  5933. |= i=iota
  5934. ?@(i i (scot i))
  5935. ::
  5936. ++ pave
  5937. |= =path
  5938. ^- pith
  5939. %+ turn path
  5940. |= i=@ta
  5941. (fall (rush i spot:stip) [%ta i])
  5942. ::
  5943. :: 4n: virtualization
  5944. +| %virtualization
  5945. ::
  5946. :: +mack: untyped, scry-less, unitary virtualization
  5947. ::
  5948. ++ mack
  5949. |= [sub=* fol=*]
  5950. ^- (unit)
  5951. =/ ton (mink [sub fol] |~(^ ~))
  5952. ?.(?=(%0 -.ton) ~ `product.ton)
  5953. :: +mink: raw virtual nock
  5954. ::
  5955. ++ mink !.
  5956. ~/ %mink
  5957. |= $: [subject=* formula=*]
  5958. scry=$-(^ (unit (unit)))
  5959. ==
  5960. =| trace=(list [@ta *])
  5961. |^ ^- tone
  5962. ?+ formula [%2 trace]
  5963. [^ *]
  5964. =/ head $(formula -.formula)
  5965. ?. ?=(%0 -.head) head
  5966. =/ tail $(formula +.formula)
  5967. ?. ?=(%0 -.tail) tail
  5968. [%0 product.head product.tail]
  5969. ::
  5970. [%0 axis=@]
  5971. =/ part (frag axis.formula subject)
  5972. ?~ part [%2 trace]
  5973. [%0 u.part]
  5974. ::
  5975. [%1 constant=*]
  5976. [%0 constant.formula]
  5977. ::
  5978. [%2 subject=* formula=*]
  5979. =/ subject $(formula subject.formula)
  5980. ?. ?=(%0 -.subject) subject
  5981. =/ formula $(formula formula.formula)
  5982. ?. ?=(%0 -.formula) formula
  5983. %= $
  5984. subject product.subject
  5985. formula product.formula
  5986. ==
  5987. ::
  5988. [%3 argument=*]
  5989. =/ argument $(formula argument.formula)
  5990. ?. ?=(%0 -.argument) argument
  5991. [%0 .?(product.argument)]
  5992. ::
  5993. [%4 argument=*]
  5994. =/ argument $(formula argument.formula)
  5995. ?. ?=(%0 -.argument) argument
  5996. ?^ product.argument [%2 trace]
  5997. [%0 .+(product.argument)]
  5998. ::
  5999. [%5 a=* b=*]
  6000. =/ a $(formula a.formula)
  6001. ?. ?=(%0 -.a) a
  6002. =/ b $(formula b.formula)
  6003. ?. ?=(%0 -.b) b
  6004. [%0 =(product.a product.b)]
  6005. ::
  6006. [%6 test=* yes=* no=*]
  6007. =/ result $(formula test.formula)
  6008. ?. ?=(%0 -.result) result
  6009. ?+ product.result
  6010. [%2 trace]
  6011. %& $(formula yes.formula)
  6012. %| $(formula no.formula)
  6013. ==
  6014. ::
  6015. [%7 subject=* next=*]
  6016. =/ subject $(formula subject.formula)
  6017. ?. ?=(%0 -.subject) subject
  6018. %= $
  6019. subject product.subject
  6020. formula next.formula
  6021. ==
  6022. ::
  6023. [%8 head=* next=*]
  6024. =/ head $(formula head.formula)
  6025. ?. ?=(%0 -.head) head
  6026. %= $
  6027. subject [product.head subject]
  6028. formula next.formula
  6029. ==
  6030. ::
  6031. [%9 axis=@ core=*]
  6032. =/ core $(formula core.formula)
  6033. ?. ?=(%0 -.core) core
  6034. =/ arm (frag axis.formula product.core)
  6035. ?~ arm [%2 trace]
  6036. %= $
  6037. subject product.core
  6038. formula u.arm
  6039. ==
  6040. ::
  6041. [%10 [axis=@ value=*] target=*]
  6042. ?: =(0 axis.formula) [%2 trace]
  6043. =/ target $(formula target.formula)
  6044. ?. ?=(%0 -.target) target
  6045. =/ value $(formula value.formula)
  6046. ?. ?=(%0 -.value) value
  6047. =/ mutant=(unit *)
  6048. (edit axis.formula product.target product.value)
  6049. ?~ mutant [%2 trace]
  6050. [%0 u.mutant]
  6051. ::
  6052. [%11 tag=@ next=*]
  6053. =/ next $(formula next.formula)
  6054. ?. ?=(%0 -.next) next
  6055. :- %0
  6056. .* subject
  6057. [11 tag.formula 1 product.next]
  6058. ::
  6059. [%11 [tag=@ clue=*] next=*]
  6060. =/ clue $(formula clue.formula)
  6061. ?. ?=(%0 -.clue) clue
  6062. =/ next
  6063. =? trace
  6064. ?=(?(%hunk %hand %lose %mean %spot) tag.formula)
  6065. [[tag.formula product.clue] trace]
  6066. $(formula next.formula)
  6067. ?. ?=(%0 -.next) next
  6068. :- %0
  6069. .* subject
  6070. [11 [tag.formula 1 product.clue] 1 product.next]
  6071. ::
  6072. [%12 ref=* path=*]
  6073. =/ ref $(formula ref.formula)
  6074. ?. ?=(%0 -.ref) ref
  6075. =/ path $(formula path.formula)
  6076. ?. ?=(%0 -.path) path
  6077. =/ result (scry product.ref product.path)
  6078. ?~ result
  6079. [%1 product.path]
  6080. ?~ u.result
  6081. [%2 [%hunk product.ref product.path] trace]
  6082. [%0 u.u.result]
  6083. ==
  6084. ::
  6085. ++ frag
  6086. |= [axis=@ noun=*]
  6087. ^- (unit)
  6088. ?: =(0 axis) ~
  6089. |- ^- (unit)
  6090. ?: =(1 axis) `noun
  6091. ?@ noun ~
  6092. =/ pick (cap axis)
  6093. %= $
  6094. axis (mas axis)
  6095. noun ?-(pick %2 -.noun, %3 +.noun)
  6096. ==
  6097. ::
  6098. ++ edit
  6099. |= [axis=@ target=* value=*]
  6100. ^- (unit)
  6101. ?: =(1 axis) `value
  6102. ?@ target ~
  6103. =/ pick (cap axis)
  6104. =/ mutant
  6105. %= $
  6106. axis (mas axis)
  6107. target ?-(pick %2 -.target, %3 +.target)
  6108. ==
  6109. ?~ mutant ~
  6110. ?- pick
  6111. %2 `[u.mutant +.target]
  6112. %3 `[-.target u.mutant]
  6113. ==
  6114. --
  6115. :: +mock: virtual nock
  6116. ::
  6117. ++ mock
  6118. |= [[sub=* fol=*] gul=$-(^ (unit (unit)))]
  6119. (mook (mink [sub fol] gul))
  6120. :: +mook: convert %tone to %toon, rendering stack frames
  6121. ::
  6122. ++ mook
  6123. |= ton=tone
  6124. ^- toon
  6125. ?. ?=([%2 *] ton)
  6126. ton
  6127. |^ [%2 (turn skip rend)]
  6128. ::
  6129. ++ skip
  6130. ^+ trace.ton
  6131. =/ yel (lent trace.ton)
  6132. ?. (gth yel 1.024) trace.ton
  6133. %+ weld
  6134. (scag 512 trace.ton)
  6135. ^+ trace.ton
  6136. :_ (slag (sub yel 512) trace.ton)
  6137. :- %lose
  6138. (crip "[skipped {(scow %ud (sub yel 1.024))} frames]")
  6139. ::
  6140. :: +rend: raw stack frame to tank
  6141. ::
  6142. :: $% [%hunk ref=* path] :: failed scry ([~ ~])
  6143. :: [%lose cord] :: skipped frames
  6144. :: [%hand *] :: mug any
  6145. :: [%mean $@(cord (trap tank))] :: ~_ et al
  6146. :: [%spot spot] :: source location
  6147. :: ==
  6148. ::
  6149. ++ rend
  6150. |= [tag=@ta dat=*]
  6151. ^- tank
  6152. ?+ tag
  6153. ::
  6154. leaf+"mook.{(rip 3 tag)}"
  6155. ::
  6156. %hunk
  6157. ?@ dat leaf+"mook.hunk"
  6158. =/ sof=(unit path) ((soft path) +.dat)
  6159. ?~ sof leaf+"mook.hunk"
  6160. (smyt u.sof)
  6161. ::
  6162. %lose
  6163. ?^ dat leaf+"mook.lose"
  6164. leaf+(rip 3 dat)
  6165. ::
  6166. %hand
  6167. leaf+(scow %p (mug dat))
  6168. ::
  6169. %mean
  6170. ?@ dat leaf+(rip 3 dat)
  6171. =/ mac (mack dat -.dat)
  6172. ?~ mac leaf+"####"
  6173. =/ sof ((soft tank) u.mac)
  6174. ?~ sof leaf+"mook.mean"
  6175. u.sof
  6176. ::
  6177. %spot
  6178. =/ sof=(unit spot) ((soft spot) dat)
  6179. ?~ sof leaf+"mook.spot"
  6180. :+ %rose [":" ~ ~]
  6181. :~ (smyt p.u.sof)
  6182. =* l p.q.u.sof
  6183. =* r q.q.u.sof
  6184. =/ ud |=(a=@u (scow %ud a))
  6185. leaf+"<[{(ud p.l)} {(ud q.l)}].[{(ud p.r)} {(ud q.r)}]>"
  6186. ==
  6187. ==
  6188. --
  6189. :: +mole: typed unitary virtual
  6190. ::
  6191. ++ mole
  6192. ~/ %mole
  6193. |* tap=(trap)
  6194. ^- (unit _$:tap)
  6195. =/ mur (mure tap)
  6196. ?~(mur ~ `$:tap)
  6197. :: +mong: virtual slam
  6198. ::
  6199. ++ mong
  6200. |= [[gat=* sam=*] gul=$-(^ (unit (unit)))]
  6201. ^- toon
  6202. ?. ?=([* ^] gat) [%2 ~]
  6203. (mock [gat(+< sam) %9 2 %0 1] gul)
  6204. :: +mule: typed virtual
  6205. ::
  6206. ++ mule
  6207. ~/ %mule
  6208. |* tap=(trap)
  6209. =/ mud (mute tap)
  6210. ?- -.mud
  6211. %& [%& p=$:tap]
  6212. %| [%| p=p.mud]
  6213. ==
  6214. :: +mure: untyped unitary virtual
  6215. ::
  6216. ++ mure
  6217. |= tap=(trap)
  6218. ^- (unit)
  6219. =/ ton (mink [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3])))
  6220. ?.(?=(%0 -.ton) ~ `product.ton)
  6221. :: +mute: untyped virtual
  6222. ::
  6223. ++ mute
  6224. |= tap=(trap)
  6225. ^- (each * (list tank))
  6226. =/ ton (mock [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3])))
  6227. ?- -.ton
  6228. %0 [%& p.ton]
  6229. ::
  6230. %1 =/ sof=(unit path) ((soft path) p.ton)
  6231. [%| ?~(sof leaf+"mute.hunk" (smyt u.sof)) ~]
  6232. ::
  6233. %2 [%| p.ton]
  6234. ==
  6235. :: +slum: slam a gate on a sample using raw nock, untyped
  6236. ::
  6237. ++ slum
  6238. ~/ %slum
  6239. |= sub=[gat=* sam=*]
  6240. .*(sub [%9 2 %10 [6 %0 3] %0 2])
  6241. :: +soft: virtual clam
  6242. ::
  6243. ++ soft
  6244. |* han=$-(* *)
  6245. |=(fud=* (mole |.((han fud))))
  6246. ::
  6247. :: 4o: molds and mold builders
  6248. +| %molds-and-mold-builders
  6249. ::
  6250. +$ abel typo :: original sin: type
  6251. +$ alas (list (pair term hoon)) :: alias list
  6252. +$ atom @ :: just an atom
  6253. +$ aura @ta :: atom format
  6254. +$ base :: base mold
  6255. $@ $? %noun :: any noun
  6256. %cell :: any cell
  6257. %flag :: loobean
  6258. %null :: ~ == 0
  6259. %void :: empty set
  6260. == ::
  6261. [%atom p=aura] :: atom
  6262. ::
  6263. +$ woof $@(@ [~ p=hoon]) :: simple embed
  6264. +$ chum $? lef=term :: jet name
  6265. [std=term kel=@] :: kelvin version
  6266. [ven=term pro=term kel=@] :: vendor and product
  6267. [ven=term pro=term ver=@ kel=@] :: all of the above
  6268. == ::
  6269. +$ coil $: p=garb :: name, wet=dry, vary
  6270. q=type :: context
  6271. r=(pair seminoun (map term tome)) :: chapters
  6272. == ::
  6273. +$ garb (trel (unit term) poly vair) :: core
  6274. +$ poly ?(%wet %dry) :: polarity
  6275. +$ foot $% [%dry p=hoon] :: dry arm, geometric
  6276. [%wet p=hoon] :: wet arm, generic
  6277. == ::
  6278. +$ link :: lexical segment
  6279. $% [%chat p=term] :: |chapter
  6280. [%cone p=aura q=atom] :: %constant
  6281. [%frag p=term] :: .face
  6282. [%funk p=term] :: +arm
  6283. [%plan p=term] :: $spec
  6284. == ::
  6285. +$ cuff (list link) :: parsed lex segments
  6286. +$ crib [summary=cord details=(list sect)] ::
  6287. +$ help [=cuff =crib] :: documentation
  6288. +$ limb $@ term :: wing element
  6289. $% [%& p=axis] :: by geometry
  6290. [%| p=@ud q=(unit term)] :: by name
  6291. == ::
  6292. :: XX more and better sanity
  6293. ::
  6294. +$ null ~ :: null, nil, etc
  6295. +$ onyx (list (pair type foot)) :: arm activation
  6296. +$ opal :: limb match
  6297. $% [%& p=type] :: leg
  6298. [%| p=axis q=(set [p=type q=foot])] :: arm
  6299. == ::
  6300. +$ pica (pair ? cord) :: & prose, | code
  6301. +$ palo (pair vein opal) :: wing trace, match
  6302. +$ pock (pair axis nock) :: changes
  6303. +$ port (each palo (pair type nock)) :: successful match
  6304. +$ spec :: structure definition
  6305. $~ [%base %null] ::
  6306. $% [%base p=base] :: base type
  6307. [%dbug p=spot q=spec] :: set debug
  6308. [%gist p=[%help p=help] q=spec] :: formal comment
  6309. [%leaf p=term q=@] :: constant atom
  6310. [%like p=wing q=(list wing)] :: reference
  6311. [%loop p=term] :: hygienic reference
  6312. [%made p=(pair term (list term)) q=spec] :: annotate synthetic
  6313. [%make p=hoon q=(list spec)] :: composed spec
  6314. [%name p=term q=spec] :: annotate simple
  6315. [%over p=wing q=spec] :: relative to subject
  6316. :: ::
  6317. [%bcgr p=spec q=spec] :: $>, filter: require
  6318. [%bcbc p=spec q=(map term spec)] :: $$, recursion
  6319. [%bcbr p=spec q=hoon] :: $|, verify
  6320. [%bccb p=hoon] :: $_, example
  6321. [%bccl p=[i=spec t=(list spec)]] :: $:, tuple
  6322. [%bccn p=[i=spec t=(list spec)]] :: $%, head pick
  6323. [%bcdt p=spec q=(map term spec)] :: $., read-write core
  6324. [%bcgl p=spec q=spec] :: $<, filter: exclude
  6325. [%bchp p=spec q=spec] :: $-, function core
  6326. [%bckt p=spec q=spec] :: $^, cons pick
  6327. [%bcls p=stud q=spec] :: $+, standard
  6328. [%bcfs p=spec q=(map term spec)] :: $/, write-only core
  6329. [%bcmc p=hoon] :: $;, manual
  6330. [%bcpm p=spec q=hoon] :: $&, repair
  6331. [%bcsg p=hoon q=spec] :: $~, default
  6332. [%bctc p=spec q=(map term spec)] :: $`, read-only core
  6333. [%bcts p=skin q=spec] :: $=, name
  6334. [%bcpt p=spec q=spec] :: $@, atom pick
  6335. [%bcwt p=[i=spec t=(list spec)]] :: $?, full pick
  6336. [%bczp p=spec q=(map term spec)] :: $!, opaque core
  6337. == ::
  6338. +$ tent :: model builder
  6339. $% [%| p=wing q=tent r=(list spec)] :: ~(p q r...)
  6340. [%& p=(list wing)] :: a.b:c.d
  6341. == ::
  6342. +$ tiki :: test case
  6343. $% [%& p=(unit term) q=wing] :: simple wing
  6344. [%| p=(unit term) q=hoon] :: named wing
  6345. == ::
  6346. +$ skin :: texture
  6347. $@ =term :: name/~[term %none]
  6348. $% [%base =base] :: base match
  6349. [%cell =skin =skin] :: pair
  6350. [%dbug =spot =skin] :: trace
  6351. [%leaf =aura =atom] :: atomic constant
  6352. [%help =help =skin] :: describe
  6353. [%name =term =skin] :: apply label
  6354. [%over =wing =skin] :: relative to
  6355. [%spec =spec =skin] :: cast to
  6356. [%wash depth=@ud] :: strip faces
  6357. == ::
  6358. +$ tome (pair what (map term hoon)) :: core chapter
  6359. +$ tope :: topographic type
  6360. $@ $? %& :: cell or atom
  6361. %| :: atom
  6362. == ::
  6363. (pair tope tope) :: cell
  6364. ++ hoot :: hoon tools
  6365. |%
  6366. +$ beer $@(char [~ p=hoon]) :: simple embed
  6367. +$ mane $@(@tas [@tas @tas]) :: XML name+space
  6368. +$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
  6369. +$ marl (list tuna) :: dynamic XML nodes
  6370. +$ mart (list [n=mane v=(list beer)]) :: dynamic XML attrs
  6371. +$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
  6372. +$ mare (each manx marl) :: node or nodes
  6373. +$ maru (each tuna marl) :: interp or nodes
  6374. +$ tuna :: maybe interpolation
  6375. $~ [[%$ ~] ~]
  6376. $^ manx
  6377. $: ?(%tape %manx %marl %call)
  6378. p=hoon
  6379. ==
  6380. -- ::
  6381. +$ hoon :: hoon AST
  6382. $+ hoon
  6383. $~ [%zpzp ~] ::
  6384. $^ [p=hoon q=hoon] ::
  6385. $% ::
  6386. [%$ p=axis] :: simple leg
  6387. :: ::
  6388. [%base p=base] :: base spec
  6389. [%bust p=base] :: bunt base
  6390. [%dbug p=spot q=hoon] :: debug info in trace
  6391. [%eror p=tape] :: assembly error
  6392. [%hand p=type q=nock] :: premade result
  6393. [%note p=note q=hoon] :: annotate
  6394. [%fits p=hoon q=wing] :: underlying ?=
  6395. [%knit p=(list woof)] :: assemble string
  6396. [%leaf p=(pair term @)] :: symbol spec
  6397. [%limb p=term] :: take limb
  6398. [%lost p=hoon] :: not to be taken
  6399. [%rock p=term q=*] :: fixed constant
  6400. [%sand p=term q=*] :: unfixed constant
  6401. [%tell p=(list hoon)] :: render as tape
  6402. [%tune p=$@(term tune)] :: minimal face
  6403. [%wing p=wing] :: take wing
  6404. [%yell p=(list hoon)] :: render as tank
  6405. [%xray p=manx:hoot] :: ;foo; templating
  6406. :: :::::: cores
  6407. [%brbc sample=(lest term) body=spec] :: |$
  6408. [%brcb p=spec q=alas r=(map term tome)] :: |_
  6409. [%brcl p=hoon q=hoon] :: |:
  6410. [%brcn p=(unit term) q=(map term tome)] :: |%
  6411. [%brdt p=hoon] :: |.
  6412. [%brkt p=hoon q=(map term tome)] :: |^
  6413. [%brhp p=hoon] :: |-
  6414. [%brsg p=spec q=hoon] :: |~
  6415. [%brtr p=spec q=hoon] :: |*
  6416. [%brts p=spec q=hoon] :: |=
  6417. [%brpt p=(unit term) q=(map term tome)] :: |@
  6418. [%brwt p=hoon] :: |?
  6419. :: :::::: tuples
  6420. [%clcb p=hoon q=hoon] :: :_ [q p]
  6421. [%clkt p=hoon q=hoon r=hoon s=hoon] :: :^ [p q r s]
  6422. [%clhp p=hoon q=hoon] :: :- [p q]
  6423. [%clls p=hoon q=hoon r=hoon] :: :+ [p q r]
  6424. [%clsg p=(list hoon)] :: :~ [p ~]
  6425. [%cltr p=(list hoon)] :: :* p as a tuple
  6426. :: :::::: invocations
  6427. [%cncb p=wing q=(list (pair wing hoon))] :: %_
  6428. [%cndt p=hoon q=hoon] :: %.
  6429. [%cnhp p=hoon q=hoon] :: %-
  6430. [%cncl p=hoon q=(list hoon)] :: %:
  6431. [%cntr p=wing q=hoon r=(list (pair wing hoon))] :: %*
  6432. [%cnkt p=hoon q=hoon r=hoon s=hoon] :: %^
  6433. [%cnls p=hoon q=hoon r=hoon] :: %+
  6434. [%cnsg p=wing q=hoon r=(list hoon)] :: %~
  6435. [%cnts p=wing q=(list (pair wing hoon))] :: %=
  6436. :: :::::: nock
  6437. [%dtkt p=spec q=hoon] :: .^ nock 11
  6438. [%dtls p=hoon] :: .+ nock 4
  6439. [%dttr p=hoon q=hoon] :: .* nock 2
  6440. [%dtts p=hoon q=hoon] :: .= nock 5
  6441. [%dtwt p=hoon] :: .? nock 3
  6442. :: :::::: type conversion
  6443. [%ktbr p=hoon] :: ^| contravariant
  6444. [%ktdt p=hoon q=hoon] :: ^. self-cast
  6445. [%ktls p=hoon q=hoon] :: ^+ expression cast
  6446. [%kthp p=spec q=hoon] :: ^- structure cast
  6447. [%ktpm p=hoon] :: ^& covariant
  6448. [%ktsg p=hoon] :: ^~ constant
  6449. [%ktts p=skin q=hoon] :: ^= label
  6450. [%ktwt p=hoon] :: ^? bivariant
  6451. [%kttr p=spec] :: ^* example
  6452. [%ktcl p=spec] :: ^: filter
  6453. :: :::::: hints
  6454. [%sgbr p=hoon q=hoon] :: ~| sell on trace
  6455. [%sgcb p=hoon q=hoon] :: ~_ tank on trace
  6456. [%sgcn p=chum q=hoon r=tyre s=hoon] :: ~% general jet hint
  6457. [%sgfs p=chum q=hoon] :: ~/ function j-hint
  6458. [%sggl p=$@(term [p=term q=hoon]) q=hoon] :: ~< backward hint
  6459. [%sggr p=$@(term [p=term q=hoon]) q=hoon] :: ~> forward hint
  6460. [%sgbc p=term q=hoon] :: ~$ profiler hit
  6461. [%sgls p=@ q=hoon] :: ~+ cache=memoize
  6462. [%sgpm p=@ud q=hoon r=hoon] :: ~& printf=priority
  6463. [%sgts p=hoon q=hoon] :: ~= don't duplicate
  6464. [%sgwt p=@ud q=hoon r=hoon s=hoon] :: ~? tested printf
  6465. [%sgzp p=hoon q=hoon] :: ~! type on trace
  6466. :: :::::: miscellaneous
  6467. [%mcts p=marl:hoot] :: ;= list templating
  6468. [%mccl p=hoon q=(list hoon)] :: ;: binary to nary
  6469. [%mcfs p=hoon] :: ;/ [%$ [%$ p ~] ~]
  6470. [%mcgl p=spec q=hoon r=hoon s=hoon] :: ;< bind
  6471. [%mcsg p=hoon q=(list hoon)] :: ;~ kleisli arrow
  6472. [%mcmc p=spec q=hoon] :: ;; normalize
  6473. :: :::::: compositions
  6474. [%tsbr p=spec q=hoon] :: =| push bunt
  6475. [%tscl p=(list (pair wing hoon)) q=hoon] :: =: q w= p changes
  6476. [%tsfs p=skin q=hoon r=hoon] :: =/ typed variable
  6477. [%tsmc p=skin q=hoon r=hoon] :: =; =/(q p r)
  6478. [%tsdt p=wing q=hoon r=hoon] :: =. r with p as q
  6479. [%tswt p=wing q=hoon r=hoon s=hoon] :: =? conditional =.
  6480. [%tsgl p=hoon q=hoon] :: =< =>(q p)
  6481. [%tshp p=hoon q=hoon] :: =- =+(q p)
  6482. [%tsgr p=hoon q=hoon] :: => q w=subject p
  6483. [%tskt p=skin q=wing r=hoon s=hoon] :: =^ state machine
  6484. [%tsls p=hoon q=hoon] :: =+ q w=[p subject]
  6485. [%tssg p=(list hoon)] :: =~ hoon stack
  6486. [%tstr p=(pair term (unit spec)) q=hoon r=hoon] :: =* new style
  6487. [%tscm p=hoon q=hoon] :: =, overload p in q
  6488. :: :::::: conditionals
  6489. [%wtbr p=(list hoon)] :: ?| loobean or
  6490. [%wthp p=wing q=(list (pair spec hoon))] :: ?- pick case in q
  6491. [%wtcl p=hoon q=hoon r=hoon] :: ?: if=then=else
  6492. [%wtdt p=hoon q=hoon r=hoon] :: ?. ?:(p r q)
  6493. [%wtkt p=wing q=hoon r=hoon] :: ?^ if p is a cell
  6494. [%wtgl p=hoon q=hoon] :: ?< ?:(p !! q)
  6495. [%wtgr p=hoon q=hoon] :: ?> ?:(p q !!)
  6496. [%wtls p=wing q=hoon r=(list (pair spec hoon))] :: ?+ ?- w=default
  6497. [%wtpm p=(list hoon)] :: ?& loobean and
  6498. [%wtpt p=wing q=hoon r=hoon] :: ?@ if p is atom
  6499. [%wtsg p=wing q=hoon r=hoon] :: ?~ if p is null
  6500. [%wthx p=skin q=wing] :: ?# if q matches p
  6501. [%wtts p=spec q=wing] :: ?= if q matches p
  6502. [%wtzp p=hoon] :: ?! loobean not
  6503. :: :::::: special
  6504. [%zpcm p=hoon q=hoon] :: !,
  6505. [%zpgr p=hoon] :: !>
  6506. [%zpgl p=spec q=hoon] :: !<
  6507. [%zpmc p=hoon q=hoon] :: !;
  6508. [%zpts p=hoon] :: !=
  6509. [%zppt p=(list wing) q=hoon r=hoon] :: !@
  6510. [%zpwt p=$@(p=@ [p=@ q=@]) q=hoon] :: !?
  6511. [%zpzp ~] :: !!
  6512. == ::
  6513. +$ tyre (list [p=term q=hoon]) ::
  6514. +$ tyke (list (unit hoon)) ::
  6515. :: :::::: virtual nock
  6516. +$ nock $^ [p=nock q=nock] :: autocons
  6517. $% [%1 p=*] :: constant
  6518. [%2 p=nock q=nock] :: compose
  6519. [%3 p=nock] :: cell test
  6520. [%4 p=nock] :: increment
  6521. [%5 p=nock q=nock] :: equality test
  6522. [%6 p=nock q=nock r=nock] :: if, then, else
  6523. [%7 p=nock q=nock] :: serial compose
  6524. [%8 p=nock q=nock] :: push onto subject
  6525. [%9 p=@ q=nock] :: select arm and fire
  6526. [%10 p=[p=@ q=nock] q=nock] :: edit
  6527. [%11 p=$@(@ [p=@ q=nock]) q=nock] :: hint
  6528. [%12 p=nock q=nock] :: grab data from sky
  6529. [%0 p=@] :: axis select
  6530. == ::
  6531. +$ note :: type annotation
  6532. $% [%help p=help] :: documentation
  6533. [%know p=stud] :: global standard
  6534. [%made p=term q=(unit (list wing))] :: structure
  6535. == ::
  6536. +$ type $+ type
  6537. $~ %noun ::
  6538. $@ $? %noun :: any nouns
  6539. %void :: no noun
  6540. == ::
  6541. $% [%atom p=term q=(unit @)] :: atom / constant
  6542. [%cell p=type q=type] :: ordered pair
  6543. [%core p=type q=coil] :: object
  6544. [%face p=$@(term tune) q=type] :: namespace
  6545. [%fork p=(set type)] :: union
  6546. [%hint p=(pair type note) q=type] :: annotation
  6547. [%hold p=type q=hoon] :: lazy evaluation
  6548. == ::
  6549. +$ tony :: ++tone done right
  6550. $% [%0 p=tine q=*] :: success
  6551. [%1 p=(set)] :: blocks
  6552. [%2 p=(list [@ta *])] :: error ~_s
  6553. == ::
  6554. +$ tine :: partial noun
  6555. $@ ~ :: open
  6556. $% [%& p=tine q=tine] :: half-blocked
  6557. [%| p=(set)] :: fully blocked
  6558. == ::
  6559. +$ tool $@(term tune) :: type decoration
  6560. +$ tune :: complex
  6561. $~ [~ ~] ::
  6562. $: p=(map term (unit hoon)) :: aliases
  6563. q=(list hoon) :: bridges
  6564. == ::
  6565. +$ typo type :: old type
  6566. +$ vase [p=type q=*] :: type-value pair
  6567. +$ vise [p=typo q=*] :: old vase
  6568. +$ vial ?(%read %rite %both %free) :: co/contra/in/bi
  6569. +$ vair ?(%gold %iron %lead %zinc) :: in/contra/bi/co
  6570. +$ vein (list (unit axis)) :: search trace
  6571. +$ sect (list pica) :: paragraph
  6572. +$ whit :: prefix docs parse
  6573. $: bat=(map cuff (pair cord (list sect))) :: batch comment
  6574. == ::
  6575. +$ whiz cord :: postfix doc parse
  6576. +$ what (unit (pair cord (list sect))) :: help slogan/section
  6577. +$ wing (list limb) :: search path
  6578. ::
  6579. :: +block: abstract identity of resource awaited
  6580. ::
  6581. +$ block
  6582. path
  6583. ::
  6584. :: +result: internal interpreter result
  6585. ::
  6586. +$ result
  6587. $@(~ seminoun)
  6588. ::
  6589. :: +thunk: fragment constructor
  6590. ::
  6591. +$ thunk
  6592. $-(@ud (unit noun))
  6593. ::
  6594. :: +seminoun:
  6595. ::
  6596. +$ seminoun
  6597. :: partial noun; blocked subtrees are ~
  6598. ::
  6599. $~ [[%full / ~ ~] ~]
  6600. [mask=stencil data=noun]
  6601. ::
  6602. :: +stencil: noun knowledge map
  6603. ::
  6604. +$ stencil
  6605. $% ::
  6606. :: %half: noun has partial block substructure
  6607. ::
  6608. [%half left=stencil rite=stencil]
  6609. ::
  6610. :: %full: noun is either fully complete, or fully blocked
  6611. ::
  6612. [%full blocks=(set block)]
  6613. ::
  6614. :: %lazy: noun can be generated from virtual subtree
  6615. ::
  6616. [%lazy fragment=axis resolve=thunk]
  6617. ==
  6618. ::
  6619. +$ output
  6620. :: ~: interpreter stopped
  6621. ::
  6622. %- unit
  6623. $% ::
  6624. :: %done: output is complete
  6625. ::
  6626. [%done p=noun]
  6627. ::
  6628. :: %wait: output is waiting for resources
  6629. ::
  6630. [%wait p=(list block)]
  6631. ==
  6632. :: profiling
  6633. +$ doss
  6634. $: mon=moan :: sample count
  6635. hit=(map term @ud) :: hit points
  6636. cut=(map path hump) :: cut points
  6637. ==
  6638. +$ moan :: sample metric
  6639. $: fun=@ud :: samples in C
  6640. noc=@ud :: samples in nock
  6641. glu=@ud :: samples in glue
  6642. mal=@ud :: samples in alloc
  6643. far=@ud :: samples in frag
  6644. coy=@ud :: samples in copy
  6645. euq=@ud :: samples in equal
  6646. == ::
  6647. ::
  6648. +$ hump
  6649. $: mon=moan :: sample count
  6650. out=(map path @ud) :: calls out of
  6651. inn=(map path @ud) :: calls into
  6652. ==
  6653. --
  6654. ::
  6655. ~% %pen
  6656. +
  6657. ==
  6658. %ap ap
  6659. %ut ut
  6660. ==
  6661. :: layer-5
  6662. ::
  6663. |%
  6664. ::
  6665. :: 5aa: new partial nock interpreter
  6666. +| %new-partial-nock-interpreter
  6667. ::
  6668. ++ musk !. :: nock with block set
  6669. |%
  6670. ++ abet
  6671. :: simplify raw result
  6672. ::
  6673. |= $: :: noy: raw result
  6674. ::
  6675. noy=result
  6676. ==
  6677. ^- output
  6678. :: propagate stop
  6679. ::
  6680. ?~ noy ~
  6681. :- ~
  6682. :: merge all blocking sets
  6683. ::
  6684. =/ blocks (squash mask.noy)
  6685. ?: =(~ blocks)
  6686. :: no blocks, data is complete
  6687. ::
  6688. done/data.noy
  6689. :: reduce block set to block list
  6690. ::
  6691. wait/~(tap in blocks)
  6692. ::
  6693. ++ araw
  6694. :: execute nock on partial subject
  6695. ::
  6696. |= $: :: bus: subject, a partial noun
  6697. :: fol: formula, a complete noun
  6698. ::
  6699. bus=seminoun
  6700. fol=noun
  6701. ==
  6702. :: interpreter loop
  6703. ::
  6704. |- ^- result
  6705. ?@ fol
  6706. :: bad formula, stop
  6707. ::
  6708. ~
  6709. ?: ?=(^ -.fol)
  6710. :: hed: interpret head
  6711. ::
  6712. =+ hed=$(fol -.fol)
  6713. :: propagate stop
  6714. ::
  6715. ?~ hed ~
  6716. :: tal: interpret tail
  6717. ::
  6718. =+ tal=$(fol +.fol)
  6719. :: propagate stop
  6720. ::
  6721. ?~ tal ~
  6722. :: combine
  6723. ::
  6724. (combine hed tal)
  6725. ?+ fol
  6726. :: bad formula; stop
  6727. ::
  6728. ~
  6729. :: 0; fragment
  6730. ::
  6731. [%0 b=@]
  6732. :: if bad axis, stop
  6733. ::
  6734. ?: =(0 b.fol) ~
  6735. :: reduce to fragment
  6736. ::
  6737. (fragment b.fol bus)
  6738. ::
  6739. :: 1; constant
  6740. ::
  6741. [%1 b=*]
  6742. :: constant is complete
  6743. ::
  6744. [full/~ b.fol]
  6745. ::
  6746. :: 2; recursion
  6747. ::
  6748. [%2 b=* c=*]
  6749. :: require complete formula
  6750. ::
  6751. %+ require
  6752. :: compute formula with current subject
  6753. ::
  6754. $(fol c.fol)
  6755. |= :: ryf: next formula
  6756. ::
  6757. ryf=noun
  6758. :: lub: next subject
  6759. ::
  6760. =+ lub=^$(fol b.fol)
  6761. :: propagate stop
  6762. ::
  6763. ?~ lub ~
  6764. :: recurse
  6765. ::
  6766. ^$(fol ryf, bus lub)
  6767. ::
  6768. :: 3; probe
  6769. ::
  6770. [%3 b=*]
  6771. %+ require
  6772. $(fol b.fol)
  6773. |= :: fig: probe input
  6774. ::
  6775. fig=noun
  6776. :: yes if cell, no if atom
  6777. ::
  6778. [full/~ .?(fig)]
  6779. ::
  6780. :: 4; increment
  6781. ::
  6782. [%4 b=*]
  6783. %+ require
  6784. $(fol b.fol)
  6785. |= :: fig: increment input
  6786. ::
  6787. fig=noun
  6788. :: stop for cells, increment for atoms
  6789. ::
  6790. ?^(fig ~ [full/~ +(fig)])
  6791. ::
  6792. :: 5; compare
  6793. ::
  6794. [%5 b=* c=*]
  6795. %+ require
  6796. $(fol b.fol)
  6797. |= :: hed: left input
  6798. ::
  6799. hed=noun
  6800. %+ require
  6801. ^$(fol c.fol)
  6802. |= :: tal: right input
  6803. ::
  6804. tal=noun
  6805. [full/~ =(hed tal)]
  6806. ::
  6807. :: 6; if-then-else
  6808. ::
  6809. [%6 b=* c=* d=*]
  6810. :: semantic expansion
  6811. ::
  6812. %+ require
  6813. $(fol b.fol)
  6814. |= :: fig: boolean
  6815. ::
  6816. fig=noun
  6817. :: apply proper booleans
  6818. ::
  6819. ?: =(& fig) ^$(fol c.fol)
  6820. ?: =(| fig) ^$(fol d.fol)
  6821. :: stop on bad test
  6822. ::
  6823. ~
  6824. ::
  6825. :: 7; composition
  6826. ::
  6827. [%7 b=* c=*]
  6828. :: one: input
  6829. ::
  6830. =+ one=$(fol b.fol)
  6831. :: propagate stop
  6832. ::
  6833. ?~ one ~
  6834. :: complete composition
  6835. ::
  6836. $(fol c.fol, bus one)
  6837. ::
  6838. :: 8; introduction
  6839. ::
  6840. [%8 b=* c=*]
  6841. :: one: input
  6842. ::
  6843. =+ one=$(fol b.fol)
  6844. :: propagate stop
  6845. ::
  6846. ?~ one ~
  6847. :: complete introduction
  6848. ::
  6849. $(fol c.fol, bus (combine one bus))
  6850. ::
  6851. :: 9; invocation
  6852. ::
  6853. [%9 b=* c=*]
  6854. :: semantic expansion
  6855. ::
  6856. ?^ b.fol ~
  6857. :: one: core
  6858. ::
  6859. =+ one=$(fol c.fol)
  6860. :: propagate stop
  6861. ::
  6862. ?~ one ~
  6863. :: if core is constant
  6864. ::
  6865. ?: ?=([[%full ~] *] one)
  6866. :: then call virtual nock directly
  6867. ::
  6868. =+ (mack data.one [%9 b.fol %0 1])
  6869. :: propagate stop
  6870. ::
  6871. ?~ - ~
  6872. :: produce result
  6873. ::
  6874. [[%full ~] u.-]
  6875. :: else complete call
  6876. ::
  6877. %+ require
  6878. :: retrieve formula
  6879. ::
  6880. (fragment b.fol one)
  6881. :: continue
  6882. ::
  6883. |=(noun ^$(bus one, fol +<))
  6884. ::
  6885. :: 10; edit
  6886. ::
  6887. [%10 [b=@ c=*] d=*]
  6888. :: tar: target of edit
  6889. ::
  6890. =+ tar=$(fol d.fol)
  6891. :: propagate stop
  6892. ::
  6893. ?~ tar ~
  6894. :: inn: inner value
  6895. ::
  6896. =+ inn=$(fol c.fol)
  6897. :: propagate stop
  6898. ::
  6899. ?~ inn ~
  6900. (mutate b.fol inn tar)
  6901. ::
  6902. :: 11; static hint
  6903. ::
  6904. [%11 @ c=*]
  6905. :: ignore hint
  6906. ::
  6907. $(fol c.fol)
  6908. ::
  6909. :: 11; dynamic hint
  6910. ::
  6911. [%11 [b=* c=*] d=*]
  6912. :: noy: dynamic hint
  6913. ::
  6914. =+ noy=$(fol c.fol)
  6915. :: propagate stop
  6916. ::
  6917. ?~ noy ~
  6918. :: if hint is a fully computed trace
  6919. ::
  6920. ?: &(?=(%spot b.fol) ?=([[%full ~] *] noy))
  6921. :: compute within trace
  6922. ::
  6923. ~_((show %o +.noy) $(fol d.fol))
  6924. :: else ignore hint
  6925. ::
  6926. $(fol d.fol)
  6927. ==
  6928. ::
  6929. ++ apex
  6930. :: execute nock on partial subject
  6931. ::
  6932. |= $: :: bus: subject, a partial noun
  6933. :: fol: formula, a complete noun
  6934. ::
  6935. bus=seminoun
  6936. fol=noun
  6937. ==
  6938. ~+
  6939. ^- output
  6940. :: simplify result
  6941. ::
  6942. (abet (araw bus fol))
  6943. ::
  6944. ++ combine
  6945. :: combine a pair of seminouns
  6946. ::
  6947. |= $: :: hed: head of pair
  6948. :: tal: tail of pair
  6949. ::
  6950. hed=seminoun
  6951. tal=seminoun
  6952. ==
  6953. ^- seminoun
  6954. ?. ?& &(?=(%full -.mask.hed) ?=(%full -.mask.tal))
  6955. =(=(~ blocks.mask.hed) =(~ blocks.mask.tal))
  6956. ==
  6957. :: default merge
  6958. ::
  6959. [half/[mask.hed mask.tal] [data.hed data.tal]]
  6960. :: both sides total
  6961. ::
  6962. ?: =(~ blocks.mask.hed)
  6963. :: both sides are complete
  6964. ::
  6965. [full/~ data.hed data.tal]
  6966. :: both sides are blocked
  6967. ::
  6968. [full/(~(uni in blocks.mask.hed) blocks.mask.tal) ~]
  6969. ::
  6970. ++ complete
  6971. :: complete any laziness
  6972. ::
  6973. |= bus=seminoun
  6974. ^- seminoun
  6975. ?- -.mask.bus
  6976. %full bus
  6977. %lazy :: fragment 1 is the whole thing
  6978. ::
  6979. ?: =(1 fragment.mask.bus)
  6980. :: blocked; we can't get fragment 1 while compiling it
  6981. ::
  6982. [[%full [~ ~ ~]] ~]
  6983. :: execute thunk
  6984. ::
  6985. =+ (resolve.mask.bus fragment.mask.bus)
  6986. :: if product is nil
  6987. ::
  6988. ?~ -
  6989. :: then blocked
  6990. ::
  6991. [[%full [~ ~ ~]] ~]
  6992. :: else use value
  6993. ::
  6994. [[%full ~] u.-]
  6995. %half :: recursive descent
  6996. ::
  6997. %+ combine
  6998. $(bus [left.mask.bus -.data.bus])
  6999. $(bus [rite.mask.bus +.data.bus])
  7000. ==
  7001. ::
  7002. ++ fragment
  7003. :: seek to an axis in a seminoun
  7004. ::
  7005. |= $: :: axe: tree address of subtree
  7006. :: bus: partial noun
  7007. ::
  7008. axe=axis
  7009. bus=seminoun
  7010. ==
  7011. ^- result
  7012. :: 1 is the root
  7013. ::
  7014. ?: =(1 axe) bus
  7015. :: now: top of axis (2 or 3)
  7016. :: lat: rest of axis
  7017. ::
  7018. =+ [now=(cap axe) lat=(mas axe)]
  7019. ?- -.mask.bus
  7020. %lazy :: propagate laziness
  7021. ::
  7022. bus(fragment.mask (peg fragment.mask.bus axe))
  7023. ::
  7024. %full :: if fully blocked, produce self
  7025. ::
  7026. ?^ blocks.mask.bus bus
  7027. :: descending into atom, stop
  7028. ::
  7029. ?@ data.bus ~
  7030. :: descend into complete cell
  7031. ::
  7032. $(axe lat, bus [full/~ ?:(=(2 now) -.data.bus +.data.bus)])
  7033. ::
  7034. %half :: descend into partial cell
  7035. ::
  7036. %= $
  7037. axe lat
  7038. bus ?: =(2 now)
  7039. [left.mask.bus -.data.bus]
  7040. [rite.mask.bus +.data.bus]
  7041. == ==
  7042. ::
  7043. ++ mutate
  7044. :: change a single axis in a seminoun
  7045. ::
  7046. |= $: :: axe: axis within big to change
  7047. :: lit: (little) seminoun to insert within big at axe
  7048. :: big: seminoun to mutate
  7049. ::
  7050. axe=@
  7051. lit=seminoun
  7052. big=seminoun
  7053. ==
  7054. ^- result
  7055. :: stop on zero axis
  7056. ::
  7057. ?~ axe ~
  7058. :: edit root of big means discard it
  7059. ::
  7060. ?: =(1 axe) lit
  7061. :: decompose axis into path of head-tail
  7062. ::
  7063. |- ^- result
  7064. ?: =(2 axe)
  7065. :: mutate head of cell
  7066. ::
  7067. =+ tal=(fragment 3 big)
  7068. :: propagate stop
  7069. ::
  7070. ?~ tal ~
  7071. (combine lit tal)
  7072. ?: =(3 axe)
  7073. :: mutate tail of cell
  7074. ::
  7075. =+ hed=(fragment 2 big)
  7076. :: propagate stop
  7077. ::
  7078. ?~ hed ~
  7079. (combine hed lit)
  7080. :: deeper axis: keep one side of big and
  7081. :: recurse into the other with smaller axe
  7082. ::
  7083. =+ mor=(mas axe)
  7084. =+ hed=(fragment 2 big)
  7085. :: propagate stop
  7086. ::
  7087. ?~ hed ~
  7088. =+ tal=(fragment 3 big)
  7089. :: propagate stop
  7090. ::
  7091. ?~ tal ~
  7092. ?: =(2 (cap axe))
  7093. :: recurse into the head
  7094. ::
  7095. =+ mut=$(big hed, axe mor)
  7096. :: propagate stop
  7097. ::
  7098. ?~ mut ~
  7099. (combine mut tal)
  7100. :: recurse into the tail
  7101. ::
  7102. =+ mut=$(big tal, axe mor)
  7103. :: propagate stop
  7104. ::
  7105. ?~ mut ~
  7106. (combine hed mut)
  7107. ::
  7108. ++ require
  7109. :: require complete intermediate step
  7110. ::
  7111. |= $: noy=result
  7112. yen=$-(* result)
  7113. ==
  7114. ^- result
  7115. :: propagate stop
  7116. ::
  7117. ?~ noy ~
  7118. :: suppress laziness
  7119. ::
  7120. =/ bus=seminoun (complete noy)
  7121. ?< ?=(%lazy -.mask.bus)
  7122. :: if partial block, squash blocks and stop
  7123. ::
  7124. ?: ?=(%half -.mask.bus) [full/(squash mask.bus) ~]
  7125. :: if full block, propagate block
  7126. ::
  7127. ?: ?=(^ blocks.mask.bus) [mask.bus ~]
  7128. :: otherwise use complete noun
  7129. ::
  7130. (yen data.bus)
  7131. ::
  7132. ++ squash
  7133. :: convert stencil to block set
  7134. ::
  7135. |= tyn=stencil
  7136. ^- (set block)
  7137. ?- -.tyn
  7138. %lazy $(tyn -:(complete tyn ~))
  7139. %full blocks.tyn
  7140. %half (~(uni in $(tyn left.tyn)) $(tyn rite.tyn))
  7141. ==
  7142. --
  7143. ::
  7144. :: 5a: compiler utilities
  7145. +| %compiler-utilities
  7146. ::
  7147. ++ bool :: make loobean
  7148. ^- type
  7149. (fork [%atom %f `%.y] [%atom %f `%.n] ~)
  7150. ::
  7151. ++ cell :: make %cell type
  7152. ~/ %cell
  7153. |= [hed=type tal=type]
  7154. ^- type
  7155. ?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal]))
  7156. ::
  7157. ++ core :: make %core type
  7158. ~/ %core
  7159. |= [pac=type con=coil]
  7160. ^- type
  7161. ?:(=(%void pac) %void [%core pac con])
  7162. ::
  7163. ++ hint
  7164. |= [p=(pair type note) q=type]
  7165. ^- type
  7166. ?: =(%void q) %void
  7167. ?: =(%noun q) %noun
  7168. [%hint p q]
  7169. ::
  7170. ++ face :: make %face type
  7171. ~/ %face
  7172. |= [giz=$@(term tune) der=type]
  7173. ^- type
  7174. ?: =(%void der)
  7175. %void
  7176. [%face giz der]
  7177. ::
  7178. ++ fork :: make %fork type
  7179. ~/ %fork
  7180. |= yed=(list type)
  7181. =| lez=(set type)
  7182. |- ^- type
  7183. ?~ yed
  7184. ?~ lez %void
  7185. ?: ?=([* ~ ~] lez) n.lez
  7186. [%fork lez]
  7187. %= $
  7188. yed t.yed
  7189. lez
  7190. ?: =(%void i.yed) lez
  7191. ?: ?=([%fork *] i.yed) (~(uni in lez) p.i.yed)
  7192. (~(put in lez) i.yed)
  7193. ==
  7194. ::
  7195. ++ cove :: extract [0 *] axis
  7196. |= nug=nock
  7197. ?- nug
  7198. [%0 *] p.nug
  7199. [%11 *] $(nug q.nug)
  7200. * ~_(leaf+"cove" !!)
  7201. ==
  7202. ++ comb :: combine two formulas
  7203. ~/ %comb
  7204. |= [mal=nock buz=nock]
  7205. ^- nock
  7206. ?: ?&(?=([%0 *] mal) !=(0 p.mal))
  7207. ?: ?&(?=([%0 *] buz) !=(0 p.buz))
  7208. [%0 (peg p.mal p.buz)]
  7209. ?: ?=([%2 [%0 *] [%0 *]] buz)
  7210. [%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]]
  7211. [%7 mal buz]
  7212. ?: ?=([^ [%0 %1]] mal)
  7213. [%8 p.mal buz]
  7214. ?: =([%0 %1] buz)
  7215. mal
  7216. [%7 mal buz]
  7217. ::
  7218. ++ cond :: ?: compile
  7219. ~/ %cond
  7220. |= [pex=nock yom=nock woq=nock]
  7221. ^- nock
  7222. ?: =([%1 &] pex) yom
  7223. ?: =([%1 |] pex) woq
  7224. ?: =([%0 0] pex) pex
  7225. [%6 pex yom woq]
  7226. ::
  7227. ++ cons :: make formula cell
  7228. ~/ %cons
  7229. |= [vur=nock sed=nock]
  7230. ^- nock
  7231. :: this optimization can remove crashes which are essential
  7232. ::
  7233. :: ?: ?=([[%0 *] [%0 *]] +<)
  7234. :: ?: ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2)))
  7235. :: [%0 (div p.vur 2)]
  7236. :: [vur sed]
  7237. ?: ?=([[%1 *] [%1 *]] +<)
  7238. [%1 p.vur p.sed]
  7239. [vur sed]
  7240. ::
  7241. ++ fitz :: odor compatibility
  7242. ~/ %fitz
  7243. |= [yaz=term wix=term]
  7244. =+ ^= fiz
  7245. |= mot=@ta ^- [p=@ q=@ta]
  7246. =+ len=(met 3 mot)
  7247. ?: =(0 len)
  7248. [0 %$]
  7249. =+ tyl=(rsh [3 (dec len)] mot)
  7250. ?: &((gte tyl 'A') (lte tyl 'Z'))
  7251. [(sub tyl 64) (end [3 (dec len)] mot)]
  7252. [0 mot]
  7253. =+ [yoz=(fiz yaz) wux=(fiz wix)]
  7254. ?& ?| =(0 p.yoz)
  7255. =(0 p.wux)
  7256. &(!=(0 p.wux) (lte p.wux p.yoz))
  7257. ==
  7258. |- ?| =(%$ q.yoz)
  7259. =(%$ q.wux)
  7260. ?& =((end 3 q.yoz) (end 3 q.wux))
  7261. $(q.yoz (rsh 3 q.yoz), q.wux (rsh 3 q.wux))
  7262. ==
  7263. ==
  7264. ==
  7265. ::
  7266. ++ flan :: loobean &
  7267. ~/ %flan
  7268. |= [bos=nock nif=nock]
  7269. ^- nock
  7270. ?: ?| =(bos nif)
  7271. =([%1 |] bos)
  7272. =([%1 &] nif)
  7273. =([%0 0] bos)
  7274. ==
  7275. bos
  7276. ?: ?| =([%1 &] bos)
  7277. =([%1 |] nif)
  7278. =([%0 0] nif)
  7279. ==
  7280. nif
  7281. [%6 bos nif [%1 |]]
  7282. ::
  7283. ++ flip :: loobean negation
  7284. ~/ %flip
  7285. |= dyr=nock
  7286. ^- nock
  7287. ?: =([%1 &] dyr) [%1 |]
  7288. ?: =([%1 |] dyr) [%1 &]
  7289. ?: =([%0 0] dyr) dyr
  7290. [%6 dyr [%1 |] %1 &]
  7291. ::
  7292. ++ flor :: loobean |
  7293. ~/ %flor
  7294. |= [bos=nock nif=nock]
  7295. ^- nock
  7296. ?: ?| =(bos nif)
  7297. =([%1 &] bos)
  7298. =([%1 |] nif)
  7299. =([%0 0] bos)
  7300. ==
  7301. bos
  7302. ?: ?| =([%1 |] bos)
  7303. =([%1 &] nif)
  7304. =([%0 0] nif)
  7305. ==
  7306. nif
  7307. [%6 bos [%1 &] nif]
  7308. ::
  7309. ++ hike
  7310. ~/ %hike
  7311. |= [a=axis pac=(list (pair axis nock))]
  7312. |^ =/ rel=(map axis nock) (roll pac insert)
  7313. =/ ord=(list axis) (sort ~(tap in ~(key by rel)) gth)
  7314. |- ^- nock
  7315. ?~ ord
  7316. [%0 a]
  7317. =/ b=axis i.ord
  7318. =/ c=nock (~(got by rel) b)
  7319. =/ d=nock $(ord t.ord)
  7320. [%10 [b c] d]
  7321. ::
  7322. ++ contains
  7323. |= [container=axis contained=axis]
  7324. ^- ?
  7325. =/ big=@ (met 0 container)
  7326. =/ small=@ (met 0 contained)
  7327. ?: (lte small big) |
  7328. =/ dif=@ (sub small big)
  7329. =(container (rsh [0 dif] contained))
  7330. ::
  7331. ++ parent
  7332. |= a=axis
  7333. `axis`(rsh 0 a)
  7334. ::
  7335. ++ sibling
  7336. |= a=axis
  7337. ^- axis
  7338. ?~ (mod a 2)
  7339. +(a)
  7340. (dec a)
  7341. ::
  7342. ++ insert
  7343. |= [e=[axe=axis fol=nock] n=(map axis nock)]
  7344. ^- (map axis nock)
  7345. ?: =/ a=axis axe.e
  7346. |- ^- ?
  7347. ?: =(1 a) |
  7348. ?: (~(has by n) a)
  7349. &
  7350. $(a (parent a))
  7351. :: parent already in
  7352. n
  7353. =. n
  7354. :: remove children
  7355. %+ roll ~(tap by n)
  7356. |= [[axe=axis fol=nock] m=_n]
  7357. ?. (contains axe.e axe) m
  7358. (~(del by m) axe)
  7359. =/ sib (sibling axe.e)
  7360. =/ un (~(get by n) sib)
  7361. ?~ un (~(put by n) axe.e fol.e)
  7362. :: replace sibling with parent
  7363. %= $
  7364. n (~(del by n) sib)
  7365. e :- (parent sib)
  7366. ?: (gth sib axe.e)
  7367. (cons fol.e u.un)
  7368. (cons u.un fol.e)
  7369. ==
  7370. --
  7371. ::
  7372. ++ jock
  7373. |= rad=?
  7374. |= lot=coin ^- hoon
  7375. ?- -.lot
  7376. ~
  7377. ?:(rad [%rock p.lot] [%sand p.lot])
  7378. ::
  7379. %blob
  7380. ?: rad
  7381. [%rock %$ p.lot]
  7382. ?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)])
  7383. ::
  7384. %many
  7385. [%cltr (turn p.lot |=(a=coin ^$(lot a)))]
  7386. ==
  7387. ::
  7388. ++ look
  7389. ~/ %look
  7390. |= [cog=term dab=(map term hoon)]
  7391. =+ axe=1
  7392. |- ^- (unit [p=axis q=hoon])
  7393. ?- dab
  7394. ~ ~
  7395. ::
  7396. [* ~ ~]
  7397. ?:(=(cog p.n.dab) [~ axe q.n.dab] ~)
  7398. ::
  7399. [* ~ *]
  7400. ?: =(cog p.n.dab)
  7401. [~ (peg axe 2) q.n.dab]
  7402. ?: (gor cog p.n.dab)
  7403. ~
  7404. $(axe (peg axe 3), dab r.dab)
  7405. ::
  7406. [* * ~]
  7407. ?: =(cog p.n.dab)
  7408. [~ (peg axe 2) q.n.dab]
  7409. ?: (gor cog p.n.dab)
  7410. $(axe (peg axe 3), dab l.dab)
  7411. ~
  7412. ::
  7413. [* * *]
  7414. ?: =(cog p.n.dab)
  7415. [~ (peg axe 2) q.n.dab]
  7416. ?: (gor cog p.n.dab)
  7417. $(axe (peg axe 6), dab l.dab)
  7418. $(axe (peg axe 7), dab r.dab)
  7419. ==
  7420. ::
  7421. ++ loot
  7422. ~/ %loot
  7423. |= [cog=term dom=(map term tome)]
  7424. =+ axe=1
  7425. |- ^- (unit [p=axis q=hoon])
  7426. ?- dom
  7427. ~ ~
  7428. ::
  7429. [* ~ ~]
  7430. %+ bind (look cog q.q.n.dom)
  7431. |=((pair axis hoon) [(peg axe p) q])
  7432. ::
  7433. [* ~ *]
  7434. =+ yep=(look cog q.q.n.dom)
  7435. ?^ yep
  7436. [~ (peg (peg axe 2) p.u.yep) q.u.yep]
  7437. $(axe (peg axe 3), dom r.dom)
  7438. ::
  7439. [* * ~]
  7440. =+ yep=(look cog q.q.n.dom)
  7441. ?^ yep
  7442. [~ (peg (peg axe 2) p.u.yep) q.u.yep]
  7443. $(axe (peg axe 3), dom l.dom)
  7444. ::
  7445. [* * *]
  7446. =+ yep=(look cog q.q.n.dom)
  7447. ?^ yep
  7448. [~ (peg (peg axe 2) p.u.yep) q.u.yep]
  7449. =+ pey=$(axe (peg axe 6), dom l.dom)
  7450. ?^ pey pey
  7451. $(axe (peg axe 7), dom r.dom)
  7452. ==
  7453. ::
  7454. :: 5b: macro expansion
  7455. +| %macro-expansions
  7456. ::
  7457. ++ ah :: tiki engine
  7458. |_ tik=tiki
  7459. ++ blue
  7460. |= gen=hoon
  7461. ^- hoon
  7462. ?. &(?=(%| -.tik) ?=(~ p.tik)) gen
  7463. [%tsgr [%$ 3] gen]
  7464. ::
  7465. ++ teal
  7466. |= mod=spec
  7467. ^- spec
  7468. ?: ?=(%& -.tik) mod
  7469. [%over [%& 3]~ mod]
  7470. ::
  7471. ++ tele
  7472. |= syn=skin
  7473. ^- skin
  7474. ?: ?=(%& -.tik) syn
  7475. [%over [%& 3]~ syn]
  7476. ::
  7477. ++ gray
  7478. |= gen=hoon
  7479. ^- hoon
  7480. ?- -.tik
  7481. %& ?~(p.tik gen [%tstr [u.p.tik ~] [%wing q.tik] gen])
  7482. %| [%tsls ?~(p.tik q.tik [%ktts u.p.tik q.tik]) gen]
  7483. ==
  7484. ::
  7485. ++ puce
  7486. ^- wing
  7487. ?- -.tik
  7488. %& ?~(p.tik q.tik [u.p.tik ~])
  7489. %| [[%& 2] ~]
  7490. ==
  7491. ::
  7492. ++ wthp |= opt=(list (pair spec hoon))
  7493. %+ gray %wthp
  7494. [puce (turn opt |=([a=spec b=hoon] [a (blue b)]))]
  7495. ++ wtkt |=([sic=hoon non=hoon] (gray [%wtkt puce (blue sic) (blue non)]))
  7496. ++ wtls |= [gen=hoon opt=(list (pair spec hoon))]
  7497. %+ gray %wtls
  7498. [puce (blue gen) (turn opt |=([a=spec b=hoon] [a (blue b)]))]
  7499. ++ wtpt |=([sic=hoon non=hoon] (gray [%wtpt puce (blue sic) (blue non)]))
  7500. ++ wtsg |=([sic=hoon non=hoon] (gray [%wtsg puce (blue sic) (blue non)]))
  7501. ++ wthx |=(syn=skin (gray [%wthx (tele syn) puce]))
  7502. ++ wtts |=(mod=spec (gray [%wtts (teal mod) puce]))
  7503. --
  7504. ::
  7505. ++ ax
  7506. =+ :* :: .dom: axis to home
  7507. :: .hay: wing to home
  7508. :: .cox: hygienic context
  7509. :: .bug: debug annotations
  7510. :: .nut: annotations
  7511. :: .def: default expression
  7512. ::
  7513. dom=`axis`1
  7514. hay=*wing
  7515. cox=*(map term spec)
  7516. bug=*(list spot)
  7517. nut=*(unit note)
  7518. def=*(unit hoon)
  7519. ==
  7520. |_ mod=spec
  7521. ::
  7522. ++ autoname
  7523. :: derive name from spec
  7524. ::
  7525. |- ^- (unit term)
  7526. ?- -.mod
  7527. %base ?.(?=([%atom *] p.mod) ~ ?:(=(%$ p.p.mod) `%atom `p.p.mod))
  7528. %dbug $(mod q.mod)
  7529. %gist $(mod q.mod)
  7530. %leaf `p.mod
  7531. %loop `p.mod
  7532. %like ?~(p.mod ~ ?^(i.p.mod ?:(?=(%& -.i.p.mod) ~ q.i.p.mod) `i.p.mod))
  7533. %make ~(name ap p.mod)
  7534. %made $(mod q.mod)
  7535. %over $(mod q.mod)
  7536. %name $(mod q.mod)
  7537. ::
  7538. %bcbc $(mod p.mod)
  7539. %bcbr $(mod p.mod)
  7540. %bccb ~(name ap p.mod)
  7541. %bccl $(mod i.p.mod)
  7542. %bccn $(mod i.p.mod)
  7543. %bcdt ~
  7544. %bcgl $(mod q.mod)
  7545. %bcgr $(mod q.mod)
  7546. %bchp $(mod p.mod)
  7547. %bckt $(mod q.mod)
  7548. %bcls $(mod q.mod)
  7549. %bcfs ~
  7550. %bcmc ~(name ap p.mod)
  7551. %bcpm $(mod p.mod)
  7552. %bcsg $(mod q.mod)
  7553. %bctc ~
  7554. %bcts $(mod q.mod)
  7555. %bcpt $(mod q.mod)
  7556. %bcwt $(mod i.p.mod)
  7557. %bczp ~
  7558. ==
  7559. ::
  7560. ++ function
  7561. :: construct a function example
  7562. ::
  7563. |= [fun=spec arg=spec]
  7564. ^- hoon
  7565. :: minimal context as subject
  7566. ::
  7567. :+ %tsgr
  7568. :: context is example of both specs
  7569. ::
  7570. [example:clear(mod fun) example:clear(mod arg)]
  7571. :: produce an %iron (contravariant) core
  7572. ::
  7573. :- %ktbr
  7574. :: make an actual gate
  7575. ::
  7576. :+ %brcl
  7577. [%$ 2]
  7578. [%$ 15]
  7579. ::
  7580. ++ interface
  7581. :: construct a core example
  7582. ::
  7583. |= [variance=vair payload=spec arms=(map term spec)]
  7584. ^- hoon
  7585. :: attach proper variance control
  7586. ::
  7587. =- ?- variance
  7588. %gold -
  7589. %lead [%ktwt -]
  7590. %zinc [%ktpm -]
  7591. %iron [%ktbr -]
  7592. ==
  7593. ^- hoon
  7594. :+ %tsgr example:clear(mod payload)
  7595. :+ %brcn ~
  7596. =- [[%$ ~ -] ~ ~]
  7597. %- ~(gas by *(map term hoon))
  7598. %+ turn
  7599. ~(tap by arms)
  7600. |= [=term =spec]
  7601. ::
  7602. :: note that we *don't* make arm specs in an interface
  7603. :: hygienic -- we leave them in context, to support
  7604. :: maximum programmer flexibility
  7605. ::
  7606. [term example:clear(mod spec)]
  7607. ::
  7608. ++ home
  7609. :: express a hoon against the original subject
  7610. ::
  7611. |= gen=hoon
  7612. ^- hoon
  7613. =/ ,wing
  7614. ?: =(1 dom)
  7615. hay
  7616. (weld hay `wing`[[%& dom] ~])
  7617. ?~ - gen
  7618. [%tsgr [%wing -] gen]
  7619. ::
  7620. ++ clear
  7621. :: clear annotations
  7622. ^+ .
  7623. .(bug ~, def ~, nut ~)
  7624. ::
  7625. ++ basal
  7626. :: example base case
  7627. ::
  7628. |= bas=base
  7629. ?- bas
  7630. ::
  7631. [%atom *]
  7632. :: we may want sped
  7633. ::
  7634. [%sand p.bas ?:(=(%da p.bas) ~2000.1.1 0)]
  7635. ::
  7636. %noun
  7637. :: raw nock produces noun type
  7638. ::
  7639. =+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -])
  7640. ::
  7641. %cell
  7642. :: reduce to pair of nouns
  7643. ::
  7644. =+($(bas %noun) [- -])
  7645. ::
  7646. %flag
  7647. :: comparison produces boolean type
  7648. ::
  7649. =+([%rock %$ 0] [%ktls [%dtts - -] -])
  7650. ::
  7651. %null
  7652. [%rock %n 0]
  7653. ::
  7654. %void
  7655. [%zpzp ~]
  7656. ==
  7657. ::
  7658. ++ unfold
  7659. |= [fun=hoon arg=(list spec)]
  7660. ^- hoon
  7661. [%cncl fun (turn arg |=(spec ktcl/+<))]
  7662. ::
  7663. ++ unreel
  7664. |= [one=wing res=(list wing)]
  7665. ^- hoon
  7666. ?~(res [%wing one] [%tsgl [%wing one] $(one i.res, res t.res)])
  7667. ::
  7668. ++ descend
  7669. :: record an axis to original subject
  7670. ::
  7671. |= axe=axis
  7672. +>(dom (peg axe dom))
  7673. ::
  7674. ++ decorate
  7675. :: apply documentation to expression
  7676. ::
  7677. |= gen=hoon
  7678. ^- hoon
  7679. =- ?~(nut - [%note u.nut -])
  7680. |-
  7681. ?~(bug gen [%dbug i.bug $(bug t.bug)])
  7682. ::
  7683. ++ pieces
  7684. :: enumerate tuple wings
  7685. ::
  7686. |= =(list term)
  7687. ^- (^list wing)
  7688. (turn list |=(=term `wing`[term ~]))
  7689. ::
  7690. ++ spore
  7691. :: build default sample
  7692. ::
  7693. ^- hoon
  7694. :: sample is always typeless
  7695. ::
  7696. :+ %ktls
  7697. [%bust %noun]
  7698. :: consume debugging context
  7699. ::
  7700. %- decorate
  7701. :: use home as subject
  7702. ::
  7703. %- home
  7704. :: if default is set, use it
  7705. ::
  7706. ?^ def u.def
  7707. :: else map structure to expression
  7708. ::
  7709. ~+
  7710. |- ^- hoon
  7711. ?- mod
  7712. [%base *] ?:(=(%void p.mod) [%rock %n 0] (basal p.mod))
  7713. [%bcbc *] :: track hygienic recursion points lexically
  7714. ::
  7715. %= $
  7716. mod p.mod
  7717. cox :: merge lexically and don't forget %$
  7718. ::
  7719. (~(put by ^+(cox (~(uni by cox) q.mod))) %$ p.mod)
  7720. ==
  7721. [%dbug *] [%dbug p.mod $(mod q.mod)]
  7722. [%gist *] $(mod q.mod)
  7723. [%leaf *] [%rock p.mod q.mod]
  7724. [%loop *] ~|([%loop p.mod] $(mod (~(got by cox) p.mod)))
  7725. [%like *] $(mod bcmc/(unreel p.mod q.mod))
  7726. [%made *] $(mod q.mod)
  7727. [%make *] $(mod bcmc/(unfold p.mod q.mod))
  7728. [%name *] $(mod q.mod)
  7729. [%over *] $(hay p.mod, mod q.mod)
  7730. ::
  7731. [%bcbr *] $(mod p.mod)
  7732. [%bccb *] [%rock %n 0]
  7733. [%bccl *] |- ^- hoon
  7734. ?~ t.p.mod ^$(mod i.p.mod)
  7735. :- ^$(mod i.p.mod)
  7736. $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
  7737. [%bccn *] :: use last entry
  7738. ::
  7739. |- ^- hoon
  7740. ?~ t.p.mod ^$(mod i.p.mod)
  7741. $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
  7742. [%bchp *] :: see under %bccb
  7743. ::
  7744. [%rock %n 0]
  7745. [%bcgl *] $(mod q.mod)
  7746. [%bcgr *] $(mod q.mod)
  7747. [%bckt *] $(mod q.mod)
  7748. [%bcls *] [%note [%know p.mod] $(mod q.mod)]
  7749. [%bcmc *] :: borrow sample
  7750. ::
  7751. [%tsgl [%$ 6] p.mod]
  7752. [%bcpm *] $(mod p.mod)
  7753. [%bcsg *] [%kthp q.mod p.mod]
  7754. [%bcts *] [%ktts p.mod $(mod q.mod)]
  7755. [%bcpt *] $(mod p.mod)
  7756. [%bcwt *] :: use last entry
  7757. ::
  7758. |- ^- hoon
  7759. ?~ t.p.mod ^$(mod i.p.mod)
  7760. $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
  7761. [%bcdt *] [%rock %n 0]
  7762. [%bcfs *] [%rock %n 0]
  7763. [%bctc *] [%rock %n 0]
  7764. [%bczp *] [%rock %n 0]
  7765. ==
  7766. ::
  7767. ++ example
  7768. :: produce a correctly typed default instance
  7769. ::
  7770. ~+
  7771. ^- hoon
  7772. ?+ mod
  7773. :: in the general case, make and analyze a spore
  7774. ::
  7775. :+ %tsls
  7776. spore
  7777. ~(relative analyze:(descend 3) 2)
  7778. ::
  7779. [%base *] (decorate (basal p.mod))
  7780. [%dbug *] example(mod q.mod, bug [p.mod bug])
  7781. [%gist *] example(mod q.mod, nut `p.mod)
  7782. [%leaf *] (decorate [%rock p.mod q.mod])
  7783. [%like *] example(mod bcmc/(unreel p.mod q.mod))
  7784. [%loop *] [%limb p.mod]
  7785. [%made *] example(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)])
  7786. [%make *] example(mod bcmc/(unfold p.mod q.mod))
  7787. [%name *] example(mod q.mod, nut `made/[p.mod ~])
  7788. [%over *] example(hay p.mod, mod q.mod)
  7789. ::
  7790. [%bccb *] (decorate (home p.mod))
  7791. [%bccl *] %- decorate
  7792. |- ^- hoon
  7793. ?~ t.p.mod
  7794. example:clear(mod i.p.mod)
  7795. :- example:clear(mod i.p.mod)
  7796. example:clear(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
  7797. [%bchp *] (decorate (function:clear p.mod q.mod))
  7798. [%bcmc *] (decorate (home [%tsgl [%limb %$] p.mod]))
  7799. [%bcsg *] [%ktls example(mod q.mod) (home p.mod)]
  7800. [%bcls *] (decorate [%note [%know p.mod] example(mod q.mod)])
  7801. [%bcts *] (decorate [%ktts p.mod example:clear(mod q.mod)])
  7802. [%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
  7803. [%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
  7804. [%bczp *] (decorate (home (interface %lead p.mod q.mod)))
  7805. [%bctc *] (decorate (home (interface %zinc p.mod q.mod)))
  7806. ==
  7807. ::
  7808. ++ factory
  7809. :: make a normalizing gate (mold)
  7810. ::
  7811. ^- hoon
  7812. :: process annotations outside construct, to catch default
  7813. ::
  7814. ::TODO: try seeing if putting %gist in here fixes %brbc
  7815. ?: ?=(%dbug -.mod) factory(mod q.mod, bug [p.mod bug])
  7816. ?: ?=(%bcsg -.mod) factory(mod q.mod, def `[%kthp q.mod p.mod])
  7817. ^- hoon
  7818. :: if we recognize an indirection
  7819. ::
  7820. ?: &(=(~ def) ?=(?(%bcmc %like %loop %make) -.mod))
  7821. :: then short-circuit it
  7822. ::
  7823. %- decorate
  7824. %- home
  7825. ?- -.mod
  7826. %bcmc p.mod
  7827. %like (unreel p.mod q.mod)
  7828. %loop [%limb p.mod]
  7829. %make (unfold p.mod q.mod)
  7830. ==
  7831. :: else build a gate
  7832. ::
  7833. :+ %brcl
  7834. [%ktsg spore]
  7835. :+ %tsls
  7836. ~(relative analyze:(descend 7) 6)
  7837. :: trigger unifying equality
  7838. ::
  7839. :+ %tsls [%dtts $/14 $/2]
  7840. $/6
  7841. ::
  7842. ++ analyze
  7843. :: normalize a fragment of the subject
  7844. ::
  7845. |_ $: :: axe: axis to fragment
  7846. ::
  7847. axe=axis
  7848. ==
  7849. ++ basic
  7850. |= bas=base
  7851. ^- hoon
  7852. ?- bas
  7853. [%atom *]
  7854. :+ %ktls example
  7855. ^- hoon
  7856. :^ %zppt
  7857. [[[%| 0 `%ruth] ~] ~]
  7858. [%cnls [%limb %ruth] [%sand %ta p.bas] fetch]
  7859. [%wtpt fetch-wing fetch [%zpzp ~]]
  7860. ::
  7861. %cell
  7862. :+ %ktls example
  7863. =+ fetch-wing
  7864. :- [%wing [[%& %2] -]]
  7865. [%wing [[%& %3] -]]
  7866. ::
  7867. %flag
  7868. :^ %wtcl
  7869. [%dtts [%rock %$ &] [%$ axe]]
  7870. [%rock %f &]
  7871. :+ %wtgr
  7872. [%dtts [%rock %$ |] [%$ axe]]
  7873. [%rock %f |]
  7874. ::
  7875. %noun
  7876. fetch
  7877. ::
  7878. %null
  7879. :+ %wtgr
  7880. [%dtts [%bust %noun] [%$ axe]]
  7881. [%rock %n ~]
  7882. :::
  7883. %void
  7884. [%zpzp ~]
  7885. ==
  7886. ++ clear
  7887. .(..analyze ^clear)
  7888. ::
  7889. ++ fetch
  7890. :: load the fragment
  7891. ::
  7892. ^- hoon
  7893. [%$ axe]
  7894. ::
  7895. ++ fetch-wing
  7896. :: load, as a wing
  7897. ::
  7898. ^- wing
  7899. [[%& axe] ~]
  7900. ::
  7901. ++ choice
  7902. :: match full models, by trying them
  7903. ::
  7904. |= $: :: one: first option
  7905. :: rep: other options
  7906. ::
  7907. one=spec
  7908. rep=(list spec)
  7909. ==
  7910. ^- hoon
  7911. :: if no other choices, construct head
  7912. ::
  7913. ?~ rep relative:clear(mod one)
  7914. :: build test
  7915. ::
  7916. :^ %wtcl
  7917. :: if we fit the type of this choice
  7918. ::
  7919. [%fits example:clear(mod one) fetch-wing]
  7920. :: build with this choice
  7921. ::
  7922. relative:clear(mod one)
  7923. :: continue through loop
  7924. ::
  7925. $(one i.rep, rep t.rep)
  7926. ::
  7927. ++ switch
  7928. |= $: :: one: first format
  7929. :: two: more formats
  7930. ::
  7931. one=spec
  7932. rep=(list spec)
  7933. ==
  7934. |- ^- hoon
  7935. :: if no other choices, construct head
  7936. ::
  7937. ?~ rep relative:clear(mod one)
  7938. :: fin: loop completion
  7939. ::
  7940. =/ fin=hoon $(one i.rep, rep t.rep)
  7941. :: interrogate this instance
  7942. ::
  7943. :^ %wtcl
  7944. :: test if the head matches this wing
  7945. ::
  7946. :+ %fits
  7947. [%tsgl [%$ 2] example:clear(mod one)]
  7948. fetch-wing(axe (peg axe 2))
  7949. :: if so, use this form
  7950. ::
  7951. relative:clear(mod one)
  7952. :: continue in the loop
  7953. ::
  7954. fin
  7955. ::
  7956. ++ relative
  7957. :: local constructor
  7958. ::
  7959. ~+
  7960. ^- hoon
  7961. ?- mod
  7962. ::
  7963. :: base
  7964. ::
  7965. [%base *]
  7966. (decorate (basic:clear p.mod))
  7967. ::
  7968. :: debug
  7969. ::
  7970. [%dbug *]
  7971. relative(mod q.mod, bug [p.mod bug])
  7972. ::
  7973. :: formal comment
  7974. ::
  7975. [%gist *]
  7976. relative(mod q.mod, nut `p.mod)
  7977. ::
  7978. :: constant
  7979. ::
  7980. [%leaf *]
  7981. %- decorate
  7982. :+ %wtgr
  7983. [%dtts fetch [%rock %$ q.mod]]
  7984. [%rock p.mod q.mod]
  7985. ::
  7986. :: composite
  7987. ::
  7988. [%make *]
  7989. relative(mod bcmc/(unfold p.mod q.mod))
  7990. ::
  7991. :: indirect
  7992. ::
  7993. [%like *]
  7994. relative(mod bcmc/(unreel p.mod q.mod))
  7995. ::
  7996. :: loop
  7997. ::
  7998. [%loop *]
  7999. (decorate [%cnhp [%limb p.mod] fetch])
  8000. ::
  8001. :: simple named structure
  8002. ::
  8003. [%name *]
  8004. relative(mod q.mod, nut `made/[p.mod ~])
  8005. ::
  8006. :: synthetic named structure
  8007. ::
  8008. [%made *]
  8009. relative(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)])
  8010. ::
  8011. :: subjective
  8012. ::
  8013. [%over *]
  8014. relative(hay p.mod, mod q.mod)
  8015. ::
  8016. :: recursive, $$
  8017. ::
  8018. [%bcbc *]
  8019. ::
  8020. :: apply semantically
  8021. ::
  8022. :+ %brkt
  8023. relative(mod p.mod, dom (peg 3 dom))
  8024. =- [[%$ ~ -] ~ ~]
  8025. %- ~(gas by *(map term hoon))
  8026. ^- (list (pair term hoon))
  8027. %+ turn
  8028. ~(tap by q.mod)
  8029. |= [=term =spec]
  8030. [term relative(mod spec, dom (peg 3 dom))]
  8031. ::
  8032. :: normalize, $&
  8033. ::
  8034. [%bcpm *]
  8035. :: push the raw result
  8036. ::
  8037. :+ %tsls relative(mod p.mod)
  8038. :: push repair function
  8039. ::
  8040. :+ %tsls
  8041. [%tsgr $/3 q.mod]
  8042. :: push repaired product
  8043. ::
  8044. :+ %tsls
  8045. [%cnhp $/2 $/6]
  8046. :: sanity-check repaired product
  8047. ::
  8048. :+ %wtgr
  8049. :: either
  8050. ::
  8051. :~ %wtbr
  8052. :: the repair did not change anything
  8053. ::
  8054. [%dtts $/14 $/2]
  8055. :: when we fix it again, it stays fixed
  8056. ::
  8057. [%dtts $/2 [%cnhp $/6 $/2]]
  8058. ==
  8059. $/2
  8060. ::
  8061. :: verify, $|
  8062. ::
  8063. [%bcbr *]
  8064. ^- hoon
  8065. :: push the raw product
  8066. ::
  8067. :+ %tsls relative(mod p.mod)
  8068. ^- hoon
  8069. :: assert
  8070. ::
  8071. :+ %wtgr
  8072. :: run the verifier
  8073. ::
  8074. [%cnhp [%tsgr $/3 q.mod] $/2]
  8075. :: produce verified product
  8076. ::
  8077. $/2
  8078. ::
  8079. :: special, $_
  8080. ::
  8081. [%bccb *]
  8082. (decorate (home p.mod))
  8083. ::
  8084. :: switch, $%
  8085. ::
  8086. [%bccn *]
  8087. (decorate (switch i.p.mod t.p.mod))
  8088. ::
  8089. :: tuple, $:
  8090. ::
  8091. [%bccl *]
  8092. %- decorate
  8093. |- ^- hoon
  8094. ?~ t.p.mod
  8095. relative:clear(mod i.p.mod)
  8096. :- relative:clear(mod i.p.mod, axe (peg axe 2))
  8097. %= relative
  8098. i.p.mod i.t.p.mod
  8099. t.p.mod t.t.p.mod
  8100. axe (peg axe 3)
  8101. ==
  8102. ::
  8103. :: exclude, $<
  8104. ::
  8105. [%bcgl *]
  8106. :+ %tsls
  8107. relative:clear(mod q.mod)
  8108. :+ %wtgl
  8109. [%wtts [%over ~[&/3] p.mod] ~[&/4]]
  8110. $/2
  8111. ::
  8112. :: require, $>
  8113. ::
  8114. [%bcgr *]
  8115. :+ %tsls
  8116. relative:clear(mod q.mod)
  8117. :+ %wtgr
  8118. [%wtts [%over ~[&/3] p.mod] ~[&/4]]
  8119. $/2
  8120. ::
  8121. :: function
  8122. ::
  8123. [%bchp *]
  8124. %- decorate
  8125. =/ fun (function:clear p.mod q.mod)
  8126. ?^ def
  8127. [%ktls fun u.def]
  8128. fun
  8129. ::
  8130. :: bridge, $^
  8131. ::
  8132. [%bckt *]
  8133. %- decorate
  8134. :^ %wtcl
  8135. [%dtwt fetch(axe (peg axe 2))]
  8136. relative:clear(mod p.mod)
  8137. relative:clear(mod q.mod)
  8138. ::
  8139. :: synthesis, $;
  8140. ::
  8141. [%bcmc *]
  8142. (decorate [%cncl (home p.mod) fetch ~])
  8143. ::
  8144. :: default
  8145. ::
  8146. [%bcsg *]
  8147. relative(mod q.mod, def `[%kthp q.mod p.mod])
  8148. ::
  8149. :: choice, $?
  8150. ::
  8151. [%bcwt *]
  8152. (decorate (choice i.p.mod t.p.mod))
  8153. ::
  8154. :: name, $=
  8155. ::
  8156. [%bcts *]
  8157. [%ktts p.mod relative(mod q.mod)]
  8158. ::
  8159. :: branch, $@
  8160. ::
  8161. [%bcpt *]
  8162. %- decorate
  8163. :^ %wtcl
  8164. [%dtwt fetch]
  8165. relative:clear(mod q.mod)
  8166. relative:clear(mod p.mod)
  8167. ::
  8168. [%bcls *] [%note [%know p.mod] relative(mod q.mod)]
  8169. [%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
  8170. [%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
  8171. [%bczp *] (decorate (home (interface %lead p.mod q.mod)))
  8172. [%bctc *] (decorate (home (interface %zinc p.mod q.mod)))
  8173. ==
  8174. --
  8175. --
  8176. ::
  8177. ++ ap :: hoon engine
  8178. ~% %ap
  8179. +>+
  8180. ==
  8181. %open open
  8182. %rake rake
  8183. ==
  8184. |_ gen=hoon
  8185. ::
  8186. ++ grip
  8187. |= =skin
  8188. =| rel=wing
  8189. |- ^- hoon
  8190. ?- skin
  8191. @
  8192. [%tsgl [%tune skin] gen]
  8193. [%base *]
  8194. ?: ?=(%noun base.skin)
  8195. gen
  8196. [%kthp skin gen]
  8197. ::
  8198. [%cell *]
  8199. =+ haf=~(half ap gen)
  8200. ?^ haf
  8201. :- $(skin skin.skin, gen p.u.haf)
  8202. $(skin ^skin.skin, gen q.u.haf)
  8203. :+ %tsls
  8204. gen
  8205. :- $(skin skin.skin, gen [%$ 4])
  8206. $(skin ^skin.skin, gen [%$ 5])
  8207. ::
  8208. [%dbug *]
  8209. [%dbug spot.skin $(skin skin.skin)]
  8210. ::
  8211. [%leaf *]
  8212. [%kthp skin gen]
  8213. ::
  8214. [%help *]
  8215. [%note [%help help.skin] $(skin skin.skin)]
  8216. ::
  8217. [%name *]
  8218. [%tsgl [%tune term.skin] $(skin skin.skin)]
  8219. ::
  8220. [%over *]
  8221. $(skin skin.skin, rel (weld wing.skin rel))
  8222. ::
  8223. [%spec *]
  8224. :+ %kthp
  8225. ?~(rel spec.skin [%over rel spec.skin])
  8226. $(skin skin.skin)
  8227. ::
  8228. [%wash *]
  8229. :+ %tsgl
  8230. :- %wing
  8231. |- ^- wing
  8232. ?: =(0 depth.skin) ~
  8233. [[%| 0 ~] $(depth.skin (dec depth.skin))]
  8234. gen
  8235. ==
  8236. ::
  8237. ++ name
  8238. |- ^- (unit term)
  8239. ?+ gen ~
  8240. [%wing *] ?~ p.gen ~
  8241. ?^ i.p.gen
  8242. ?:(?=(%& -.i.p.gen) ~ q.i.p.gen)
  8243. `i.p.gen
  8244. [%limb *] `p.gen
  8245. [%dbug *] $(gen ~(open ap gen))
  8246. [%tsgl *] $(gen ~(open ap gen))
  8247. [%tsgr *] $(gen q.gen)
  8248. ==
  8249. ::
  8250. ++ feck
  8251. |- ^- (unit term)
  8252. ?- gen
  8253. [%sand %tas @] [~ q.gen]
  8254. [%dbug *] $(gen q.gen)
  8255. * ~
  8256. ==
  8257. ::
  8258. :: not used at present; see comment at %csng in ++open
  8259. ::::
  8260. ::++ hail
  8261. :: |= axe=axis
  8262. :: =| air=(list (pair wing hoon))
  8263. :: |- ^+ air
  8264. :: =+ hav=half
  8265. :: ?~ hav [[[[%| 0 ~] [%& axe] ~] gen] air]
  8266. :: $(gen p.u.hav, axe (peg axe 2), air $(gen q.u.hav, axe (peg axe 3)))
  8267. ::
  8268. ++ half
  8269. |- ^- (unit (pair hoon hoon))
  8270. ?+ gen ~
  8271. [^ *] `[p.gen q.gen]
  8272. [%dbug *] $(gen q.gen)
  8273. [%clcb *] `[q.gen p.gen]
  8274. [%clhp *] `[p.gen q.gen]
  8275. [%clkt *] `[p.gen %clls q.gen r.gen s.gen]
  8276. [%clsg *] ?~(p.gen ~ `[i.p.gen %clsg t.p.gen])
  8277. [%cltr *] ?~ p.gen ~
  8278. ?~(t.p.gen $(gen i.p.gen) `[i.p.gen %cltr t.p.gen])
  8279. ==
  8280. ::::
  8281. :: +flay: hoon to skin
  8282. ::
  8283. ++ flay
  8284. |- ^- (unit skin)
  8285. ?+ gen
  8286. =+(open ?:(=(- gen) ~ $(gen -)))
  8287. ::
  8288. [^ *]
  8289. =+ [$(gen p.gen) $(gen q.gen)]
  8290. ?~(-< ~ ?~(-> ~ `[%cell -<+ ->+]))
  8291. ::
  8292. [%base *]
  8293. `gen
  8294. ::
  8295. [%rock *]
  8296. ?@(q.gen `[%leaf p.gen q.gen] ~)
  8297. ::
  8298. [%cnts [@ ~] ~]
  8299. `i.p.gen
  8300. ::
  8301. [%tsgr *]
  8302. %+ biff reek(gen p.gen)
  8303. |= =wing
  8304. (bind ^$(gen q.gen) |=(=skin [%over wing skin]))
  8305. ::
  8306. [%limb @]
  8307. `p.gen
  8308. ::
  8309. [%note [%help *] *]
  8310. (bind $(gen q.gen) |=(=skin [%help p.p.gen skin]))
  8311. ::
  8312. [%wing *]
  8313. ?: ?=([@ ~] p.gen)
  8314. `i.p.gen
  8315. =/ depth 0
  8316. |- ^- (unit skin)
  8317. ?~ p.gen `[%wash depth]
  8318. ?. =([%| 0 ~] i.p.gen) ~
  8319. $(p.gen t.p.gen)
  8320. ::
  8321. [%kttr *]
  8322. `[%spec p.gen %base %noun]
  8323. ::
  8324. [%ktts *]
  8325. %+ biff $(gen q.gen)
  8326. |= =skin
  8327. ?@ p.gen `[%name p.gen skin]
  8328. ?. ?=([%name @ [%base %noun]] p.gen) ~
  8329. `[%name term.p.gen skin]
  8330. ==
  8331. ::
  8332. :: +open: desugarer
  8333. ++ open
  8334. ^- hoon
  8335. ?- gen
  8336. [~ *] [%cnts [[%& p.gen] ~] ~]
  8337. ::
  8338. [%base *] ~(factory ax `spec`gen)
  8339. [%bust *] ~(example ax %base p.gen)
  8340. [%ktcl *] ~(factory ax p.gen)
  8341. [%dbug *] q.gen
  8342. [%eror *] ~_((crip p.gen) !!)
  8343. ::
  8344. [%knit *] ::
  8345. :+ %tsgr [%ktts %v %$ 1] :: => v=.
  8346. :- %brhp :: |-
  8347. :+ %ktls :: ^+
  8348. :- %brhp :: |-
  8349. :^ %wtcl :: ?:
  8350. [%bust %flag] :: ?
  8351. [%bust %null] :: ~
  8352. :- [%ktts %i [%sand 'tD' *@]] :: :- i=~~
  8353. [%ktts %t [%limb %$]] :: t=$
  8354. |- ^- hoon ::
  8355. ?~ p.gen ::
  8356. [%bust %null] :: ~
  8357. =+ res=$(p.gen t.p.gen) ::
  8358. ^- hoon ::
  8359. ?@ i.p.gen ::
  8360. [[%sand 'tD' i.p.gen] res] :: [~~{i.p.gen} {res}]
  8361. :+ %tsls ::
  8362. :- :+ %ktts :: ^=
  8363. %a :: a
  8364. :+ %ktls :: ^+
  8365. [%limb %$] :: $
  8366. [%tsgr [%limb %v] p.i.p.gen] :: =>(v {p.i.p.gen})
  8367. [%ktts %b res] :: b=[res]
  8368. ^- hoon ::
  8369. :- %brhp :: |-
  8370. :^ %wtpt :: ?@
  8371. [%a ~] :: a
  8372. [%limb %b] :: b
  8373. :- [%tsgl [%$ 2] [%limb %a]] :: :- -.a
  8374. :+ %cnts :: %=
  8375. [%$ ~] :: $
  8376. [[[%a ~] [%tsgl [%$ 3] [%limb %a]]] ~] :: a +.a
  8377. ::
  8378. [%leaf *] ~(factory ax `spec`gen)
  8379. [%limb *] [%cnts [p.gen ~] ~]
  8380. [%tell *] [%cncl [%limb %noah] [%zpgr [%cltr p.gen]] ~]
  8381. [%wing *] [%cnts p.gen ~]
  8382. [%yell *] [%cncl [%limb %cain] [%zpgr [%cltr p.gen]] ~]
  8383. [%note *] q.gen
  8384. ::
  8385. ::TODO: does %gist need to be special cased here?
  8386. [%brbc *] =- ?~ - !!
  8387. :+ %brtr
  8388. [%bccl -]
  8389. |-
  8390. ?. ?=([%gist *] body.gen)
  8391. [%ktcl body.gen]
  8392. [%note p.body.gen $(body.gen q.body.gen)]
  8393. %+ turn `(list term)`sample.gen
  8394. |= =term
  8395. ^- spec
  8396. =/ tar [%base %noun]
  8397. [%bcts term [%bcsg tar [%bchp tar tar]]]
  8398. [%brcb *] :+ %tsls [%kttr p.gen]
  8399. :+ %brcn ~
  8400. %- ~(run by r.gen)
  8401. |= =tome
  8402. :- p.tome
  8403. %- ~(run by q.tome)
  8404. |= =hoon
  8405. ?~ q.gen hoon
  8406. [%tstr [p.i.q.gen ~] q.i.q.gen $(q.gen t.q.gen)]
  8407. [%brcl *] [%tsls p.gen [%brdt q.gen]]
  8408. [%brdt *] :+ %brcn ~
  8409. =- [[%$ ~ -] ~ ~]
  8410. (~(put by *(map term hoon)) %$ p.gen)
  8411. [%brkt *] :+ %tsgl [%limb %$]
  8412. :+ %brcn ~
  8413. =+ zil=(~(get by q.gen) %$)
  8414. ?~ zil
  8415. %+ ~(put by q.gen) %$
  8416. [*what [[%$ p.gen] ~ ~]]
  8417. %+ ~(put by q.gen) %$
  8418. [p.u.zil (~(put by q.u.zil) %$ p.gen)]
  8419. [%brhp *] [%tsgl [%limb %$] [%brdt p.gen]]
  8420. [%brsg *] [%ktbr [%brts p.gen q.gen]]
  8421. [%brtr *] :+ %tsls [%kttr p.gen]
  8422. :+ %brpt ~
  8423. =- [[%$ ~ -] ~ ~]
  8424. (~(put by *(map term hoon)) %$ q.gen)
  8425. [%brts *] :+ %brcb p.gen
  8426. =- [~ [[%$ ~ -] ~ ~]]
  8427. (~(put by *(map term hoon)) %$ q.gen)
  8428. [%brwt *] [%ktwt %brdt p.gen]
  8429. ::
  8430. [%clkt *] [p.gen q.gen r.gen s.gen]
  8431. [%clls *] [p.gen q.gen r.gen]
  8432. [%clcb *] [q.gen p.gen]
  8433. [%clhp *] [p.gen q.gen]
  8434. [%clsg *]
  8435. |- ^- hoon
  8436. ?~ p.gen
  8437. [%rock %n ~]
  8438. [i.p.gen $(p.gen t.p.gen)]
  8439. ::
  8440. [%cltr *]
  8441. |- ^- hoon
  8442. ?~ p.gen
  8443. [%zpzp ~]
  8444. ?~ t.p.gen
  8445. i.p.gen
  8446. [i.p.gen $(p.gen t.p.gen)]
  8447. ::
  8448. [%kttr *] [%ktsg ~(example ax p.gen)]
  8449. [%cncb *] [%ktls [%wing p.gen] %cnts p.gen q.gen]
  8450. [%cndt *] [%cncl q.gen [p.gen ~]]
  8451. [%cnkt *] [%cncl p.gen q.gen r.gen s.gen ~]
  8452. [%cnls *] [%cncl p.gen q.gen r.gen ~]
  8453. [%cnhp *] [%cncl p.gen q.gen ~]
  8454. :: this probably should work, but doesn't
  8455. ::
  8456. :: [%cncl *] [%cntr [%$ ~] p.gen [[[[%& 6] ~] [%cltr q.gen]] ~]]
  8457. [%cncl *] [%cnsg [%$ ~] p.gen q.gen]
  8458. [%cnsg *]
  8459. :: this complex matching system is a leftover from the old
  8460. :: "electroplating" era. %cnsg should be removed and replaced
  8461. :: with the commented-out %cncl above. but something is broken.
  8462. ::
  8463. :^ %cntr p.gen q.gen
  8464. =+ axe=6
  8465. |- ^- (list [wing hoon])
  8466. ?~ r.gen ~
  8467. ?~ t.r.gen [[[[%| 0 ~] [%& axe] ~] i.r.gen] ~]
  8468. :- [[[%| 0 ~] [%& (peg axe 2)] ~] i.r.gen]
  8469. $(axe (peg axe 3), r.gen t.r.gen)
  8470. ::
  8471. [%cntr *]
  8472. ?: =(~ r.gen)
  8473. [%tsgr q.gen [%wing p.gen]]
  8474. :+ %tsls
  8475. q.gen
  8476. :+ %cnts
  8477. (weld p.gen `wing`[[%& 2] ~])
  8478. (turn r.gen |=([p=wing q=hoon] [p [%tsgr [%$ 3] q]]))
  8479. ::
  8480. [%ktdt *] [%ktls [%cncl p.gen q.gen ~] q.gen]
  8481. [%kthp *] [%ktls ~(example ax p.gen) q.gen]
  8482. [%ktts *] (grip(gen q.gen) p.gen)
  8483. ::
  8484. [%sgbr *]
  8485. :+ %sggr
  8486. :- %mean
  8487. =+ fek=~(feck ap p.gen)
  8488. ?^ fek [%rock %tas u.fek]
  8489. [%brdt [%cncl [%limb %cain] [%zpgr [%tsgr [%$ 3] p.gen]] ~]]
  8490. q.gen
  8491. ::
  8492. [%sgcb *] [%sggr [%mean [%brdt p.gen]] q.gen]
  8493. [%sgcn *]
  8494. :+ %sggl
  8495. :- %fast
  8496. :- %clls
  8497. :+ [%rock %$ p.gen]
  8498. [%zpts q.gen]
  8499. :- %clsg
  8500. =+ nob=`(list hoon)`~
  8501. |- ^- (list hoon)
  8502. ?~ r.gen
  8503. nob
  8504. [[[%rock %$ p.i.r.gen] [%zpts q.i.r.gen]] $(r.gen t.r.gen)]
  8505. s.gen
  8506. ::
  8507. [%sgfs *] [%sgcn p.gen [%$ 7] ~ q.gen]
  8508. [%sggl *] [%tsgl [%sggr p.gen [%$ 1]] q.gen]
  8509. [%sgbc *] [%sggr [%live [%rock %$ p.gen]] q.gen]
  8510. [%sgls *] [%sggr [%memo %rock %$ p.gen] q.gen]
  8511. [%sgpm *]
  8512. :+ %sggr
  8513. [%slog [%sand %$ p.gen] [%cncl [%limb %cain] [%zpgr q.gen] ~]]
  8514. r.gen
  8515. ::
  8516. [%sgts *] [%sggr [%germ p.gen] q.gen]
  8517. [%sgwt *]
  8518. :+ %tsls [%wtdt q.gen [%bust %null] [[%bust %null] r.gen]]
  8519. :^ %wtsg [%& 2]~
  8520. [%tsgr [%$ 3] s.gen]
  8521. [%sgpm p.gen [%$ 5] [%tsgr [%$ 3] s.gen]]
  8522. ::
  8523. [%mcts *]
  8524. |-
  8525. ?~ p.gen [%bust %null]
  8526. ?- -.i.p.gen
  8527. ^ [[%xray i.p.gen] $(p.gen t.p.gen)]
  8528. %manx [p.i.p.gen $(p.gen t.p.gen)]
  8529. %tape [[%mcfs p.i.p.gen] $(p.gen t.p.gen)]
  8530. %call [%cncl p.i.p.gen [$(p.gen t.p.gen)]~]
  8531. %marl =- [%cndt [p.i.p.gen $(p.gen t.p.gen)] -]
  8532. ^- hoon
  8533. :+ %tsbr [%base %cell]
  8534. :+ %brpt ~
  8535. ^- (map term tome)
  8536. =- [[%$ ~ -] ~ ~]
  8537. ^- (map term hoon)
  8538. :_ [~ ~]
  8539. =+ sug=[[%& 12] ~]
  8540. :- %$
  8541. :^ %wtsg sug
  8542. [%cnts sug [[[[%& 1] ~] [%$ 13]] ~]]
  8543. [%cnts sug [[[[%& 3] ~] [%cnts [%$ ~] [[sug [%$ 25]] ~]]] ~]]
  8544. ==
  8545. ::
  8546. [%mccl *]
  8547. ?- q.gen
  8548. ~ [%zpzp ~]
  8549. [* ~] i.q.gen
  8550. ^
  8551. :+ %tsls
  8552. p.gen
  8553. =+ yex=`(list hoon)`q.gen
  8554. |- ^- hoon
  8555. ?- yex
  8556. [* ~] [%tsgr [%$ 3] i.yex]
  8557. [* ^] [%cncl [%$ 2] [%tsgr [%$ 3] i.yex] $(yex t.yex) ~]
  8558. ~ !!
  8559. ==
  8560. ==
  8561. ::
  8562. [%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
  8563. [%mcgl *] [%cnls [%cnhp q ktcl+p] r [%brts p [%tsgr $+3 s]]]:gen
  8564. ::
  8565. [%mcsg *] :: ;~
  8566. |- ^- hoon
  8567. ?- q.gen
  8568. ~ ~_(leaf+"open-mcsg" !!)
  8569. ^
  8570. :+ %tsgr [%ktts %v %$ 1] :: => v=.
  8571. |- ^- hoon ::
  8572. ?: ?=(~ t.q.gen) ::
  8573. [%tsgr [%limb %v] i.q.gen] :: =>(v {i.q.gen})
  8574. :+ %tsls [%ktts %a $(q.gen t.q.gen)] :: =+ ^= a
  8575. :+ %tsls :: {$(q.gen t.q.gen)}
  8576. [%ktts %b [%tsgr [%limb %v] i.q.gen]] :: =+ ^= b
  8577. :+ %tsls :: =>(v {i.q.gen})
  8578. :+ %ktts %c :: =+ c=,.+6.b
  8579. :+ %tsgl ::
  8580. [%wing [%| 0 ~] [%& 6] ~] ::
  8581. [%limb %b] ::
  8582. :- %brdt :: |.
  8583. :^ %cnls :: %+
  8584. [%tsgr [%limb %v] p.gen] :: =>(v {p.gen})
  8585. [%cncl [%limb %b] [%limb %c] ~] :: (b c)
  8586. :+ %cnts [%a ~] :: a(,.+6 c)
  8587. [[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] ::
  8588. == ::
  8589. ::
  8590. [%mcmc *] :: ;;
  8591. [%cnhp ~(factory ax p.gen) q.gen]
  8592. ::
  8593. [%tsbr *]
  8594. [%tsls ~(example ax p.gen) q.gen]
  8595. ::
  8596. [%tstr *]
  8597. :+ %tsgl
  8598. r.gen
  8599. [%tune [[p.p.gen ~ ?~(q.p.gen q.gen [%kthp u.q.p.gen q.gen])] ~ ~] ~]
  8600. ::
  8601. [%tscl *]
  8602. [%tsgr [%cncb [[%& 1] ~] p.gen] q.gen]
  8603. ::
  8604. [%tsfs *]
  8605. [%tsls [%ktts p.gen q.gen] r.gen]
  8606. ::
  8607. [%tsmc *] [%tsfs p.gen r.gen q.gen]
  8608. [%tsdt *]
  8609. [%tsgr [%cncb [[%& 1] ~] [[p.gen q.gen] ~]] r.gen]
  8610. [%tswt *] :: =?
  8611. [%tsdt p.gen [%wtcl q.gen r.gen [%wing p.gen]] s.gen]
  8612. ::
  8613. [%tskt *] :: =^
  8614. =+ wuy=(weld q.gen `wing`[%v ~]) ::
  8615. :+ %tsgr [%ktts %v %$ 1] :: => v=.
  8616. :+ %tsls [%ktts %a %tsgr [%limb %v] r.gen] :: =+ a==>(v \r.gen)
  8617. :^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]]
  8618. :+ %tsgr :- :+ %ktts [%over [%v ~] p.gen]
  8619. [%tsgl [%$ 2] [%limb %a]]
  8620. [%limb %v]
  8621. s.gen
  8622. ::
  8623. [%tsgl *] [%tsgr q.gen p.gen]
  8624. [%tsls *] [%tsgr [p.gen [%$ 1]] q.gen]
  8625. [%tshp *] [%tsls q.gen p.gen]
  8626. [%tssg *]
  8627. |- ^- hoon
  8628. ?~ p.gen [%$ 1]
  8629. ?~ t.p.gen i.p.gen
  8630. [%tsgr i.p.gen $(p.gen t.p.gen)]
  8631. ::
  8632. [%wtbr *]
  8633. |-
  8634. ?~(p.gen [%rock %f 1] [%wtcl i.p.gen [%rock %f 0] $(p.gen t.p.gen)])
  8635. ::
  8636. [%wtdt *] [%wtcl p.gen r.gen q.gen]
  8637. [%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen]
  8638. [%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]]
  8639. [%wtkt *] [%wtcl [%wtts [%base %atom %$] p.gen] r.gen q.gen]
  8640. ::
  8641. [%wthp *]
  8642. |-
  8643. ?~ q.gen
  8644. [%lost [%wing p.gen]]
  8645. :^ %wtcl
  8646. [%wtts p.i.q.gen p.gen]
  8647. q.i.q.gen
  8648. $(q.gen t.q.gen)
  8649. ::
  8650. [%wtls *]
  8651. [%wthp p.gen (weld r.gen `_r.gen`[[[%base %noun] q.gen] ~])]
  8652. ::
  8653. [%wtpm *]
  8654. |-
  8655. ?~(p.gen [%rock %f 0] [%wtcl i.p.gen $(p.gen t.p.gen) [%rock %f 1]])
  8656. ::
  8657. [%xray *]
  8658. |^ :- [(open-mane n.g.p.gen) %clsg (turn a.g.p.gen open-mart)]
  8659. [%mcts c.p.gen]
  8660. ::
  8661. ++ open-mane
  8662. |= a=mane:hoot
  8663. ?@(a [%rock %tas a] [[%rock %tas -.a] [%rock %tas +.a]])
  8664. ::
  8665. ++ open-mart
  8666. |= [n=mane:hoot v=(list beer:hoot)]
  8667. [(open-mane n) %knit v]
  8668. --
  8669. ::
  8670. [%wtpt *] [%wtcl [%wtts [%base %atom %$] p.gen] q.gen r.gen]
  8671. [%wtsg *] [%wtcl [%wtts [%base %null] p.gen] q.gen r.gen]
  8672. [%wtts *] [%fits ~(example ax p.gen) q.gen]
  8673. [%wtzp *] [%wtcl p.gen [%rock %f 1] [%rock %f 0]]
  8674. [%zpgr *]
  8675. [%cncl [%limb %onan] [%zpmc [%kttr [%bcmc %limb %abel]] p.gen] ~]
  8676. ::
  8677. [%zpwt *]
  8678. ?: ?: ?=(@ p.gen)
  8679. (lte hoon-version p.gen)
  8680. &((lte hoon-version p.p.gen) (gte hoon-version q.p.gen))
  8681. q.gen
  8682. ~_(leaf+"hoon-version" !!)
  8683. ::
  8684. * gen
  8685. ==
  8686. ::
  8687. ++ rake ~>(%mean.'rake-hoon' (need reek))
  8688. ++ reek
  8689. ^- (unit wing)
  8690. ?+ gen ~
  8691. [~ *] `[[%& p.gen] ~]
  8692. [%limb *] `[p.gen ~]
  8693. [%wing *] `p.gen
  8694. [%cnts * ~] `p.gen
  8695. [%dbug *] reek(gen q.gen)
  8696. ==
  8697. ++ rusk
  8698. ^- term
  8699. =+ wig=rake
  8700. ?. ?=([@ ~] wig)
  8701. ~>(%mean.'rusk-hoon' !!)
  8702. i.wig
  8703. --
  8704. ::
  8705. :: 5c: compiler backend and prettyprinter
  8706. +| %compiler-backend-and-prettyprinter
  8707. ::
  8708. ++ ut
  8709. ~% %ut
  8710. +>+
  8711. ==
  8712. %ar ar
  8713. %fan fan
  8714. %rib rib
  8715. %vet vet
  8716. %blow blow
  8717. %burp burp
  8718. %busk busk
  8719. %buss buss
  8720. %crop crop
  8721. %duck duck
  8722. %dune dune
  8723. %dunk dunk
  8724. %epla epla
  8725. %emin emin
  8726. %emul emul
  8727. %feel feel
  8728. %felt felt
  8729. %fine fine
  8730. %fire fire
  8731. %fish fish
  8732. %fond fond
  8733. %fund fund
  8734. %funk funk
  8735. %fuse fuse
  8736. %gain gain
  8737. %lose lose
  8738. %mile mile
  8739. %mine mine
  8740. %mint mint
  8741. %moot moot
  8742. %mull mull
  8743. %nest nest
  8744. %peel peel
  8745. %play play
  8746. %peek peek
  8747. %repo repo
  8748. %rest rest
  8749. %sink sink
  8750. %tack tack
  8751. %toss toss
  8752. %wrap wrap
  8753. ==
  8754. =+ :* fan=*(set [type hoon])
  8755. rib=*(set [type type hoon])
  8756. vet=`?`&
  8757. ==
  8758. =+ sut=`type`%noun
  8759. |%
  8760. ++ clip
  8761. |= ref=type
  8762. ?> ?|(!vet (nest(sut ref) & sut))
  8763. ref
  8764. ::
  8765. :: +ar: texture engine
  8766. ::
  8767. ++ ar !:
  8768. ~% %ar
  8769. +>
  8770. ==
  8771. %fish fish
  8772. %gain gain
  8773. %lose lose
  8774. ==
  8775. |_ [ref=type =skin]
  8776. ::
  8777. :: +fish: make a $nock that tests a .ref at .axis for .skin
  8778. ::
  8779. ++ fish
  8780. |= =axis
  8781. ^- nock
  8782. ?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
  8783. ?- -.skin
  8784. ::
  8785. %base
  8786. ?- base.skin
  8787. %cell $(skin [%cell [%base %noun] [%base %noun]])
  8788. %flag ?: (~(nest ut bool) | ref)
  8789. [%1 &]
  8790. %+ flan
  8791. $(skin [%base %atom %$])
  8792. %+ flor
  8793. [%5 [%0 axis] [%1 &]]
  8794. [%5 [%0 axis] [%1 |]]
  8795. %noun [%1 &]
  8796. %null $(skin [%leaf %n ~])
  8797. %void [%1 |]
  8798. [%atom *] ?: (~(nest ut [%atom %$ ~]) | ref)
  8799. [%1 &]
  8800. ?: (~(nest ut [%cell %noun %noun]) | ref)
  8801. [%1 |]
  8802. (flip [%3 %0 axis])
  8803. ==
  8804. ::
  8805. %cell
  8806. ?: (~(nest ut [%atom %$ ~]) | ref) [%1 |]
  8807. %+ flan
  8808. ?: (~(nest ut [%cell %noun %noun]) | ref)
  8809. [%1 &]
  8810. [%3 %0 axis]
  8811. %+ flan
  8812. $(ref (peek(sut ref) %free 2), axis (peg axis 2), skin skin.skin)
  8813. $(ref (peek(sut ref) %free 3), axis (peg axis 3), skin ^skin.skin)
  8814. ::
  8815. %leaf
  8816. ?: (~(nest ut [%atom %$ `atom.skin]) | ref)
  8817. [%1 &]
  8818. [%5 [%1 atom.skin] [%0 axis]]
  8819. ::
  8820. %dbug $(skin skin.skin)
  8821. %help $(skin skin.skin)
  8822. %name $(skin skin.skin)
  8823. %over ::NOTE might need to guard with +feel, crashing is too strict
  8824. =+ ~| %oops-guess-you-needed-feel-after-all
  8825. fid=(fend %read wing.skin)
  8826. $(sut p.fid, axis (peg axis q.fid), skin skin.skin)
  8827. %spec =/ hit (~(play ut sut) ~(example ax spec.skin))
  8828. ?> (~(nest ut hit) & ref)
  8829. $(skin skin.skin)
  8830. %wash [%1 &]
  8831. ==
  8832. ::
  8833. :: +gain: make a $type by restricting .ref to .skin
  8834. ::
  8835. ++ gain
  8836. |- ^- type
  8837. ?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
  8838. ?- -.skin
  8839. ::
  8840. %base
  8841. ?- base.skin
  8842. %cell $(skin [%cell [%base %noun] [%base %noun]])
  8843. %flag (fork $(skin [%leaf %f &]) $(skin [%leaf %f |]) ~)
  8844. %null $(skin [%leaf %n ~])
  8845. %void %void
  8846. %noun ?:((~(nest ut %void) | ref) %void ref)
  8847. [%atom *]
  8848. =| gil=(set type)
  8849. |- ^- type
  8850. ?- ref
  8851. %void %void
  8852. %noun [%atom p.base.skin ~]
  8853. [%atom *] ?. (fitz p.base.skin p.ref)
  8854. ~>(%mean.'atom-mismatch' !!)
  8855. :+ %atom
  8856. (max p.base.skin p.ref)
  8857. q.ref
  8858. [%cell *] %void
  8859. [%core *] %void
  8860. [%face *] $(ref q.ref)
  8861. [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
  8862. [%hint *] (hint p.ref $(ref q.ref))
  8863. [%hold *] ?: (~(has in gil) ref) %void
  8864. $(gil (~(put in gil) ref), ref repo(sut ref))
  8865. ==
  8866. ==
  8867. ::
  8868. %cell
  8869. =| gil=(set type)
  8870. |- ^- type
  8871. ?- ref
  8872. %void %void
  8873. %noun =+ ^$(skin skin.skin)
  8874. ?: =(%void -) %void
  8875. (cell - ^$(skin ^skin.skin))
  8876. [%atom *] %void
  8877. [%cell *] =+ ^$(skin skin.skin, ref p.ref)
  8878. ?: =(%void -) %void
  8879. (cell - ^$(skin ^skin.skin, ref q.ref))
  8880. [%core *] =+ ^$(skin skin.skin, ref p.ref)
  8881. ?: =(%void -) %void
  8882. ?. =(%noun ^skin.skin)
  8883. (cell - ^$(skin ^skin.skin, ref %noun))
  8884. [%core - q.ref]
  8885. [%face *] $(ref q.ref)
  8886. [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
  8887. [%hint *] (hint p.ref $(ref q.ref))
  8888. [%hold *] ?: (~(has in gil) ref) %void
  8889. $(gil (~(put in gil) ref), ref repo(sut ref))
  8890. ==
  8891. ::
  8892. %leaf
  8893. =| gil=(set type)
  8894. |- ^- type
  8895. ?- ref
  8896. %void %void
  8897. %noun [%atom aura.skin `atom.skin]
  8898. [%atom *] ?: &(?=(^ q.ref) !=(atom.skin u.q.ref))
  8899. %void
  8900. ?. (fitz aura.skin p.ref)
  8901. ~>(%mean.'atom-mismatch' !!)
  8902. :+ %atom
  8903. (max aura.skin p.ref)
  8904. `atom.skin
  8905. [%cell *] %void
  8906. [%core *] %void
  8907. [%face *] $(ref q.ref)
  8908. [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
  8909. [%hint *] (hint p.ref $(ref q.ref))
  8910. [%hold *] ?: (~(has in gil) ref) %void
  8911. $(gil (~(put in gil) ref), ref repo(sut ref))
  8912. ==
  8913. ::
  8914. %dbug $(skin skin.skin)
  8915. %help (hint [sut %help help.skin] $(skin skin.skin))
  8916. %name (face term.skin $(skin skin.skin))
  8917. %over $(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
  8918. %spec =/ hit (~(play ut sut) ~(example ax spec.skin))
  8919. ?> (~(nest ut hit) & $(skin skin.skin))
  8920. (~(fuse ut ref) hit)
  8921. %wash =- $(ref (~(play ut ref) -))
  8922. :- %wing
  8923. |- ^- wing
  8924. ?: =(0 depth.skin) ~
  8925. [[%| 0 ~] $(depth.skin (dec depth.skin))]
  8926. ==
  8927. ::
  8928. :: +lose: make a $type by restricting .ref to exclude .skin
  8929. ::
  8930. ++ lose
  8931. |- ^- type
  8932. ?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
  8933. ?- -.skin
  8934. ::
  8935. %base
  8936. ?- base.skin
  8937. %cell $(skin [%cell [%base %noun] [%base %noun]])
  8938. %flag $(ref $(skin [%leaf %f &]), skin [%leaf %f |])
  8939. %null $(skin [%leaf %n ~])
  8940. %void ref
  8941. %noun %void
  8942. [%atom *]
  8943. =| gil=(set type)
  8944. |- ^- type
  8945. ?- ref
  8946. %void %void
  8947. %noun [%cell %noun %noun]
  8948. [%atom *] %void
  8949. [%cell *] ref
  8950. [%core *] ref
  8951. [%face *] (face p.ref $(ref q.ref))
  8952. [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
  8953. [%hint *] (hint p.ref $(ref q.ref))
  8954. [%hold *] ?: (~(has in gil) ref) %void
  8955. $(gil (~(put in gil) ref), ref repo(sut ref))
  8956. ==
  8957. ==
  8958. ::
  8959. %cell
  8960. =| gil=(set type)
  8961. |- ^- type
  8962. ?- ref
  8963. %void %void
  8964. %noun ?. =([%cell [%base %noun] [%base %noun]] skin)
  8965. ref
  8966. [%atom %$ ~]
  8967. [%atom *] ref
  8968. [%cell *] =/ lef ^$(skin skin.skin, ref p.ref)
  8969. =/ rig ^$(skin ^skin.skin, ref q.ref)
  8970. (fork (cell lef rig) (cell lef q.ref) (cell p.ref rig) ~)
  8971. [%core *] =+ ^$(skin skin.skin, ref p.ref)
  8972. ?: =(%void -) %void
  8973. ?. =(%noun ^skin.skin)
  8974. (cell - ^$(skin ^skin.skin, ref %noun))
  8975. [%core - q.ref]
  8976. [%face *] $(ref q.ref)
  8977. [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
  8978. [%hint *] (hint p.ref $(ref q.ref))
  8979. [%hold *] ?: (~(has in gil) ref) %void
  8980. $(gil (~(put in gil) ref), ref repo(sut ref))
  8981. ==
  8982. ::
  8983. %leaf
  8984. =| gil=(set type)
  8985. |- ^- type
  8986. ?- ref
  8987. %void %void
  8988. %noun %noun
  8989. [%atom *] ?: =(q.ref `atom.skin)
  8990. %void
  8991. ref
  8992. [%cell *] ref
  8993. [%core *] ref
  8994. [%face *] (face p.ref $(ref q.ref))
  8995. [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
  8996. [%hint *] (hint p.ref $(ref q.ref))
  8997. [%hold *] ?: (~(has in gil) ref) %void
  8998. $(gil (~(put in gil) ref), ref repo(sut ref))
  8999. ==
  9000. ::
  9001. %dbug $(skin skin.skin)
  9002. %help $(skin skin.skin)
  9003. %name $(skin skin.skin)
  9004. %over ::TODO if we guard in +fish (+feel), we have to guard again here
  9005. $(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
  9006. %spec =/ hit (~(play ut sut) ~(example ax spec.skin))
  9007. ?> (~(nest ut hit) & $(skin skin.skin))
  9008. (~(crop ut ref) hit)
  9009. %wash ref
  9010. ==
  9011. --
  9012. ::
  9013. ++ blow
  9014. |= [gol=type gen=hoon]
  9015. ^- [type nock]
  9016. =+ pro=(mint gol gen)
  9017. =+ jon=(apex:musk bran q.pro)
  9018. ?: |(?=(~ jon) ?=(%wait -.u.jon))
  9019. [p.pro q.pro]
  9020. [p.pro %1 p.u.jon]
  9021. ::
  9022. ++ bran
  9023. ~+
  9024. =+ gil=*(set type)
  9025. |- ~+ ^- seminoun:musk
  9026. ?- sut
  9027. %noun [full/[~ ~ ~] ~]
  9028. %void [full/[~ ~ ~] ~]
  9029. [%atom *] ?~(q.sut [full/[~ ~ ~] ~] [full/~ u.q.sut])
  9030. [%cell *] (combine:musk $(sut p.sut) $(sut q.sut))
  9031. [%core *] %+ combine:musk
  9032. p.r.q.sut
  9033. $(sut p.sut)
  9034. [%face *] $(sut repo)
  9035. [%fork *] [full/[~ ~ ~] ~]
  9036. [%hint *] $(sut repo)
  9037. [%hold *] ?: (~(has in gil) sut)
  9038. [full/[~ ~ ~] ~]
  9039. $(sut repo, gil (~(put in gil) sut))
  9040. ==
  9041. ::
  9042. ++ burp
  9043. :: expel undigested seminouns
  9044. ::
  9045. ^- type
  9046. ~+
  9047. =- ?.(=(sut -) - sut)
  9048. ?+ sut sut
  9049. [%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
  9050. [%core *] :+ %core
  9051. burp(sut p.sut)
  9052. :* p.q.sut
  9053. burp(sut q.q.sut)
  9054. :_ q.r.q.sut
  9055. ?: ?=([[%full ~] *] p.r.q.sut)
  9056. p.r.q.sut
  9057. [[%full ~ ~ ~] ~]
  9058. ==
  9059. [%face *] [%face p.sut burp(sut q.sut)]
  9060. [%fork *] [%fork (~(run in p.sut) |=(type burp(sut +<)))]
  9061. [%hint *] (hint [burp(sut p.p.sut) q.p.sut] burp(sut q.sut))
  9062. [%hold *] [%hold burp(sut p.sut) q.sut]
  9063. ==
  9064. ::
  9065. ++ busk
  9066. ~/ %busk
  9067. |= gen=hoon
  9068. ^- type
  9069. [%face [~ [gen ~]] sut]
  9070. ::
  9071. ++ buss
  9072. ~/ %buss
  9073. |= [cog=term gen=hoon]
  9074. ^- type
  9075. [%face [[[cog ~ gen] ~ ~] ~] sut]
  9076. ::
  9077. ++ crop
  9078. ~/ %crop
  9079. |= ref=type
  9080. =+ bix=*(set [type type])
  9081. =< dext
  9082. |%
  9083. ++ dext
  9084. ^- type
  9085. ~_ leaf+"crop"
  9086. :: ~_ (dunk 'dext: sut')
  9087. :: ~_ (dunk(sut ref) 'dext: ref')
  9088. ?: |(=(sut ref) =(%noun ref))
  9089. %void
  9090. ?: =(%void ref)
  9091. sut
  9092. ?- sut
  9093. [%atom *]
  9094. ?+ ref sint
  9095. [%atom *] ?^ q.sut
  9096. ?^(q.ref ?:(=(q.ref q.sut) %void sut) %void)
  9097. ?^(q.ref sut %void)
  9098. [%cell *] sut
  9099. ==
  9100. ::
  9101. [%cell *]
  9102. ?+ ref sint
  9103. [%atom *] sut
  9104. [%cell *] ?. (nest(sut p.ref) | p.sut) sut
  9105. (cell p.sut dext(sut q.sut, ref q.ref))
  9106. ==
  9107. ::
  9108. [%core *] ?:(?=(?([%atom *] [%cell *]) ref) sut sint)
  9109. [%face *] (face p.sut dext(sut q.sut))
  9110. [%fork *] (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
  9111. [%hint *] (hint p.sut dext(sut q.sut))
  9112. [%hold *] ?< (~(has in bix) [sut ref])
  9113. dext(sut repo, bix (~(put in bix) [sut ref]))
  9114. %noun dext(sut repo)
  9115. %void %void
  9116. ==
  9117. ::
  9118. ++ sint
  9119. ^- type
  9120. ?+ ref !!
  9121. [%core *] sut
  9122. [%face *] dext(ref repo(sut ref))
  9123. [%fork *] =+ yed=~(tap in p.ref)
  9124. |- ^- type
  9125. ?~ yed sut
  9126. $(yed t.yed, sut dext(ref i.yed))
  9127. [%hint *] dext(ref repo(sut ref))
  9128. [%hold *] dext(ref repo(sut ref))
  9129. ==
  9130. --
  9131. ::
  9132. ++ cool
  9133. |= [pol=? hyp=wing ref=type]
  9134. ^- type
  9135. =+ fid=(find %both hyp)
  9136. ?- -.fid
  9137. %| sut
  9138. %& =< q
  9139. %+ take p.p.fid
  9140. |=(a=type ?:(pol (fuse(sut a) ref) (crop(sut a) ref)))
  9141. ==
  9142. ::
  9143. ++ duck ^-(tank ~(duck us sut))
  9144. ++ dune |.(duck)
  9145. ++ dunk
  9146. |= paz=term ^- tank
  9147. :+ %palm
  9148. [['.' ~] ['-' ~] ~ ~]
  9149. [[%leaf (mesc (trip paz))] duck ~]
  9150. ::
  9151. ++ elbo
  9152. |= [lop=palo rig=(list (pair wing hoon))]
  9153. ^- type
  9154. ?: ?=(%& -.q.lop)
  9155. |- ^- type
  9156. ?~ rig
  9157. p.q.lop
  9158. =+ zil=(play q.i.rig)
  9159. =+ dar=(tack(sut p.q.lop) p.i.rig zil)
  9160. %= $
  9161. rig t.rig
  9162. p.q.lop q.dar
  9163. ==
  9164. =+ hag=~(tap in q.q.lop)
  9165. %- fire
  9166. |- ^+ hag
  9167. ?~ rig
  9168. hag
  9169. =+ zil=(play q.i.rig)
  9170. =+ dix=(toss p.i.rig zil hag)
  9171. %= $
  9172. rig t.rig
  9173. hag q.dix
  9174. ==
  9175. ::
  9176. ++ ergo
  9177. |= [lop=palo rig=(list (pair wing hoon))]
  9178. ^- (pair type nock)
  9179. =+ axe=(tend p.lop)
  9180. =| hej=(list (pair axis nock))
  9181. ?: ?=(%& -.q.lop)
  9182. =- [p.- (hike axe q.-)]
  9183. |- ^- (pair type (list (pair axis nock)))
  9184. ?~ rig
  9185. [p.q.lop hej]
  9186. =+ zil=(mint %noun q.i.rig)
  9187. =+ dar=(tack(sut p.q.lop) p.i.rig p.zil)
  9188. %= $
  9189. rig t.rig
  9190. p.q.lop q.dar
  9191. hej [[p.dar q.zil] hej]
  9192. ==
  9193. =+ hag=~(tap in q.q.lop)
  9194. =- [(fire p.-) [%9 p.q.lop (hike axe q.-)]]
  9195. |- ^- (pair (list (pair type foot)) (list (pair axis nock)))
  9196. ?~ rig
  9197. [hag hej]
  9198. =+ zil=(mint %noun q.i.rig)
  9199. =+ dix=(toss p.i.rig p.zil hag)
  9200. %= $
  9201. rig t.rig
  9202. hag q.dix
  9203. hej [[p.dix q.zil] hej]
  9204. ==
  9205. ::
  9206. ++ endo
  9207. |= [lop=(pair palo palo) dox=type rig=(list (pair wing hoon))]
  9208. ^- (pair type type)
  9209. ?: ?=(%& -.q.p.lop)
  9210. ?> ?=(%& -.q.q.lop)
  9211. |- ^- (pair type type)
  9212. ?~ rig
  9213. [p.q.p.lop p.q.q.lop]
  9214. =+ zil=(mull %noun dox q.i.rig)
  9215. =+ ^= dar
  9216. :- p=(tack(sut p.q.p.lop) p.i.rig p.zil)
  9217. q=(tack(sut p.q.q.lop) p.i.rig q.zil)
  9218. ?> =(p.p.dar p.q.dar)
  9219. %= $
  9220. rig t.rig
  9221. p.q.p.lop q.p.dar
  9222. p.q.q.lop q.q.dar
  9223. ==
  9224. ?> ?=(%| -.q.q.lop)
  9225. ?> =(p.q.p.lop p.q.q.lop)
  9226. =+ hag=[p=~(tap in q.q.p.lop) q=~(tap in q.q.q.lop)]
  9227. =- [(fire p.-) (fire(vet |) q.-)]
  9228. |- ^- (pair (list (pair type foot)) (list (pair type foot)))
  9229. ?~ rig
  9230. hag
  9231. =+ zil=(mull %noun dox q.i.rig)
  9232. =+ ^= dix
  9233. :- p=(toss p.i.rig p.zil p.hag)
  9234. q=(toss p.i.rig q.zil q.hag)
  9235. ?> =(p.p.dix p.q.dix)
  9236. %= $
  9237. rig t.rig
  9238. hag [q.p.dix q.q.dix]
  9239. ==
  9240. ::
  9241. ++ et
  9242. |_ [hyp=wing rig=(list (pair wing hoon))]
  9243. ::
  9244. ++ play
  9245. ^- type
  9246. =+ lug=(find %read hyp)
  9247. ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.p.lug))
  9248. (elbo p.lug rig)
  9249. ::
  9250. ++ mint
  9251. |= gol=type
  9252. =- ?>(?|(!vet (nest(sut gol) & p.-)) -)
  9253. ^- (pair type nock)
  9254. =+ lug=(find %read hyp)
  9255. ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.lug))
  9256. (ergo p.lug rig)
  9257. ::
  9258. ++ mull
  9259. |= [gol=type dox=type]
  9260. =- ?>(?|(!vet (nest(sut gol) & p.-)) -)
  9261. ^- (pair type type)
  9262. =+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)]
  9263. ?: ?=(%| -.p.lug)
  9264. ?> &(?=(%| -.q.lug) ?=(~ rig))
  9265. [p.p.p.lug p.p.q.lug]
  9266. ?> ?=(%& -.q.lug)
  9267. (endo [p.p.lug p.q.lug] dox rig)
  9268. --
  9269. ::
  9270. ++ epla
  9271. ~/ %epla
  9272. |= [hyp=wing rig=(list (pair wing hoon))]
  9273. ^- type
  9274. ~(play et hyp rig)
  9275. ::
  9276. ++ emin
  9277. ~/ %emin
  9278. |= [gol=type hyp=wing rig=(list (pair wing hoon))]
  9279. ^- (pair type nock)
  9280. (~(mint et hyp rig) gol)
  9281. ::
  9282. ++ emul
  9283. ~/ %emul
  9284. |= [gol=type dox=type hyp=wing rig=(list (pair wing hoon))]
  9285. ^- (pair type type)
  9286. (~(mull et hyp rig) gol dox)
  9287. ::
  9288. ++ felt !!
  9289. :: ::
  9290. ++ feel :: detect existence
  9291. |= rot=(list wing)
  9292. ^- ?
  9293. =. rot (flop rot)
  9294. |- ^- ?
  9295. ?~ rot &
  9296. =/ yep (fond %free i.rot)
  9297. ?~ yep |
  9298. ?- -.yep
  9299. %& %= $
  9300. rot t.rot
  9301. sut p:(fine %& p.yep)
  9302. ==
  9303. %| ?- -.p.yep
  9304. %& |
  9305. %| %= $
  9306. rot t.rot
  9307. sut p:(fine %| p.p.yep)
  9308. ==
  9309. == ==
  9310. ::
  9311. ++ fond
  9312. ~/ %fond
  9313. |= [way=vial hyp=wing]
  9314. => |%
  9315. ++ pony :: raw match
  9316. $@ ~ :: void
  9317. %+ each :: natural/abnormal
  9318. palo :: arm or leg
  9319. %+ each :: abnormal
  9320. @ud :: unmatched
  9321. (pair type nock) :: synthetic
  9322. --
  9323. ^- pony
  9324. ?~ hyp
  9325. [%& ~ %& sut]
  9326. =+ mor=$(hyp t.hyp)
  9327. ?- -.mor
  9328. %|
  9329. ?- -.p.mor
  9330. %& mor
  9331. %|
  9332. =+ fex=(mint(sut p.p.p.mor) %noun [%wing i.hyp ~])
  9333. [%| %| p.fex (comb q.p.p.mor q.fex)]
  9334. ==
  9335. ::
  9336. %&
  9337. =. sut
  9338. =* lap q.p.mor
  9339. ?- -.lap
  9340. %& p.lap
  9341. %| (fork (turn ~(tap in q.lap) head))
  9342. ==
  9343. => :_ +
  9344. :* axe=`axis`1
  9345. lon=p.p.mor
  9346. heg=?^(i.hyp i.hyp [%| p=0 q=(some i.hyp)])
  9347. ==
  9348. ?: ?=(%& -.heg)
  9349. [%& [`p.heg lon] %& (peek way p.heg)]
  9350. =| gil=(set type)
  9351. =< $
  9352. |% ++ here ?: =(0 p.heg)
  9353. [%& [~ `axe lon] %& sut]
  9354. [%| %& (dec p.heg)]
  9355. ++ lose [%| %& p.heg]
  9356. ++ stop ?~(q.heg here lose)
  9357. ++ twin |= [hax=pony yor=pony]
  9358. ^- pony
  9359. ~_ leaf+"find-fork"
  9360. ?: =(hax yor) hax
  9361. ?~ hax yor
  9362. ?~ yor hax
  9363. ?: ?=(%| -.hax)
  9364. ?> ?& ?=(%| -.yor)
  9365. ?=(%| -.p.hax)
  9366. ?=(%| -.p.yor)
  9367. =(q.p.p.hax q.p.p.yor)
  9368. ==
  9369. :+ %|
  9370. %|
  9371. [(fork p.p.p.hax p.p.p.yor ~) q.p.p.hax]
  9372. ?> ?=(%& -.yor)
  9373. ?> =(p.p.hax p.p.yor)
  9374. ?: &(?=(%& -.q.p.hax) ?=(%& -.q.p.yor))
  9375. :+ %& p.p.hax
  9376. [%& (fork p.q.p.hax p.q.p.yor ~)]
  9377. ?> &(?=(%| -.q.p.hax) ?=(%| -.q.p.yor))
  9378. ?> =(p.q.p.hax p.q.p.yor)
  9379. =+ wal=(~(uni in q.q.p.hax) q.q.p.yor)
  9380. :+ %& p.p.hax
  9381. [%| p.q.p.hax wal]
  9382. ++ $
  9383. ^- pony
  9384. ?- sut
  9385. %void ~
  9386. %noun stop
  9387. [%atom *] stop
  9388. [%cell *]
  9389. ?~ q.heg here
  9390. =+ taf=$(axe (peg axe 2), sut p.sut)
  9391. ?~ taf ~
  9392. ?: |(?=(%& -.taf) ?=(%| -.p.taf))
  9393. taf
  9394. $(axe (peg axe 3), p.heg p.p.taf, sut q.sut)
  9395. ::
  9396. [%core *]
  9397. ?~ q.heg here
  9398. =^ zem p.heg
  9399. =+ zem=(loot u.q.heg q.r.q.sut)
  9400. ?~ zem [~ p.heg]
  9401. ?:(=(0 p.heg) [zem 0] [~ (dec p.heg)])
  9402. ?^ zem
  9403. :+ %&
  9404. [`axe lon]
  9405. =/ zut ^- foot
  9406. ?- q.p.q.sut
  9407. %wet [%wet q.u.zem]
  9408. %dry [%dry q.u.zem]
  9409. ==
  9410. [%| (peg 2 p.u.zem) [[sut zut] ~ ~]]
  9411. =+ pec=(peel way r.p.q.sut)
  9412. ?. sam.pec lose
  9413. ?: con.pec $(sut p.sut, axe (peg axe 3))
  9414. $(sut (peek(sut p.sut) way 2), axe (peg axe 6))
  9415. ::
  9416. [%hint *]
  9417. $(sut repo)
  9418. ::
  9419. [%face *]
  9420. ?: ?=(~ q.heg) here(sut q.sut)
  9421. =* zot p.sut
  9422. ?@ zot
  9423. ?:(=(u.q.heg zot) here(sut q.sut) lose)
  9424. =< main
  9425. |%
  9426. ++ main
  9427. ^- pony
  9428. =+ tyr=(~(get by p.zot) u.q.heg)
  9429. ?~ tyr
  9430. next
  9431. ?~ u.tyr
  9432. $(sut q.sut, lon [~ lon], p.heg +(p.heg))
  9433. ?. =(0 p.heg)
  9434. next(p.heg (dec p.heg))
  9435. =+ tor=(fund way u.u.tyr)
  9436. ?- -.tor
  9437. %& [%& (weld p.p.tor `vein`[~ `axe lon]) q.p.tor]
  9438. %| [%| %| p.p.tor (comb [%0 axe] q.p.tor)]
  9439. ==
  9440. ++ next
  9441. |- ^- pony
  9442. ?~ q.zot
  9443. ^$(sut q.sut, lon [~ lon])
  9444. =+ tiv=(mint(sut q.sut) %noun i.q.zot)
  9445. =+ fid=^$(sut p.tiv, lon ~, axe 1, gil ~)
  9446. ?~ fid ~
  9447. ?: ?=([%| %& *] fid)
  9448. $(q.zot t.q.zot, p.heg p.p.fid)
  9449. =/ vat=(pair type nock)
  9450. ?- -.fid
  9451. %& (fine %& p.fid)
  9452. %| (fine %| p.p.fid)
  9453. ==
  9454. [%| %| p.vat (comb (comb [%0 axe] q.tiv) q.vat)]
  9455. --
  9456. ::
  9457. [%fork *]
  9458. =+ wiz=(turn ~(tap in p.sut) |=(a=type ^$(sut a)))
  9459. ?~ wiz ~
  9460. |- ^- pony
  9461. ?~ t.wiz i.wiz
  9462. (twin i.wiz $(wiz t.wiz))
  9463. ::
  9464. [%hold *]
  9465. ?: (~(has in gil) sut)
  9466. ~
  9467. $(gil (~(put in gil) sut), sut repo)
  9468. ==
  9469. --
  9470. ==
  9471. ::
  9472. ++ find
  9473. ~/ %find
  9474. |= [way=vial hyp=wing]
  9475. ^- port
  9476. ~_ (show [%c %find] %l hyp)
  9477. =- ?@ - !!
  9478. ?- -<
  9479. %& [%& p.-]
  9480. %| ?- -.p.-
  9481. %| [%| p.p.-]
  9482. %& !!
  9483. == ==
  9484. (fond way hyp)
  9485. ::
  9486. ++ fend
  9487. |= [way=vial hyp=wing]
  9488. ^- (pair type axis)
  9489. =+ fid=(find way hyp)
  9490. ~> %mean.'fend-fragment'
  9491. ?> &(?=(%& -.fid) ?=(%& -.q.p.fid))
  9492. [p.q.p.fid (tend p.p.fid)]
  9493. ::
  9494. ++ fund
  9495. ~/ %fund
  9496. |= [way=vial gen=hoon]
  9497. ^- port
  9498. =+ hup=~(reek ap gen)
  9499. ?~ hup
  9500. [%| (mint %noun gen)]
  9501. (find way u.hup)
  9502. ::
  9503. ++ fine
  9504. ~/ %fine
  9505. |= tor=port
  9506. ^- (pair type nock)
  9507. ?- -.tor
  9508. %| p.tor
  9509. %& =+ axe=(tend p.p.tor)
  9510. ?- -.q.p.tor
  9511. %& [`type`p.q.p.tor %0 axe]
  9512. %| [(fire ~(tap in q.q.p.tor)) [%9 p.q.p.tor %0 axe]]
  9513. == ==
  9514. ::
  9515. ++ fire
  9516. |= hag=(list [p=type q=foot])
  9517. ^- type
  9518. ?: ?=([[* [%wet ~ %1]] ~] hag)
  9519. p.i.hag
  9520. %- fork
  9521. %+ turn
  9522. hag.$
  9523. |= [p=type q=foot]
  9524. ?. ?=([%core *] p)
  9525. ~_ (dunk %fire-type)
  9526. ~_ leaf+"expected-fork-to-be-core"
  9527. ~_ (dunk(sut p) %fork-type)
  9528. ~>(%mean.'fire-core' !!)
  9529. :- %hold
  9530. =+ dox=[%core q.q.p q.p(r.p %gold)]
  9531. ?: ?=(%dry -.q)
  9532. :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry)
  9533. ?> ?|(!vet (nest(sut q.q.p) & p.p))
  9534. [dox p.q]
  9535. ?> ?=(%wet -.q)
  9536. :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-wet)
  9537. =. p.p (redo(sut p.p) q.q.p)
  9538. ?> ?| !vet
  9539. (~(has in rib) [sut dox p.q])
  9540. !=(** (mull(sut p, rib (~(put in rib) sut dox p.q)) %noun dox p.q))
  9541. ==
  9542. [p p.q]
  9543. ::
  9544. ++ fish
  9545. ~/ %fish
  9546. |= axe=axis
  9547. =+ vot=*(set type)
  9548. |- ^- nock
  9549. ?- sut
  9550. %void [%1 1]
  9551. %noun [%1 0]
  9552. [%atom *] ?~ q.sut
  9553. (flip [%3 %0 axe])
  9554. [%5 [%1 u.q.sut] [%0 axe]]
  9555. [%cell *]
  9556. %+ flan
  9557. [%3 %0 axe]
  9558. (flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3)))
  9559. ::
  9560. [%core *] ~>(%mean.'fish-core' !!)
  9561. [%face *] $(sut q.sut)
  9562. [%fork *] =+ yed=~(tap in p.sut)
  9563. |- ^- nock
  9564. ?~(yed [%1 1] (flor ^$(sut i.yed) $(yed t.yed)))
  9565. [%hint *] $(sut q.sut)
  9566. [%hold *]
  9567. ?: (~(has in vot) sut)
  9568. ~>(%mean.'fish-loop' !!)
  9569. => %=(. vot (~(put in vot) sut))
  9570. $(sut repo)
  9571. ==
  9572. ::
  9573. ++ fuse
  9574. ~/ %fuse
  9575. |= ref=type
  9576. =+ bix=*(set [type type])
  9577. |- ^- type
  9578. ?: ?|(=(sut ref) =(%noun ref))
  9579. sut
  9580. ?- sut
  9581. [%atom *]
  9582. ?- ref
  9583. [%atom *] =+ foc=?:((fitz p.ref p.sut) p.sut p.ref)
  9584. ?^ q.sut
  9585. ?^ q.ref
  9586. ?: =(q.sut q.ref)
  9587. [%atom foc q.sut]
  9588. %void
  9589. [%atom foc q.sut]
  9590. [%atom foc q.ref]
  9591. [%cell *] %void
  9592. * $(sut ref, ref sut)
  9593. ==
  9594. [%cell *]
  9595. ?- ref
  9596. [%cell *] (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref))
  9597. * $(sut ref, ref sut)
  9598. ==
  9599. ::
  9600. [%core *] $(sut repo)
  9601. [%face *] (face p.sut $(sut q.sut))
  9602. [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
  9603. [%hint *] (hint p.sut $(sut q.sut))
  9604. [%hold *]
  9605. ?: (~(has in bix) [sut ref])
  9606. ~>(%mean.'fuse-loop' !!)
  9607. $(sut repo, bix (~(put in bix) [sut ref]))
  9608. ::
  9609. %noun ref
  9610. %void %void
  9611. ==
  9612. ::
  9613. ++ gain
  9614. ~/ %gain
  9615. |= gen=hoon ^- type
  9616. (chip & gen)
  9617. ::
  9618. ++ hemp
  9619. :: generate formula from foot
  9620. ::
  9621. |= [hud=poly gol=type gen=hoon]
  9622. ^- nock
  9623. ~+
  9624. =+ %hemp-141
  9625. ?- hud
  9626. %dry q:(mint gol gen)
  9627. %wet q:(mint(vet |) gol gen)
  9628. ==
  9629. ::
  9630. ++ laze
  9631. :: produce lazy core generator for static execution
  9632. ::
  9633. |= [nym=(unit term) hud=poly dom=(map term tome)]
  9634. ~+
  9635. ^- seminoun
  9636. =+ %hemp-141
  9637. :: tal: map from battery axis to foot
  9638. ::
  9639. =; tal=(map @ud hoon)
  9640. :: produce lazy battery
  9641. ::
  9642. :_ ~
  9643. :+ %lazy 1
  9644. |= axe=@ud
  9645. ^- (unit noun)
  9646. %+ bind (~(get by tal) axe)
  9647. |= gen=hoon
  9648. %. [hud %noun gen]
  9649. hemp(sut (core sut [nym hud %gold] sut [[%lazy 1 ..^$] ~] dom))
  9650. ::
  9651. %- ~(gas by *(map @ud hoon))
  9652. =| yeb=(list (pair @ud hoon))
  9653. =+ axe=1
  9654. |^ ?- dom
  9655. ~ yeb
  9656. [* ~ ~] (chapter q.q.n.dom)
  9657. [* * ~] %= $
  9658. dom l.dom
  9659. axe (peg axe 3)
  9660. yeb (chapter(axe (peg axe 2)) q.q.n.dom)
  9661. ==
  9662. [* ~ *] %= $
  9663. dom r.dom
  9664. axe (peg axe 3)
  9665. yeb (chapter(axe (peg axe 2)) q.q.n.dom)
  9666. ==
  9667. [* * *] %= $
  9668. dom r.dom
  9669. axe (peg axe 7)
  9670. yeb %= $
  9671. dom l.dom
  9672. axe (peg axe 6)
  9673. yeb (chapter(axe (peg axe 2)) q.q.n.dom)
  9674. == == ==
  9675. ++ chapter
  9676. |= dab=(map term hoon)
  9677. ^+ yeb
  9678. ?- dab
  9679. ~ yeb
  9680. [* ~ ~] [[axe q.n.dab] yeb]
  9681. [* * ~] %= $
  9682. dab l.dab
  9683. axe (peg axe 3)
  9684. yeb [[(peg axe 2) q.n.dab] yeb]
  9685. ==
  9686. [* ~ *] %= $
  9687. dab r.dab
  9688. axe (peg axe 3)
  9689. yeb [[(peg axe 2) q.n.dab] yeb]
  9690. ==
  9691. [* * *] %= $
  9692. dab r.dab
  9693. axe (peg axe 7)
  9694. yeb %= $
  9695. dab l.dab
  9696. axe (peg axe 6)
  9697. yeb [[(peg axe 2) q.n.dab] yeb]
  9698. == == ==
  9699. --
  9700. ::
  9701. ++ lose
  9702. ~/ %lose
  9703. |= gen=hoon ^- type
  9704. (chip | gen)
  9705. ::
  9706. ++ chip
  9707. ~/ %chip
  9708. |= [how=? gen=hoon] ^- type
  9709. ?: ?=([%wtts *] gen)
  9710. (cool how q.gen (play ~(example ax p.gen)))
  9711. ?: ?=([%wthx *] gen)
  9712. =+ fid=(find %both q.gen)
  9713. ?- -.fid
  9714. %| sut
  9715. %& =< q
  9716. %+ take p.p.fid
  9717. |=(a=type ?:(how ~(gain ar a p.gen) ~(lose ar a p.gen)))
  9718. ==
  9719. ?: ?&(how ?=([%wtpm *] gen))
  9720. |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
  9721. ?: ?&(!how ?=([%wtbr *] gen))
  9722. |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
  9723. =+ neg=~(open ap gen)
  9724. ?:(=(neg gen) sut $(gen neg))
  9725. ::
  9726. ++ bake
  9727. |= [dox=type hud=poly dab=(map term hoon)]
  9728. ^- *
  9729. ?: ?=(~ dab)
  9730. ~
  9731. =+ ^= dov
  9732. :: this seems wrong but it's actually right
  9733. ::
  9734. ?- hud
  9735. %dry (mull %noun dox q.n.dab)
  9736. %wet ~
  9737. ==
  9738. ?- dab
  9739. [* ~ ~] dov
  9740. [* ~ *] [dov $(dab r.dab)]
  9741. [* * ~] [dov $(dab l.dab)]
  9742. [* * *] [dov $(dab l.dab) $(dab r.dab)]
  9743. ==
  9744. ::
  9745. ++ balk
  9746. |= [dox=type hud=poly dom=(map term tome)]
  9747. ^- *
  9748. ?: ?=(~ dom)
  9749. ~
  9750. =+ dov=(bake dox hud q.q.n.dom)
  9751. ?- dom
  9752. [* ~ ~] dov
  9753. [* ~ *] [dov $(dom r.dom)]
  9754. [* * ~] [dov $(dom l.dom)]
  9755. [* * *] [dov $(dom l.dom) $(dom r.dom)]
  9756. ==
  9757. ::
  9758. ++ mile
  9759. :: mull all chapters and feet in a core
  9760. ::
  9761. |= [dox=type mel=vair nym=(unit term) hud=poly dom=(map term tome)]
  9762. ^- (pair type type)
  9763. =+ yet=(core sut [nym hud %gold] sut (laze nym hud dom) dom)
  9764. =+ hum=(core dox [nym hud %gold] dox (laze nym hud dom) dom)
  9765. =+ (balk(sut yet) hum hud dom)
  9766. [yet hum]
  9767. ::
  9768. ++ mine
  9769. :: mint all chapters and feet in a core
  9770. ::
  9771. |= [gol=type mel=vair nym=(unit term) hud=poly dom=(map term tome)]
  9772. ^- (pair type nock)
  9773. |^
  9774. =/ log (chapters-check (core-check gol))
  9775. =/ dog (get-tomes log)
  9776. =- :_ [%1 dez]
  9777. (core sut [nym hud mel] sut [[%full ~] dez] dom)
  9778. ^= dez
  9779. =. sut (core sut [nym hud %gold] sut (laze nym hud dom) dom)
  9780. |- ^- ?(~ ^)
  9781. ?: ?=(~ dom)
  9782. ~
  9783. =/ dov=?(~ ^)
  9784. =/ dab=(map term hoon) q.q.n.dom
  9785. =/ dag (arms-check dab (get-arms dog p.n.dom))
  9786. |- ^- ?(~ ^)
  9787. ?: ?=(~ dab)
  9788. ~
  9789. =/ gog (get-arm-type log dag p.n.dab)
  9790. =+ vad=(hemp hud gog q.n.dab)
  9791. ?- dab
  9792. [* ~ ~] vad
  9793. [* ~ *] [vad $(dab r.dab)]
  9794. [* * ~] [vad $(dab l.dab)]
  9795. [* * *] [vad $(dab l.dab) $(dab r.dab)]
  9796. ==
  9797. ?- dom
  9798. [* ~ ~] dov
  9799. [* ~ *] [dov $(dom r.dom)]
  9800. [* * ~] [dov $(dom l.dom)]
  9801. [* * *] [dov $(dom l.dom) $(dom r.dom)]
  9802. ==
  9803. ::
  9804. :: all the below arms are used for gol checking and should have no
  9805. :: effect other than giving more specific errors
  9806. ::
  9807. :: +gol-type: all the possible types we could be expecting.
  9808. ::
  9809. +$ gol-type
  9810. $~ %noun
  9811. $@ %noun
  9812. $% [%cell p=type q=type]
  9813. [%core p=type q=coil]
  9814. [%fork p=(set gol-type)]
  9815. ==
  9816. :: +core-check: check that we're looking for a core
  9817. ::
  9818. ++ core-check
  9819. |= log=type
  9820. |- ^- gol-type
  9821. ?+ log $(log repo(sut log))
  9822. %noun (nice log &)
  9823. %void (nice %noun |)
  9824. [%atom *] (nice %noun |)
  9825. [%cell *] (nice log (nest(sut p.log) & %noun))
  9826. [%core *] (nice log(r.p.q %gold) &)
  9827. [%fork *]
  9828. =/ tys ~(tap in p.log)
  9829. :- %fork
  9830. |- ^- (set gol-type)
  9831. ?~ tys
  9832. ~
  9833. =/ a ^$(log i.tys)
  9834. =/ b $(tys t.tys)
  9835. (~(put in b) a)
  9836. ==
  9837. :: +chapters-check: check we have the expected number of chapters
  9838. ::
  9839. ++ chapters-check
  9840. |= log=gol-type
  9841. |- ^- gol-type
  9842. ?- log
  9843. %noun (nice log &)
  9844. [%cell *] (nice log &)
  9845. [%core *] ~_ leaf+"core-number-of-chapters"
  9846. (nice log =(~(wyt by dom) ~(wyt by q.r.q.log)))
  9847. [%fork *]
  9848. =/ tys ~(tap in p.log)
  9849. |- ^- gol-type
  9850. ?~ tys
  9851. log
  9852. =/ a ^$(log i.tys)
  9853. =/ b $(tys t.tys)
  9854. log
  9855. ==
  9856. :: +get-tomes: get map of tomes if exists
  9857. ::
  9858. ++ get-tomes
  9859. |= log=gol-type
  9860. ^- (unit (map term tome))
  9861. ?- log
  9862. %noun ~
  9863. [%cell *] ~
  9864. [%fork *] ~ :: maybe could be more aggressive
  9865. [%core *] `q.r.q.log
  9866. ==
  9867. :: +get-arms: get arms in tome
  9868. ::
  9869. ++ get-arms
  9870. |= [dog=(unit (map term tome)) nam=term]
  9871. ^- (unit (map term hoon))
  9872. %+ bind dog
  9873. |= a=(map term tome)
  9874. ~_ leaf+"unexpcted-chapter.{(trip nam)}"
  9875. q:(~(got by a) nam)
  9876. :: +arms-check: check we have the expected number of arms
  9877. ::
  9878. ++ arms-check
  9879. |= [dab=(map term hoon) dag=(unit (map term hoon))]
  9880. ?~ dag
  9881. dag
  9882. =/ a
  9883. =/ exp ~(wyt by u.dag)
  9884. =/ hav ~(wyt by dab)
  9885. ~_ =/ expt (scow %ud exp)
  9886. =/ havt (scow %ud hav)
  9887. leaf+"core-number-of-arms.exp={expt}.hav={havt}"
  9888. ~_ =/ missing ~(tap in (~(dif in ~(key by u.dag)) ~(key by dab)))
  9889. leaf+"missing.{<missing>}"
  9890. ~_ =/ extra ~(tap in (~(dif in ~(key by dab)) ~(key by u.dag)))
  9891. leaf+"extra.{<extra>}"
  9892. ~_ =/ have ~(tap in ~(key by dab))
  9893. leaf+"have.{<have>}"
  9894. (nice dag =(exp hav))
  9895. a
  9896. :: +get-arm-type: get expected type of this arm
  9897. ::
  9898. ++ get-arm-type
  9899. |= [log=gol-type dag=(unit (map term hoon)) nam=term]
  9900. ^- type
  9901. %- fall :_ %noun
  9902. %+ bind dag
  9903. |= a=(map term hoon)
  9904. =/ gen=hoon
  9905. ~_ leaf+"unexpected-arm.{(trip nam)}"
  9906. (~(got by a) nam)
  9907. (play(sut log) gen)
  9908. ::
  9909. ++ nice
  9910. |* [typ=* gud=?]
  9911. ?: gud
  9912. typ
  9913. ~_ leaf+"core-nice"
  9914. !!
  9915. --
  9916. ::
  9917. ++ mint
  9918. ~/ %mint
  9919. |= [gol=type gen=hoon]
  9920. ^- [p=type q=nock]
  9921. ::~& %pure-mint
  9922. |^ ^- [p=type q=nock]
  9923. ?: ?&(=(%void sut) !?=([%dbug *] gen))
  9924. ?. |(!vet ?=([%lost *] gen) ?=([%zpzp *] gen))
  9925. ~>(%mean.'mint-vain' !!)
  9926. [%void %0 0]
  9927. ?- gen
  9928. ::
  9929. [^ *]
  9930. =+ hed=$(gen p.gen, gol %noun)
  9931. =+ tal=$(gen q.gen, gol %noun)
  9932. [(nice (cell p.hed p.tal)) (cons q.hed q.tal)]
  9933. ::
  9934. [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen)
  9935. [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen)
  9936. ::
  9937. [%cnts *] (~(mint et p.gen q.gen) gol)
  9938. ::
  9939. [%dtkt *]
  9940. =+ nef=$(gen [%kttr p.gen])
  9941. [p.nef [%12 [%1 hoon-version p.nef] q:$(gen q.gen, gol %noun)]]
  9942. ::
  9943. [%dtls *] [(nice [%atom %$ ~]) [%4 q:$(gen p.gen, gol [%atom %$ ~])]]
  9944. [%sand *] [(nice (play gen)) [%1 q.gen]]
  9945. [%rock *] [(nice (play gen)) [%1 q.gen]]
  9946. ::
  9947. [%dttr *]
  9948. [(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
  9949. ::
  9950. [%dtts *]
  9951. [(nice bool) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
  9952. ::
  9953. [%dtwt *] [(nice bool) [%3 q:$(gen p.gen, gol %noun)]]
  9954. [%hand *] [p.gen q.gen]
  9955. [%ktbr *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %iron)) q.vat])
  9956. ::
  9957. [%ktls *]
  9958. =+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)])
  9959. ::
  9960. [%ktpm *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %zinc)) q.vat])
  9961. [%ktsg *] (blow gol p.gen)
  9962. [%tune *] [(face p.gen sut) [%0 %1]]
  9963. [%ktwt *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %lead)) q.vat])
  9964. ::
  9965. [%note *]
  9966. =+ hum=$(gen q.gen)
  9967. [(hint [sut p.gen] p.hum) q.hum]
  9968. ::
  9969. [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen))
  9970. [%sggr *]
  9971. =+ hum=$(gen q.gen)
  9972. :: ?: &(huz !?=(%|(@ [?(%sgcn %sgls) ^]) p.gen))
  9973. :: hum
  9974. :- p.hum
  9975. :+ %11
  9976. ?- p.gen
  9977. @ p.gen
  9978. ^ [p.p.gen q:$(gen q.p.gen, gol %noun)]
  9979. ==
  9980. q.hum
  9981. ::
  9982. [%tsgr *]
  9983. =+ fid=$(gen p.gen, gol %noun)
  9984. =+ dov=$(sut p.fid, gen q.gen)
  9985. [p.dov (comb q.fid q.dov)]
  9986. ::
  9987. [%tscm *]
  9988. $(gen q.gen, sut (busk p.gen))
  9989. ::
  9990. [%wtcl *]
  9991. =+ nor=$(gen p.gen, gol bool)
  9992. =+ [fex=(gain p.gen) wux=(lose p.gen)]
  9993. ::
  9994. :: if either branch is impossible, eliminate it
  9995. :: (placing the conditional in a dynamic hint to preserve crashes)
  9996. ::
  9997. =+ ^= [ned duy]
  9998. ?- -
  9999. [%void %void] |+[%0 0]
  10000. [%void *] &+[%1 |]
  10001. [* %void] &+[%1 &]
  10002. * |+q.nor
  10003. ==
  10004. =+ hiq=$(sut fex, gen q.gen)
  10005. =+ ran=$(sut wux, gen r.gen)
  10006. =+ fol=(cond duy q.hiq q.ran)
  10007. [(fork p.hiq p.ran ~) ?.(ned fol [%11 [%toss q.nor] fol])]
  10008. ::
  10009. [%wthx *]
  10010. :- (nice bool)
  10011. =+ fid=(fend %read [[%& 1] q.gen])
  10012. (~(fish ar `type`p.fid `skin`p.gen) q.fid)
  10013. ::
  10014. [%fits *]
  10015. :- (nice bool)
  10016. =+ ref=(play p.gen)
  10017. =+ fid=(find %read q.gen)
  10018. ~| [%test q.gen]
  10019. |- ^- nock
  10020. ?- -.fid
  10021. %& ?- -.q.p.fid
  10022. %& (fish(sut ref) (tend p.p.fid))
  10023. %| $(fid [%| (fine fid)])
  10024. ==
  10025. %| [%7 q.p.fid (fish(sut ref) 1)]
  10026. ==
  10027. ::
  10028. [%dbug *]
  10029. ~_ (show %o p.gen)
  10030. =+ hum=$(gen q.gen)
  10031. [p.hum [%11 [%spot %1 p.gen] q.hum]]
  10032. ::
  10033. [%zpcm *] [(nice (play p.gen)) [%1 q.gen]] :: XX validate!
  10034. [%lost *]
  10035. ?: vet
  10036. ~_ (dunk(sut (play p.gen)) 'lost')
  10037. ~>(%mean.'mint-lost' !!)
  10038. [%void [%0 0]]
  10039. ::
  10040. [%zpmc *]
  10041. =+ vos=$(gol %noun, gen q.gen)
  10042. =+ ref=p:$(gol %noun, gen p.gen)
  10043. [(nice (cell ref p.vos)) (cons [%1 burp(sut p.vos)] q.vos)]
  10044. ::
  10045. [%zpgl *]
  10046. =/ typ (nice (play [%kttr p.gen]))
  10047. =/ val
  10048. =< q
  10049. %_ $
  10050. gol %noun
  10051. gen
  10052. :^ %wtcl
  10053. :+ %cncl [%limb %levi]
  10054. :~ [%tsgr [%zpgr [%kttr p.gen]] [%$ 2]]
  10055. [%tsgr q.gen [%$ 2]]
  10056. ==
  10057. [%tsgr q.gen [%$ 3]]
  10058. [%zpzp ~]
  10059. ==
  10060. [typ val]
  10061. ::
  10062. [%zpts *] [(nice %noun) [%1 q:$(vet |, gen p.gen)]]
  10063. [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
  10064. ::
  10065. [%zpzp ~] [%void [%0 0]]
  10066. *
  10067. =+ doz=~(open ap gen)
  10068. ?: =(doz gen)
  10069. ~_ (show [%c 'hoon'] [%q gen])
  10070. ~>(%mean.'mint-open' !!)
  10071. $(gen doz)
  10072. ==
  10073. ::
  10074. ++ nice
  10075. |= typ=type
  10076. ~_ leaf+"mint-nice"
  10077. ?> ?|(!vet (nest(sut gol) & typ))
  10078. typ
  10079. ::
  10080. ++ grow
  10081. |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)]
  10082. ^- [p=type q=nock]
  10083. =+ dan=^$(gen ruf, gol %noun)
  10084. =+ pul=(mine gol mel nym hud dom)
  10085. [(nice p.pul) (cons q.pul q.dan)]
  10086. --
  10087. ::
  10088. ++ moot
  10089. =+ gil=*(set type)
  10090. |- ^- ?
  10091. ?- sut
  10092. [%atom *] |
  10093. [%cell *] |($(sut p.sut) $(sut q.sut))
  10094. [%core *] $(sut p.sut)
  10095. [%face *] $(sut q.sut)
  10096. [%fork *] (levy ~(tap in p.sut) |=(type ^$(sut +<)))
  10097. [%hint *] $(sut q.sut)
  10098. [%hold *] |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo))
  10099. %noun |
  10100. %void &
  10101. ==
  10102. ::
  10103. ++ mull
  10104. ~/ %mull
  10105. |= [gol=type dox=type gen=hoon]
  10106. |^ ^- [p=type q=type]
  10107. ?: =(%void sut)
  10108. ~>(%mean.'mull-none' !!)
  10109. ?- gen
  10110. ::
  10111. [^ *]
  10112. =+ hed=$(gen p.gen, gol %noun)
  10113. =+ tal=$(gen q.gen, gol %noun)
  10114. [(nice (cell p.hed p.tal)) (cell q.hed q.tal)]
  10115. ::
  10116. [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen)
  10117. [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen)
  10118. [%cnts *] (~(mull et p.gen q.gen) gol dox)
  10119. [%dtkt *] =+($(gen q.gen, gol %noun) $(gen [%kttr p.gen]))
  10120. [%dtls *] =+($(gen p.gen, gol [%atom %$ ~]) (beth [%atom %$ ~]))
  10121. [%sand *] (beth (play gen))
  10122. [%rock *] (beth (play gen))
  10123. ::
  10124. [%dttr *]
  10125. =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth %noun))
  10126. ::
  10127. [%dtts *]
  10128. =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth bool))
  10129. ::
  10130. [%dtwt *] =+($(gen p.gen, gol %noun) (beth bool)) :: XX =|
  10131. [%hand *] [p.gen p.gen]
  10132. [%ktbr *]
  10133. =+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) (wrap(sut q.vat) %iron)])
  10134. ::
  10135. [%ktls *]
  10136. =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)]
  10137. =+($(gen q.gen, gol p.hif) hif)
  10138. ::
  10139. [%ktpm *]
  10140. =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)])
  10141. ::
  10142. [%tune *]
  10143. [(face p.gen sut) (face p.gen dox)]
  10144. ::
  10145. [%ktwt *]
  10146. =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) (wrap(sut q.vat) %lead)])
  10147. ::
  10148. [%note *]
  10149. =+ vat=$(gen q.gen)
  10150. [(hint [sut p.gen] p.vat) (hint [dox p.gen] q.vat)]
  10151. ::
  10152. [%ktsg *] $(gen p.gen)
  10153. [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen))
  10154. [%sggr *] $(gen q.gen)
  10155. [%tsgr *]
  10156. =+ lem=$(gen p.gen, gol %noun)
  10157. $(gen q.gen, sut p.lem, dox q.lem)
  10158. ::
  10159. [%tscm *]
  10160. =/ boc (busk p.gen)
  10161. =/ nuf (busk(sut dox) p.gen)
  10162. $(gen q.gen, sut boc, dox nuf)
  10163. ::
  10164. [%wtcl *]
  10165. =+ nor=$(gen p.gen, gol bool)
  10166. =+ ^= hiq ^- [p=type q=type]
  10167. =+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)]
  10168. ?: =(%void p.fex)
  10169. :- %void
  10170. ?: =(%void q.fex)
  10171. %void
  10172. ~>(%mean.'if-z' (play(sut q.fex) q.gen))
  10173. ?: =(%void q.fex)
  10174. ~>(%mean.'mull-bonk-b' !!)
  10175. $(sut p.fex, dox q.fex, gen q.gen)
  10176. =+ ^= ran ^- [p=type q=type]
  10177. =+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)]
  10178. ?: =(%void p.wux)
  10179. :- %void
  10180. ?: =(%void q.wux)
  10181. %void
  10182. ~>(%mean.'if-a' (play(sut q.wux) r.gen))
  10183. ?: =(%void q.wux)
  10184. ~>(%mean.'mull-bonk-c' !!)
  10185. $(sut p.wux, dox q.wux, gen r.gen)
  10186. [(nice (fork p.hiq p.ran ~)) (fork q.hiq q.ran ~)]
  10187. ::
  10188. [%fits *]
  10189. =+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)]
  10190. =+ ^= syx :- p=(cove q:(mint %noun [%wing q.gen]))
  10191. q=(cove q:(mint(sut dox) %noun [%wing q.gen]))
  10192. =+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)]
  10193. ?. &(=(p.syx q.syx) =(p.pov q.pov))
  10194. ~>(%mean.'mull-bonk-a' !!)
  10195. (beth bool)
  10196. ::
  10197. [%wthx *]
  10198. ~> %mean.'mull-bonk-x'
  10199. =+ :- new=[type=p axis=q]:(fend %read [[%& 1] q.gen])
  10200. old=[type=p axis=q]:(fend(sut dox) %read [[%& 1] q.gen])
  10201. ?> =(axis.old axis.new)
  10202. ?> (nest(sut type.old) & type.new)
  10203. (beth bool)
  10204. ::
  10205. [%dbug *] ~_((show %o p.gen) $(gen q.gen))
  10206. [%zpcm *] [(nice (play p.gen)) (play(sut dox) p.gen)]
  10207. [%lost *]
  10208. ?: vet
  10209. :: ~_ (dunk(sut (play p.gen)) 'also')
  10210. ~>(%mean.'mull-skip' !!)
  10211. (beth %void)
  10212. ::
  10213. [%zpts *] (beth %noun)
  10214. ::
  10215. [%zpmc *]
  10216. =+ vos=$(gol %noun, gen q.gen) :: XX validate!
  10217. [(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)]
  10218. ::
  10219. [%zpgl *]
  10220. :: XX is this right?
  10221. (beth (play [%kttr p.gen]))
  10222. ::
  10223. [%zppt *]
  10224. =+ [(feel p.gen) (feel(sut dox) p.gen)]
  10225. ?. =(-< ->)
  10226. ~>(%mean.'mull-bonk-f' !!)
  10227. ?: -<
  10228. $(gen q.gen)
  10229. $(gen r.gen)
  10230. ::
  10231. [%zpzp *] (beth %void)
  10232. *
  10233. =+ doz=~(open ap gen)
  10234. ?: =(doz gen)
  10235. ~_ (show [%c 'hoon'] [%q gen])
  10236. ~>(%mean.'mull-open' !!)
  10237. $(gen doz)
  10238. ==
  10239. ::
  10240. ++ beth
  10241. |= typ=type
  10242. [(nice typ) typ]
  10243. ::
  10244. ++ nice
  10245. |= typ=type
  10246. :: ~_ (dunk(sut gol) 'need')
  10247. :: ~_ (dunk(sut typ) 'have')
  10248. ~_ leaf+"mull-nice"
  10249. ?> ?|(!vet (nest(sut gol) & typ))
  10250. typ
  10251. ::
  10252. ++ grow
  10253. |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)]
  10254. :: make al
  10255. ~_ leaf+"mull-grow"
  10256. ^- [p=type q=type]
  10257. =+ dan=^$(gen ruf, gol %noun)
  10258. =+ yaz=(mile(sut p.dan) q.dan mel nym hud dom)
  10259. [(nice p.yaz) q.yaz]
  10260. --
  10261. ++ meet |=(ref=type &((nest | ref) (nest(sut ref) | sut)))
  10262. :: ::
  10263. ++ miss :: nonintersection
  10264. |= $: :: ref: symmetric type
  10265. ::
  10266. ref=type
  10267. ==
  10268. :: intersection of sut and ref is empty
  10269. ::
  10270. ^- ?
  10271. =| gil=(set (set type))
  10272. =< dext
  10273. |%
  10274. ++ dext
  10275. ^- ?
  10276. ::
  10277. ?: =(ref sut)
  10278. (nest(sut %void) | sut)
  10279. ?- sut
  10280. %void &
  10281. %noun (nest(sut %void) | ref)
  10282. [%atom *] sint
  10283. [%cell *] sint
  10284. [%core *] sint(sut [%cell %noun %noun])
  10285. [%fork *] %+ levy ~(tap in p.sut)
  10286. |=(type dext(sut +<))
  10287. [%face *] dext(sut q.sut)
  10288. [%hint *] dext(sut q.sut)
  10289. [%hold *] =+ (~(gas in *(set type)) `(list type)`[sut ref ~])
  10290. ?: (~(has in gil) -)
  10291. &
  10292. %= dext
  10293. sut repo
  10294. gil (~(put in gil) -)
  10295. == ==
  10296. ++ sint
  10297. ?+ ref dext(sut ref, ref sut)
  10298. [%atom *] ?. ?=([%atom *] sut) &
  10299. ?& ?=(^ q.ref)
  10300. ?=(^ q.sut)
  10301. !=(q.ref q.sut)
  10302. ==
  10303. [%cell *] ?. ?=([%cell *] sut) &
  10304. ?| dext(sut p.sut, ref p.ref)
  10305. dext(sut q.sut, ref q.ref)
  10306. == ==
  10307. --
  10308. ++ mite |=(ref=type |((nest | ref) (nest(sut ref) & sut)))
  10309. ++ nest
  10310. ~/ %nest
  10311. |= [tel=? ref=type]
  10312. =| $: seg=(set type) :: degenerate sut
  10313. reg=(set type) :: degenerate ref
  10314. gil=(set [p=type q=type]) :: assume nest
  10315. ==
  10316. =< dext
  10317. ~% %nest-in ..$ ~
  10318. |%
  10319. ++ deem
  10320. |= [mel=vair ram=vair]
  10321. ^- ?
  10322. ?. |(=(mel ram) =(%lead mel) =(%gold ram)) |
  10323. ?- mel
  10324. %lead &
  10325. %gold meet
  10326. %iron dext(sut (peek(sut ref) %rite 2), ref (peek %rite 2))
  10327. %zinc dext(sut (peek %read 2), ref (peek(sut ref) %read 2))
  10328. ==
  10329. ::
  10330. ++ deep
  10331. |= $: dom=(map term tome)
  10332. vim=(map term tome)
  10333. ==
  10334. ^- ?
  10335. ?: ?=(~ dom) =(vim ~)
  10336. ?: ?=(~ vim) |
  10337. ?& =(p.n.dom p.n.vim)
  10338. $(dom l.dom, vim l.vim)
  10339. $(dom r.dom, vim r.vim)
  10340. ::
  10341. =+ [dab hem]=[q.q.n.dom q.q.n.vim]
  10342. |- ^- ?
  10343. ?: ?=(~ dab) =(hem ~)
  10344. ?: ?=(~ hem) |
  10345. ?& =(p.n.dab p.n.hem)
  10346. $(dab l.dab, hem l.hem)
  10347. $(dab r.dab, hem r.hem)
  10348. %= dext
  10349. sut (play q.n.dab)
  10350. ref (play(sut ref) q.n.hem)
  10351. == == ==
  10352. ::
  10353. ++ dext
  10354. =< $
  10355. ~% %nest-dext + ~
  10356. |.
  10357. ^- ?
  10358. =- ?: - &
  10359. ?. tel |
  10360. ~_ (dunk %need)
  10361. ~_ (dunk(sut ref) %have)
  10362. ~> %mean.'nest-fail'
  10363. !!
  10364. ?: =(sut ref) &
  10365. ?- sut
  10366. %void sint
  10367. %noun &
  10368. [%atom *] ?. ?=([%atom *] ref) sint
  10369. ?& (fitz p.sut p.ref)
  10370. |(?=(~ q.sut) =(q.sut q.ref))
  10371. ==
  10372. [%cell *] ?. ?=([%cell *] ref) sint
  10373. ?& dext(sut p.sut, ref p.ref, seg ~, reg ~)
  10374. dext(sut q.sut, ref q.ref, seg ~, reg ~)
  10375. ==
  10376. [%core *] ?. ?=([%core *] ref) sint
  10377. ?: =(q.sut q.ref) dext(sut p.sut, ref p.ref)
  10378. ?& =(q.p.q.sut q.p.q.ref) :: same wet/dry
  10379. meet(sut q.q.sut, ref p.sut)
  10380. dext(sut q.q.ref, ref p.ref)
  10381. (deem(sut q.q.sut, ref q.q.ref) r.p.q.sut r.p.q.ref)
  10382. ?: =(%wet q.p.q.sut) =(q.r.q.sut q.r.q.ref)
  10383. ?| (~(has in gil) [sut ref])
  10384. %. [q.r.q.sut q.r.q.ref]
  10385. %= deep
  10386. gil (~(put in gil) [sut ref])
  10387. sut sut(p q.q.sut, r.p.q %gold)
  10388. ref ref(p q.q.ref, r.p.q %gold)
  10389. == ==
  10390. ==
  10391. [%face *] dext(sut q.sut)
  10392. [%fork *] ?. ?=(?([%atom *] %noun [%cell *] [%core *]) ref) sint
  10393. (lien ~(tap in p.sut) |=(type dext(tel |, sut +<)))
  10394. [%hint *] dext(sut q.sut)
  10395. [%hold *] ?: (~(has in seg) sut) |
  10396. ?: (~(has in gil) [sut ref]) &
  10397. %= dext
  10398. sut repo
  10399. seg (~(put in seg) sut)
  10400. gil (~(put in gil) [sut ref])
  10401. == ==
  10402. ::
  10403. ++ meet &(dext dext(sut ref, ref sut))
  10404. ++ sint
  10405. ^- ?
  10406. ?- ref
  10407. %noun |
  10408. %void &
  10409. [%atom *] |
  10410. [%cell *] |
  10411. [%core *] dext(ref repo(sut ref))
  10412. [%face *] dext(ref q.ref)
  10413. [%fork *] (levy ~(tap in p.ref) |=(type dext(ref +<)))
  10414. [%hint *] dext(ref q.ref)
  10415. [%hold *] ?: (~(has in reg) ref) &
  10416. ?: (~(has in gil) [sut ref]) &
  10417. %= dext
  10418. ref repo(sut ref)
  10419. reg (~(put in reg) ref)
  10420. gil (~(put in gil) [sut ref])
  10421. == ==
  10422. --
  10423. ::
  10424. ++ peek
  10425. ~/ %peek
  10426. |= [way=?(%read %rite %both %free) axe=axis]
  10427. ^- type
  10428. ?: =(1 axe)
  10429. sut
  10430. =+ [now=(cap axe) lat=(mas axe)]
  10431. =+ gil=*(set type)
  10432. |- ^- type
  10433. ?- sut
  10434. [%atom *] %void
  10435. [%cell *] ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat))
  10436. [%core *]
  10437. ?. =(3 now) %noun
  10438. =+ pec=(peel way r.p.q.sut)
  10439. =/ tow
  10440. ?: =(1 lat) 1
  10441. (cap lat)
  10442. %= ^$
  10443. axe lat
  10444. sut
  10445. ?: ?| =([& &] pec)
  10446. &(sam.pec =(tow 2))
  10447. &(con.pec =(tow 3))
  10448. ==
  10449. p.sut
  10450. ~_ leaf+"payload-block"
  10451. ?. =(way %read) !!
  10452. %+ cell
  10453. ?.(sam.pec %noun ^$(sut p.sut, axe 2))
  10454. ?.(con.pec %noun ^$(sut p.sut, axe 3))
  10455. ==
  10456. ::
  10457. [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
  10458. [%hold *]
  10459. ?: (~(has in gil) sut)
  10460. %void
  10461. $(gil (~(put in gil) sut), sut repo)
  10462. ::
  10463. %void %void
  10464. %noun %noun
  10465. * $(sut repo)
  10466. ==
  10467. ::
  10468. ++ peel
  10469. |= [way=vial met=?(%gold %iron %lead %zinc)]
  10470. ^- [sam=? con=?]
  10471. ?: ?=(%gold met) [& &]
  10472. ?- way
  10473. %both [| |]
  10474. %free [& &]
  10475. %read [?=(%zinc met) |]
  10476. %rite [?=(%iron met) |]
  10477. ==
  10478. ::
  10479. ++ play
  10480. ~/ %play
  10481. => .(vet |)
  10482. |= gen=hoon
  10483. ^- type
  10484. ?- gen
  10485. [^ *] (cell $(gen p.gen) $(gen q.gen))
  10486. [%brcn *] (core sut [p.gen %dry %gold] sut *seminoun q.gen)
  10487. [%brpt *] (core sut [p.gen %wet %gold] sut *seminoun q.gen)
  10488. [%cnts *] ~(play et p.gen q.gen)
  10489. [%dtkt *] $(gen [%kttr p.gen])
  10490. [%dtls *] [%atom %$ ~]
  10491. [%rock *] |- ^- type
  10492. ?@ q.gen [%atom p.gen `q.gen]
  10493. [%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
  10494. [%sand *] ?@ q.gen
  10495. ?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen `q.gen])
  10496. ?: =(%f p.gen) ?>((lte q.gen 1) bool)
  10497. [%atom p.gen ~]
  10498. $(-.gen %rock)
  10499. [%tune *] (face p.gen sut)
  10500. [%dttr *] %noun
  10501. [%dtts *] bool
  10502. [%dtwt *] bool
  10503. [%hand *] p.gen
  10504. [%ktbr *] (wrap(sut $(gen p.gen)) %iron)
  10505. [%ktls *] $(gen p.gen)
  10506. [%ktpm *] (wrap(sut $(gen p.gen)) %zinc)
  10507. [%ktsg *] $(gen p.gen)
  10508. [%ktwt *] (wrap(sut $(gen p.gen)) %lead)
  10509. [%note *] (hint [sut p.gen] $(gen q.gen))
  10510. [%sgzp *] ~_(duck(sut ^$(gen p.gen)) $(gen q.gen))
  10511. [%sggr *] $(gen q.gen)
  10512. [%tsgr *] $(gen q.gen, sut $(gen p.gen))
  10513. [%tscm *] $(gen q.gen, sut (busk p.gen))
  10514. [%wtcl *] =+ [fex=(gain p.gen) wux=(lose p.gen)]
  10515. %- fork :~
  10516. ?:(=(%void fex) %void $(sut fex, gen q.gen))
  10517. ?:(=(%void wux) %void $(sut wux, gen r.gen))
  10518. ==
  10519. [%fits *] bool
  10520. [%wthx *] bool
  10521. [%dbug *] ~_((show %o p.gen) $(gen q.gen))
  10522. [%zpcm *] $(gen p.gen)
  10523. [%lost *] %void
  10524. [%zpmc *] (cell $(gen p.gen) $(gen q.gen))
  10525. [%zpgl *] (play [%kttr p.gen])
  10526. [%zpts *] %noun
  10527. [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
  10528. [%zpzp *] %void
  10529. * =+ doz=~(open ap gen)
  10530. ?: =(doz gen)
  10531. ~_ (show [%c 'hoon'] [%q gen])
  10532. ~> %mean.'play-open'
  10533. !!
  10534. $(gen doz)
  10535. ==
  10536. :: ::
  10537. ++ redo :: refurbish faces
  10538. ~/ %redo
  10539. |= $: :: ref: raw payload
  10540. ::
  10541. ref=type
  10542. ==
  10543. :: :type: subject refurbished to reference namespace
  10544. ::
  10545. ^- type
  10546. :: hos: subject tool stack
  10547. :: wec: reference tool stack set
  10548. :: gil: repetition set
  10549. ::
  10550. =| hos=(list tool)
  10551. =/ wec=(set (list tool)) [~ ~ ~]
  10552. =| gil=(set (pair type type))
  10553. =< :: errors imply subject/reference mismatch
  10554. ::
  10555. ~| %redo-match
  10556. :: reduce by subject
  10557. ::
  10558. dext
  10559. |%
  10560. :: ::
  10561. ++ dear :: resolve tool stack
  10562. :: :(unit (list tool)): unified tool stack
  10563. ::
  10564. ^- (unit (list tool))
  10565. :: empty implies void
  10566. ::
  10567. ?~ wec `~
  10568. :: any reference faces must be clear
  10569. ::
  10570. ?. ?=([* ~ ~] wec)
  10571. ~& [%dear-many wec]
  10572. ~
  10573. :- ~
  10574. :: har: single reference tool stack
  10575. ::
  10576. =/ har n.wec
  10577. :: len: lengths of [sut ref] face stacks
  10578. ::
  10579. =/ len [p q]=[(lent hos) (lent har)]
  10580. :: lip: length of sut-ref face stack overlap
  10581. ::
  10582. :: AB
  10583. :: BC
  10584. ::
  10585. :: +lip is (lent B), where +hay is forward AB
  10586. :: and +liv is forward BC (stack BA and CB).
  10587. ::
  10588. :: overlap is a weird corner case. +lip is
  10589. :: almost always 0. brute force is fine.
  10590. ::
  10591. =/ lip
  10592. =| lup=(unit @ud)
  10593. =| lip=@ud
  10594. |- ^- @ud
  10595. ?: |((gth lip p.len) (gth lip q.len))
  10596. (fall lup 0)
  10597. :: lep: overlap candidate: suffix of subject face stack
  10598. ::
  10599. =/ lep (slag (sub p.len lip) hos)
  10600. :: lap: overlap candidate: prefix of reference face stack
  10601. ::
  10602. =/ lap (scag lip har)
  10603. :: save any match and continue
  10604. ::
  10605. $(lip +(lip), lup ?.(=(lep lap) lup `lip))
  10606. :: ~& [har+har hos+hos len+len lip+lip]
  10607. :: produce combined face stack (forward ABC, stack CBA)
  10608. ::
  10609. (weld hos (slag lip har))
  10610. :: ::
  10611. ++ dext :: subject traverse
  10612. :: :type: refurbished subject
  10613. ::
  10614. ^- type
  10615. :: check for trivial cases
  10616. ::
  10617. ?: ?| =(sut ref)
  10618. ?=(?(%noun %void [?(%atom %core) *]) ref)
  10619. ==
  10620. done
  10621. :: ~_ (dunk 'redo: dext: sut')
  10622. :: ~_ (dunk(sut ref) 'redo: dext: ref')
  10623. ?- sut
  10624. ?(%noun %void [?(%atom %core) *])
  10625. :: reduce reference and reassemble leaf
  10626. ::
  10627. done:(sint &)
  10628. ::
  10629. [%cell *]
  10630. :: reduce reference to match subject
  10631. ::
  10632. => (sint &)
  10633. ?> ?=([%cell *] sut)
  10634. :: leaf with possible recursive descent
  10635. ::
  10636. %= done
  10637. sut
  10638. :: clear face stacks for descent
  10639. ::
  10640. =: hos ~
  10641. wec [~ ~ ~]
  10642. ==
  10643. :: descend into cell
  10644. ::
  10645. :+ %cell
  10646. dext(sut p.sut, ref (peek(sut ref) %free 2))
  10647. dext(sut q.sut, ref (peek(sut ref) %free 3))
  10648. ==
  10649. ::
  10650. [%face *]
  10651. :: push face on subject stack, and descend
  10652. ::
  10653. dext(hos [p.sut hos], sut q.sut)
  10654. ::
  10655. [%hint *]
  10656. :: work through hint
  10657. ::
  10658. (hint p.sut dext(sut q.sut))
  10659. ::
  10660. [%fork *]
  10661. :: reconstruct each case in fork
  10662. ::
  10663. (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
  10664. ::
  10665. [%hold *]
  10666. :: reduce to hard
  10667. ::
  10668. => (sint |)
  10669. ?> ?=([%hold *] sut)
  10670. ?: (~(has in fan) [p.sut q.sut])
  10671. :: repo loop; redo depends on its own product
  10672. ::
  10673. done:(sint &)
  10674. ?: (~(has in gil) [sut ref])
  10675. :: type recursion, stop renaming
  10676. ::
  10677. done:(sint |)
  10678. :: restore unchanged holds
  10679. ::
  10680. =+ repo
  10681. =- ?:(=(- +<) sut -)
  10682. dext(sut -, gil (~(put in gil) sut ref))
  10683. ==
  10684. :: ::
  10685. ++ done :: complete assembly
  10686. ^- type
  10687. :: :type: subject refurbished
  10688. ::
  10689. :: lov: combined face stack
  10690. ::
  10691. =/ lov
  10692. =/ lov dear
  10693. ?~ lov
  10694. :: ~_ (dunk 'redo: dear: sut')
  10695. :: ~_ (dunk(sut ref) 'redo: dear: ref')
  10696. ~& [%wec wec]
  10697. !!
  10698. (need lov)
  10699. :: recompose faces
  10700. ::
  10701. |- ^- type
  10702. ?~ lov sut
  10703. $(lov t.lov, sut (face i.lov sut))
  10704. ::
  10705. ++ sint :: reduce by reference
  10706. |= $: :: hod: expand holds
  10707. ::
  10708. hod=?
  10709. ==
  10710. :: ::.: reference with face/fork/hold reduced
  10711. ::
  10712. ^+ .
  10713. :: =- ~> %slog.[0 (dunk 'sint: sut')]
  10714. :: ~> %slog.[0 (dunk(sut ref) 'sint: ref')]
  10715. :: ~> %slog.[0 (dunk(sut =>(- ref)) 'sint: pro')]
  10716. :: -
  10717. ?+ ref .
  10718. [%hint *] $(ref q.ref)
  10719. [%face *]
  10720. :: extend all stacks in set
  10721. ::
  10722. %= $
  10723. ref q.ref
  10724. wec (~(run in wec) |=((list tool) [p.ref +<]))
  10725. ==
  10726. ::
  10727. [%fork *]
  10728. :: reconstruct all relevant cases
  10729. ::
  10730. =- :: ~> %slog.[0 (dunk 'fork: sut')]
  10731. :: ~> %slog.[0 (dunk(sut ref) 'fork: ref')]
  10732. :: ~> %slog.[0 (dunk(sut (fork ->)) 'fork: pro')]
  10733. +(wec -<, ref (fork ->))
  10734. =/ moy ~(tap in p.ref)
  10735. |- ^- (pair (set (list tool)) (list type))
  10736. ?~ moy [~ ~]
  10737. :: head recurse
  10738. ::
  10739. =/ mor $(moy t.moy)
  10740. :: prune reference cases outside subject
  10741. ::
  10742. ?: (miss i.moy) mor
  10743. :: unify all cases
  10744. ::
  10745. =/ dis ^$(ref i.moy)
  10746. [(~(uni in p.mor) wec.dis) [ref.dis q.mor]]
  10747. ::
  10748. [%hold *]
  10749. ?. hod .
  10750. $(ref repo(sut ref))
  10751. ==
  10752. --
  10753. ::
  10754. ++ repo
  10755. ^- type
  10756. ?- sut
  10757. [%core *] [%cell %noun p.sut]
  10758. [%face *] q.sut
  10759. [%hint *] q.sut
  10760. [%hold *] (rest [[p.sut q.sut] ~])
  10761. %noun (fork [%atom %$ ~] [%cell %noun %noun] ~)
  10762. * ~>(%mean.'repo-fltt' !!)
  10763. ==
  10764. ::
  10765. ++ rest
  10766. ~/ %rest
  10767. |= leg=(list [p=type q=hoon])
  10768. ^- type
  10769. ?: (lien leg |=([p=type q=hoon] (~(has in fan) [p q])))
  10770. ~>(%mean.'rest-loop' !!)
  10771. => .(fan (~(gas in fan) leg))
  10772. %- fork
  10773. %~ tap in
  10774. %- ~(gas in *(set type))
  10775. (turn leg |=([p=type q=hoon] (play(sut p) q)))
  10776. ::
  10777. ++ sink
  10778. ~/ %sink
  10779. |^ ^- cord
  10780. ?- sut
  10781. %void 'void'
  10782. %noun 'noun'
  10783. [%atom *] (rap 3 'atom ' p.sut ' ' ?~(q.sut '~' u.q.sut) ~)
  10784. [%cell *] (rap 3 'cell ' (mup p.sut) ' ' (mup q.sut) ~)
  10785. [%face *] (rap 3 'face ' ?@(p.sut p.sut (mup p.sut)) ' ' (mup q.sut) ~)
  10786. [%fork *] (rap 3 'fork ' (mup p.sut) ~)
  10787. [%hint *] (rap 3 'hint ' (mup p.sut) ' ' (mup q.sut) ~)
  10788. [%hold *] (rap 3 'hold ' (mup p.sut) ' ' (mup q.sut) ~)
  10789. ::
  10790. [%core *]
  10791. %+ rap 3
  10792. :~ 'core '
  10793. (mup p.sut)
  10794. ' '
  10795. ?~(p.p.q.sut '~' u.p.p.q.sut)
  10796. ' '
  10797. q.p.q.sut
  10798. ' '
  10799. r.p.q.sut
  10800. ' '
  10801. (mup q.q.sut)
  10802. ' '
  10803. (mup p.r.q.sut)
  10804. ==
  10805. ==
  10806. ::
  10807. ++ mup |=(* (scot %p (mug +<)))
  10808. --
  10809. ::
  10810. ++ take
  10811. |= [vit=vein duz=$-(type type)]
  10812. ^- (pair axis type)
  10813. :- (tend vit)
  10814. =. vit (flop vit)
  10815. |- ^- type
  10816. ?~ vit (duz sut)
  10817. ?~ i.vit
  10818. |- ^- type
  10819. ?+ sut ^$(vit t.vit)
  10820. [%face *] (face p.sut ^$(vit t.vit, sut q.sut))
  10821. [%hint *] (hint p.sut ^$(sut q.sut))
  10822. [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
  10823. [%hold *] $(sut repo)
  10824. ==
  10825. =+ vil=*(set type)
  10826. |- ^- type
  10827. ?: =(1 u.i.vit)
  10828. ^$(vit t.vit)
  10829. =+ [now lat]=(cap u.i.vit)^(mas u.i.vit)
  10830. ?- sut
  10831. %noun $(sut [%cell %noun %noun])
  10832. %void %void
  10833. [%atom *] %void
  10834. [%cell *] ?: =(2 now)
  10835. (cell $(sut p.sut, u.i.vit lat) q.sut)
  10836. (cell p.sut $(sut q.sut, u.i.vit lat))
  10837. [%core *] ?: =(2 now)
  10838. $(sut repo)
  10839. (core $(sut p.sut, u.i.vit lat) q.sut)
  10840. [%face *] (face p.sut $(sut q.sut))
  10841. [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
  10842. [%hint *] (hint p.sut $(sut q.sut))
  10843. [%hold *] ?: (~(has in vil) sut)
  10844. %void
  10845. $(sut repo, vil (~(put in vil) sut))
  10846. ==
  10847. ::
  10848. ++ tack
  10849. |= [hyp=wing mur=type]
  10850. ~_ (show [%c %tack] %l hyp)
  10851. =+ fid=(find %rite hyp)
  10852. ?> ?=(%& -.fid)
  10853. (take p.p.fid |=(type mur))
  10854. ::
  10855. ++ tend
  10856. |= vit=vein
  10857. ^- axis
  10858. ?~(vit 1 (peg $(vit t.vit) ?~(i.vit 1 u.i.vit)))
  10859. ::
  10860. ++ toss
  10861. ~/ %toss
  10862. |= [hyp=wing mur=type men=(list [p=type q=foot])]
  10863. ^- [p=axis q=(list [p=type q=foot])]
  10864. =- [(need p.wib) q.wib]
  10865. ^= wib
  10866. |- ^- [p=(unit axis) q=(list [p=type q=foot])]
  10867. ?~ men
  10868. [*(unit axis) ~]
  10869. =+ geq=(tack(sut p.i.men) hyp mur)
  10870. =+ mox=$(men t.men)
  10871. [(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]]
  10872. ::
  10873. ++ wrap
  10874. ~/ %wrap
  10875. |= yoz=?(%lead %iron %zinc)
  10876. ~_ leaf+"wrap"
  10877. ^- type
  10878. ?+ sut sut
  10879. [%cell *] (cell $(sut p.sut) $(sut q.sut))
  10880. [%core *] ?>(|(=(%gold r.p.q.sut) =(%lead yoz)) sut(r.p.q yoz))
  10881. [%face *] (face p.sut $(sut q.sut))
  10882. [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
  10883. [%hint *] (hint p.sut $(sut q.sut))
  10884. [%hold *] $(sut repo)
  10885. ==
  10886. --
  10887. ++ us :: prettyprinter
  10888. => |%
  10889. +$ cape [p=(map @ud wine) q=wine] ::
  10890. +$ wine ::
  10891. $@ $? %noun ::
  10892. %path ::
  10893. %type ::
  10894. %void ::
  10895. %wall ::
  10896. %wool ::
  10897. %yarn ::
  10898. == ::
  10899. $% [%mato p=term] ::
  10900. [%core p=(list @ta) q=wine] ::
  10901. [%face p=term q=wine] ::
  10902. [%list p=term q=wine] ::
  10903. [%pear p=term q=@] ::
  10904. [%bcwt p=(list wine)] ::
  10905. [%plot p=(list wine)] ::
  10906. [%stop p=@ud] ::
  10907. [%tree p=term q=wine] ::
  10908. [%unit p=term q=wine] ::
  10909. [%name p=stud q=wine] ::
  10910. == ::
  10911. --
  10912. |_ sut=type
  10913. ++ dash
  10914. |= [mil=tape lim=char lam=tape]
  10915. ^- tape
  10916. =/ esc (~(gas in *(set @tD)) lam)
  10917. :- lim
  10918. |- ^- tape
  10919. ?~ mil [lim ~]
  10920. ?: ?| =(lim i.mil)
  10921. =('\\' i.mil)
  10922. (~(has in esc) i.mil)
  10923. ==
  10924. ['\\' i.mil $(mil t.mil)]
  10925. ?: (lte ' ' i.mil)
  10926. [i.mil $(mil t.mil)]
  10927. ['\\' ~(x ne (rsh 2 i.mil)) ~(x ne (end 2 i.mil)) $(mil t.mil)]
  10928. ::
  10929. ++ deal |=(lum=* (dish dole lum))
  10930. ++ dial
  10931. |= ham=cape
  10932. =+ gid=*(set @ud)
  10933. =< `tank`-:$
  10934. |%
  10935. ++ many
  10936. |= haz=(list wine)
  10937. ^- [(list tank) (set @ud)]
  10938. ?~ haz [~ gid]
  10939. =^ mor gid $(haz t.haz)
  10940. =^ dis gid ^$(q.ham i.haz)
  10941. [[dis mor] gid]
  10942. ::
  10943. ++ $
  10944. ^- [tank (set @ud)]
  10945. ?- q.ham
  10946. %noun :_(gid [%leaf '*' ~])
  10947. %path :_(gid [%leaf '/' ~])
  10948. %type :_(gid [%leaf '#' 't' ~])
  10949. %void :_(gid [%leaf '#' '!' ~])
  10950. %wool :_(gid [%leaf '*' '"' '"' ~])
  10951. %wall :_(gid [%leaf '*' '\'' '\'' ~])
  10952. %yarn :_(gid [%leaf '"' '"' ~])
  10953. [%mato *] :_(gid [%leaf '@' (trip p.q.ham)])
  10954. [%core *]
  10955. =^ cox gid $(q.ham q.q.ham)
  10956. :_ gid
  10957. :+ %rose
  10958. [[' ' ~] ['<' ~] ['>' ~]]
  10959. |- ^- (list tank)
  10960. ?~ p.q.ham [cox ~]
  10961. [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
  10962. ::
  10963. [%face *]
  10964. =^ cox gid $(q.ham q.q.ham)
  10965. :_(gid [%palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
  10966. ::
  10967. [%list *]
  10968. =^ cox gid $(q.ham q.q.ham)
  10969. :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
  10970. ::
  10971. [%bcwt *]
  10972. =^ coz gid (many p.q.ham)
  10973. :_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
  10974. ::
  10975. [%plot *]
  10976. =^ coz gid (many p.q.ham)
  10977. :_(gid [%rose [[' ' ~] ['[' ~] [']' ~]] coz])
  10978. ::
  10979. [%pear *]
  10980. :_(gid [%leaf '%' ~(rend co [%$ p.q.ham q.q.ham])])
  10981. ::
  10982. [%stop *]
  10983. =+ num=~(rend co [%$ %ud p.q.ham])
  10984. ?: (~(has in gid) p.q.ham)
  10985. :_(gid [%leaf '#' num])
  10986. =^ cox gid
  10987. %= $
  10988. gid (~(put in gid) p.q.ham)
  10989. q.ham (~(got by p.ham) p.q.ham)
  10990. ==
  10991. :_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
  10992. ::
  10993. [%tree *]
  10994. =^ cox gid $(q.ham q.q.ham)
  10995. :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
  10996. ::
  10997. [%unit *]
  10998. =^ cox gid $(q.ham q.q.ham)
  10999. :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
  11000. ::
  11001. [%name *]
  11002. :_ gid
  11003. ?@ p.q.ham (cat 3 '#' mark.p.q.ham)
  11004. (rap 3 '#' auth.p.q.ham '+' (spat type.p.q.ham) ~)
  11005. ==
  11006. --
  11007. ::
  11008. ++ dish !:
  11009. |= [ham=cape lum=*] ^- tank
  11010. ~| [%dish-h ?@(q.ham q.ham -.q.ham)]
  11011. ~| [%lump lum]
  11012. ~| [%ham ham]
  11013. %- need
  11014. =| gil=(set [@ud *])
  11015. |- ^- (unit tank)
  11016. ?- q.ham
  11017. %noun
  11018. %= $
  11019. q.ham
  11020. ?: ?=(@ lum)
  11021. [%mato %$]
  11022. :- %plot
  11023. |- ^- (list wine)
  11024. [%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
  11025. ==
  11026. ::
  11027. %path
  11028. :- ~
  11029. :+ %rose
  11030. [['/' ~] ['/' ~] ~]
  11031. |- ^- (list tank)
  11032. ?~ lum ~
  11033. ?@ lum !!
  11034. ?> ?=(@ -.lum)
  11035. [[%leaf (rip 3 -.lum)] $(lum +.lum)]
  11036. ::
  11037. %type
  11038. =+ tyr=|.((dial dole))
  11039. =+ vol=tyr(sut lum)
  11040. =+ cis=;;(tank .*(vol [%9 2 %0 1]))
  11041. :^ ~ %palm
  11042. [~ ~ ~ ~]
  11043. [[%leaf '#' 't' '/' ~] cis ~]
  11044. ::
  11045. %wall
  11046. :- ~
  11047. :+ %rose
  11048. [[' ' ~] ['<' '|' ~] ['|' '>' ~]]
  11049. |- ^- (list tank)
  11050. ?~ lum ~
  11051. ?@ lum !!
  11052. [[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
  11053. ::
  11054. %wool
  11055. :- ~
  11056. :+ %rose
  11057. [[' ' ~] ['<' '<' ~] ['>' '>' ~]]
  11058. |- ^- (list tank)
  11059. ?~ lum ~
  11060. ?@ lum !!
  11061. [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
  11062. ::
  11063. %yarn
  11064. [~ %leaf (dash (tape lum) '"' "\{")]
  11065. ::
  11066. %void
  11067. ~
  11068. ::
  11069. [%mato *]
  11070. ?. ?=(@ lum)
  11071. ~
  11072. :+ ~
  11073. %leaf
  11074. ?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
  11075. ~(rend co [%$ p.q.ham lum])
  11076. %$ ~(rend co [%$ %ud lum])
  11077. %t (dash (rip 3 lum) '\'' ~)
  11078. %tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
  11079. ==
  11080. ::
  11081. [%core *]
  11082. :: XX needs rethinking for core metal
  11083. :: ?. ?=(^ lum) ~
  11084. :: => .(lum `*`lum)
  11085. :: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
  11086. :: ^= tok
  11087. :: |- ^- (unit (list tank))
  11088. :: ?~ p.q.ham
  11089. :: =+ den=^$(q.ham q.q.ham)
  11090. :: ?~(den ~ [~ u.den ~])
  11091. :: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
  11092. :: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
  11093. [~ (dial ham)]
  11094. ::
  11095. [%face *]
  11096. =+ wal=$(q.ham q.q.ham)
  11097. ?~ wal
  11098. ~
  11099. [~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
  11100. ::
  11101. [%list *]
  11102. ?: =(~ lum)
  11103. [~ %leaf '~' ~]
  11104. =- ?~ tok
  11105. ~
  11106. [~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
  11107. ^= tok
  11108. |- ^- (unit (list tank))
  11109. ?: ?=(@ lum)
  11110. ?.(=(~ lum) ~ [~ ~])
  11111. =+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
  11112. ?. &(?=(^ for) ?=(^ aft))
  11113. ~
  11114. [~ u.for u.aft]
  11115. ::
  11116. [%bcwt *]
  11117. |- ^- (unit tank)
  11118. ?~ p.q.ham
  11119. ~
  11120. =+ wal=^$(q.ham i.p.q.ham)
  11121. ?~ wal
  11122. $(p.q.ham t.p.q.ham)
  11123. wal
  11124. ::
  11125. [%plot *]
  11126. =- ?~ tok
  11127. ~
  11128. [~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
  11129. ^= tok
  11130. |- ^- (unit (list tank))
  11131. ?~ p.q.ham
  11132. ~
  11133. ?: ?=([* ~] p.q.ham)
  11134. =+ wal=^$(q.ham i.p.q.ham)
  11135. ?~(wal ~ [~ [u.wal ~]])
  11136. ?@ lum
  11137. ~
  11138. =+ gim=^$(q.ham i.p.q.ham, lum -.lum)
  11139. ?~ gim
  11140. ~
  11141. =+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
  11142. ?~ myd
  11143. ~
  11144. [~ u.gim u.myd]
  11145. ::
  11146. [%pear *]
  11147. ?. =(lum q.q.ham)
  11148. ~
  11149. =. p.q.ham
  11150. (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
  11151. =+ fox=$(q.ham [%mato p.q.ham])
  11152. ?> ?=([~ %leaf ^] fox)
  11153. ?: ?=(?(%n %tas) p.q.ham)
  11154. fox
  11155. [~ %leaf '%' p.u.fox]
  11156. ::
  11157. [%stop *]
  11158. ?: (~(has in gil) [p.q.ham lum]) ~
  11159. =+ kep=(~(get by p.ham) p.q.ham)
  11160. ?~ kep
  11161. ~|([%stop-loss p.q.ham] !!)
  11162. $(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
  11163. ::
  11164. [%tree *]
  11165. =- ?~ tok
  11166. ~
  11167. [~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
  11168. ^= tok
  11169. =+ tuk=*(list tank)
  11170. |- ^- (unit (list tank))
  11171. ?: =(~ lum)
  11172. [~ tuk]
  11173. ?. ?=([n=* l=* r=*] lum)
  11174. ~
  11175. =+ rol=$(lum r.lum)
  11176. ?~ rol
  11177. ~
  11178. =+ tim=^$(q.ham q.q.ham, lum n.lum)
  11179. ?~ tim
  11180. ~
  11181. $(lum l.lum, tuk [u.tim u.rol])
  11182. ::
  11183. [%unit *]
  11184. ?@ lum
  11185. ?.(=(~ lum) ~ [~ %leaf '~' ~])
  11186. ?. =(~ -.lum)
  11187. ~
  11188. =+ wal=$(q.ham q.q.ham, lum +.lum)
  11189. ?~ wal
  11190. ~
  11191. [~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
  11192. ::
  11193. [%name *]
  11194. $(q.ham q.q.ham)
  11195. ==
  11196. ::
  11197. ++ doge
  11198. |= ham=cape
  11199. =- ?+ woz woz
  11200. [%list * [%mato %'ta']] %path
  11201. [%list * [%mato %'t']] %wall
  11202. [%list * [%mato %'tD']] %yarn
  11203. [%list * %yarn] %wool
  11204. ==
  11205. ^= woz
  11206. ^- wine
  11207. ?. ?=([%stop *] q.ham)
  11208. ?: ?& ?= [%bcwt [%pear %n %0] [%plot [%pear %n %0] [%face *] ~] ~]
  11209. q.ham
  11210. =(1 (met 3 p.i.t.p.i.t.p.q.ham))
  11211. ==
  11212. [%unit =<([p q] i.t.p.i.t.p.q.ham)]
  11213. q.ham
  11214. =+ may=(~(get by p.ham) p.q.ham)
  11215. ?~ may
  11216. q.ham
  11217. =+ nul=[%pear %n 0]
  11218. ?. ?& ?=([%bcwt *] u.may)
  11219. ?=([* * ~] p.u.may)
  11220. |(=(nul i.p.u.may) =(nul i.t.p.u.may))
  11221. ==
  11222. q.ham
  11223. =+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
  11224. ?: ?& ?=([%plot [%face *] [%face * %stop *] ~] din)
  11225. =(p.q.ham p.q.i.t.p.din)
  11226. =(1 (met 3 p.i.p.din))
  11227. =(1 (met 3 p.i.t.p.din))
  11228. ==
  11229. :+ %list
  11230. (cat 3 p.i.p.din p.i.t.p.din)
  11231. q.i.p.din
  11232. ?: ?& ?= $: %plot
  11233. [%face *]
  11234. [%face * %stop *]
  11235. [[%face * %stop *] ~]
  11236. ==
  11237. din
  11238. =(p.q.ham p.q.i.t.p.din)
  11239. =(p.q.ham p.q.i.t.t.p.din)
  11240. =(1 (met 3 p.i.p.din))
  11241. =(1 (met 3 p.i.t.p.din))
  11242. =(1 (met 3 p.i.t.t.p.din))
  11243. ==
  11244. :+ %tree
  11245. %^ cat
  11246. 3
  11247. p.i.p.din
  11248. (cat 3 p.i.t.p.din p.i.t.t.p.din)
  11249. q.i.p.din
  11250. q.ham
  11251. ::
  11252. ++ dole
  11253. ^- cape
  11254. =+ gil=*(set type)
  11255. =+ dex=[p=*(map type @) q=*(map @ wine)]
  11256. =< [q.p q]
  11257. |- ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
  11258. =- [p.tez (doge q.p.tez q.tez)]
  11259. ^= tez
  11260. ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
  11261. ?: (~(meet ut sut) -:!>(*type))
  11262. [dex %type]
  11263. ?- sut
  11264. %noun [dex sut]
  11265. %void [dex sut]
  11266. [%atom *] [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
  11267. [%cell *]
  11268. =+ hin=$(sut p.sut)
  11269. =+ yon=$(dex p.hin, sut q.sut)
  11270. :- p.yon
  11271. :- %plot
  11272. ?:(?=([%plot *] q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
  11273. ::
  11274. [%core *]
  11275. =+ yad=$(sut p.sut)
  11276. :- p.yad
  11277. =+ ^= doy ^- [p=(list @ta) q=wine]
  11278. ?: ?=([%core *] q.yad)
  11279. [p.q.yad q.q.yad]
  11280. [~ q.yad]
  11281. :- %core
  11282. :_ q.doy
  11283. :_ p.doy
  11284. %^ cat 3
  11285. %~ rent co
  11286. :+ %$ %ud
  11287. %- ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
  11288. |=([[@ a=@u] b=@u] (add a b))
  11289. %^ cat 3
  11290. ?-(r.p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&')
  11291. =+ gum=(mug q.r.q.sut)
  11292. %+ can 3
  11293. :~ [1 (add 'a' (mod gum 26))]
  11294. [1 (add 'a' (mod (div gum 26) 26))]
  11295. [1 (add 'a' (mod (div gum 676) 26))]
  11296. ==
  11297. ::
  11298. [%hint *]
  11299. =+ yad=$(sut q.sut)
  11300. ?. ?=(%know -.q.p.sut) yad
  11301. [p.yad [%name p.q.p.sut q.yad]]
  11302. ::
  11303. [%face *]
  11304. =+ yad=$(sut q.sut)
  11305. ?^(p.sut yad [p.yad [%face p.sut q.yad]])
  11306. ::
  11307. [%fork *]
  11308. =+ yed=(sort ~(tap in p.sut) aor)
  11309. =- [p [%bcwt q]]
  11310. |- ^- [p=[p=(map type @) q=(map @ wine)] q=(list wine)]
  11311. ?~ yed
  11312. [dex ~]
  11313. =+ mor=$(yed t.yed)
  11314. =+ dis=^$(dex p.mor, sut i.yed)
  11315. [p.dis q.dis q.mor]
  11316. ::
  11317. [%hold *]
  11318. =+ hey=(~(get by p.dex) sut)
  11319. ?^ hey
  11320. [dex [%stop u.hey]]
  11321. ?: (~(has in gil) sut)
  11322. =+ dyr=+(~(wyt by p.dex))
  11323. [[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
  11324. =+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
  11325. =+ rey=(~(get by p.p.rom) sut)
  11326. ?~ rey
  11327. rom
  11328. [[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
  11329. ==
  11330. ::
  11331. ++ duck (dial dole)
  11332. --
  11333. ++ cain sell :: $-(vase tank)
  11334. ++ noah text :: $-(vase tape)
  11335. ++ onan seer :: $-(vise vase)
  11336. ++ levi :: $-([type type] ?)
  11337. |= [a=type b=type]
  11338. (~(nest ut a) & b)
  11339. ::
  11340. ++ text :: tape pretty-print
  11341. |= vax=vase ^- tape
  11342. ~(ram re (sell vax))
  11343. ::
  11344. ++ seem |=(toy=typo `type`toy) :: promote typo
  11345. ++ seer |=(vix=vise `vase`vix) :: promote vise
  11346. ::
  11347. :: +sell: pretty-print a vase to a tank using +deal.
  11348. ::
  11349. ++ sell
  11350. ~/ %sell
  11351. |= vax=vase
  11352. ^- tank
  11353. ~| %sell
  11354. (~(deal us p.vax) q.vax)
  11355. ::
  11356. :: +skol: $-(type tank) using duck.
  11357. ::
  11358. ++ skol
  11359. |= typ=type
  11360. ^- tank
  11361. ~(duck ut typ)
  11362. ::
  11363. ++ slam :: slam a gate
  11364. |= [gat=vase sam=vase] ^- vase
  11365. =+ :- ^= typ ^- type
  11366. [%cell p.gat p.sam]
  11367. ^= gen ^- hoon
  11368. [%cnsg [%$ ~] [%$ 2] [%$ 3] ~]
  11369. =+ gun=(~(mint ut typ) %noun gen)
  11370. [p.gun (slum q.gat q.sam)]
  11371. ::
  11372. :: +slab: states whether you can access an arm in a type.
  11373. ::
  11374. :: .way: the access type ($vial): read, write, or read-and-write.
  11375. :: The fourth case of $vial, %free, is not permitted because it would
  11376. :: allow you to discover "private" information about a type,
  11377. :: information which you could not make use of in (law-abiding) hoon anyway.
  11378. ::
  11379. ++ slab :: test if contains
  11380. |= [way=?(%read %rite %both) cog=@tas typ=type]
  11381. ?= [%& *]
  11382. (~(fond ut typ) way ~[cog])
  11383. ::
  11384. ++ slap
  11385. |= [vax=vase gen=hoon] ^- vase :: untyped vase .*
  11386. =+ gun=(~(mint ut p.vax) %noun gen)
  11387. [p.gun .*(q.vax q.gun)]
  11388. ::
  11389. ++ slog :: deify printf
  11390. =| pri=@ :: priority level
  11391. |= a=tang ^+ same :: .= ~&(%a 1)
  11392. ?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1)
  11393. :: ::
  11394. ++ mean :: crash with trace
  11395. |= a=tang
  11396. ^+ !!
  11397. ?~ a !!
  11398. ~_(i.a $(a t.a))
  11399. ::
  11400. ++ road
  11401. |* =(trap *)
  11402. ^+ $:trap
  11403. =/ res (mule trap)
  11404. ?- -.res
  11405. %& p.res
  11406. %| (mean p.res)
  11407. ==
  11408. ::
  11409. ++ slew :: get axis in vase
  11410. |= [axe=@ vax=vase]
  11411. =/ typ |. (~(peek ut p.vax) %free axe)
  11412. |- ^- (unit vase)
  11413. ?: =(1 axe) `[$:typ q.vax]
  11414. ?@ q.vax ~
  11415. $(axe (mas axe), q.vax ?-((cap axe) %2 -.q.vax, %3 +.q.vax))
  11416. ::
  11417. ++ slim :: identical to seer?
  11418. |= old=vise ^- vase
  11419. old
  11420. ::
  11421. ++ slit :: type of slam
  11422. |= [gat=type sam=type]
  11423. ?> (~(nest ut (~(peek ut gat) %free 6)) & sam)
  11424. (~(play ut [%cell gat sam]) [%cnsg [%$ ~] [%$ 2] [%$ 3] ~])
  11425. ::
  11426. ++ slob :: superficial arm
  11427. |= [cog=@tas typ=type]
  11428. ^- ?
  11429. ?+ typ |
  11430. [%hold *] $(typ ~(repo ut typ))
  11431. [%hint *] $(typ ~(repo ut typ))
  11432. [%core *]
  11433. |- ^- ?
  11434. ?~ q.r.q.typ |
  11435. ?| (~(has by q.q.n.q.r.q.typ) cog)
  11436. $(q.r.q.typ l.q.r.q.typ)
  11437. $(q.r.q.typ r.q.r.q.typ)
  11438. ==
  11439. ==
  11440. ::
  11441. ++ sloe :: get arms in core
  11442. |= typ=type
  11443. ^- (list term)
  11444. ?+ typ ~
  11445. [%hold *] $(typ ~(repo ut typ))
  11446. [%hint *] $(typ ~(repo ut typ))
  11447. [%core *]
  11448. %- zing
  11449. %+ turn ~(tap by q.r.q.typ)
  11450. |= [* b=tome]
  11451. %+ turn ~(tap by q.b)
  11452. |= [a=term *]
  11453. a
  11454. ==
  11455. ::
  11456. ++ slop :: cons two vases
  11457. |= [hed=vase tal=vase]
  11458. ^- vase
  11459. [[%cell p.hed p.tal] [q.hed q.tal]]
  11460. ::
  11461. ++ slot :: got axis in vase
  11462. |= [axe=@ vax=vase] ^- vase
  11463. [(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])]
  11464. ::
  11465. ++ slym :: slam w+o sample-type
  11466. |= [gat=vase sam=*] ^- vase
  11467. (slap gat(+<.q sam) [%limb %$])
  11468. ::
  11469. ++ sped :: reconstruct type
  11470. |= vax=vase
  11471. ^- vase
  11472. :_ q.vax
  11473. ?@ q.vax (~(fuse ut p.vax) [%atom %$ ~])
  11474. ?@ -.q.vax
  11475. ^= typ
  11476. %- ~(play ut p.vax)
  11477. [%wtgr [%wtts [%leaf %tas -.q.vax] [%& 2]~] [%$ 1]]
  11478. (~(fuse ut p.vax) [%cell %noun %noun])
  11479. :: +swat: deferred +slap
  11480. ::
  11481. ++ swat
  11482. |= [tap=(trap vase) gen=hoon]
  11483. ^- (trap vase)
  11484. =/ gun (~(mint ut p:$:tap) %noun gen)
  11485. |. ~+
  11486. [p.gun .*(q:$:tap q.gun)]
  11487. ::
  11488. :: 5d: parser
  11489. +| %parser
  11490. ::
  11491. :: +vang: set +vast params
  11492. ::
  11493. :: bug: debug mode
  11494. :: doc: doccord parsing
  11495. :: wer: where we are
  11496. ::
  11497. ++ vang
  11498. |= [f=$@(? [bug=? doc=?]) wer=path]
  11499. %*(. vast bug ?@(f f bug.f), doc ?@(f & doc.f), wer wer)
  11500. ::
  11501. ++ vast :: main parsing core
  11502. =+ [bug=`?`| wer=*path doc=`?`&]
  11503. |%
  11504. ++ gash %+ cook :: parse path
  11505. |= a=(list tyke) ^- tyke
  11506. ?~(a ~ (weld i.a $(a t.a)))
  11507. (more fas limp)
  11508. ++ gasp ;~ pose :: parse =path= etc.
  11509. %+ cook
  11510. |=([a=tyke b=tyke c=tyke] :(weld a b c))
  11511. ;~ plug
  11512. (cook |=(a=(list) (turn a |=(b=* ~))) (star tis))
  11513. (cook |=(a=hoon [[~ a] ~]) hasp)
  11514. (cook |=(a=(list) (turn a |=(b=* ~))) (star tis))
  11515. ==
  11516. (cook |=(a=(list) (turn a |=(b=* ~))) (plus tis))
  11517. ==
  11518. ++ glam ~+((glue ace))
  11519. ++ hasp ;~ pose :: path element
  11520. (ifix [sel ser] wide)
  11521. (stag %cncl (ifix [pal par] (most ace wide)))
  11522. (stag %sand (stag %tas (cold %$ buc)))
  11523. (stag %sand (stag %t qut))
  11524. %+ cook
  11525. |=(a=coin [%sand ?:(?=([~ %tas *] a) %tas %ta) ~(rent co a)])
  11526. nuck:so
  11527. ==
  11528. ++ limp %+ cook
  11529. |= [a=(list) b=tyke]
  11530. ?~ a b
  11531. $(a t.a, b [`[%sand %tas %$] b])
  11532. ;~(plug (star fas) gasp)
  11533. ++ mota %+ cook
  11534. |=([a=tape b=tape] (rap 3 (weld a b)))
  11535. ;~(plug (star low) (star hig))
  11536. ++ docs
  11537. |%
  11538. :: +apex: prefix comment. may contain batch comments.
  11539. ::
  11540. :: when a prefix doccord is parsed, it is possible that there is no +gap
  11541. :: afterward to be consumed, so we add an additional newline and
  11542. :: decrement the line number in the `hair` of the parser
  11543. ::
  11544. :: the reason for this is that the whitespace parsing under +vast seems
  11545. :: to factor more cleanly this way, at least compared to the variations
  11546. :: tried without the extra newline. this doesn't mean there isn't a
  11547. :: better factorization without it, though.
  11548. ++ apex
  11549. ?. doc (easy *whit)
  11550. %+ knee *whit |. ~+
  11551. ;~ plug
  11552. |= tub=nail
  11553. =/ vex
  11554. %. tub
  11555. %- star
  11556. %+ cook |*([[a=* b=*] c=*] [a b c])
  11557. ;~(pfix (punt leap) into ;~(pose larg smol))
  11558. ?~ q.vex vex
  11559. :- p=p.vex
  11560. %- some
  11561. ?~ p.u.q.vex
  11562. [p=~ q=q.u.q.vex]
  11563. :- p=(malt p.u.q.vex)
  11564. q=`nail`[[(dec p.p.q.u.q.vex) q.p.q.u.q.vex] ['\0a' q.q.u.q.vex]]
  11565. ==
  11566. ::
  11567. :: +apse: postfix comment.
  11568. ::
  11569. :: a one line comment at the end of a line (typically starting at column
  11570. :: 57) that attaches to the expression starting at the beginning of the
  11571. :: current line. does not use a $link.
  11572. ++ apse
  11573. ?. doc (easy *whiz)
  11574. %+ knee *whiz |. ~+
  11575. ;~ pose
  11576. ;~(less ;~(plug into step en-link col ace) ;~(pfix into step line))
  11577. ::
  11578. (easy *whiz)
  11579. ==
  11580. ::
  11581. ++ leap :: whitespace w/o docs
  11582. %+ cold ~
  11583. ;~ plug
  11584. ;~ pose
  11585. (just '\0a')
  11586. ;~(plug gah ;~(pose gah skip))
  11587. skip
  11588. ==
  11589. (star ;~(pose skip gah))
  11590. ==
  11591. ::
  11592. :: +smol: 2 aces then summary, 4 aces then paragraphs.
  11593. ++ smol
  11594. ;~ pfix
  11595. step
  11596. ;~ plug
  11597. ;~ plug
  11598. (plus en-link)
  11599. ;~ pose
  11600. (ifix [;~(plug col ace) (just '\0a')] (cook crip (plus prn)))
  11601. (ifix [(star ace) (just '\0a')] (easy *cord))
  11602. ==
  11603. ==
  11604. (rant ;~(pfix step step text))
  11605. ==
  11606. ==
  11607. ::
  11608. :: +larg: 4 aces then summary, 2 aces then paragraphs.
  11609. ++ larg
  11610. ;~ pfix
  11611. step step
  11612. ;~ plug
  11613. ;~ sfix
  11614. ;~ plug
  11615. ;~ pose
  11616. ;~(sfix (plus en-link) col ace)
  11617. ;~(less ace (easy *cuff))
  11618. ==
  11619. ;~(less ace (cook crip (plus prn)))
  11620. ==
  11621. (just '\0a')
  11622. ==
  11623. (rant ;~(pfix step teyt))
  11624. ==
  11625. ==
  11626. ::
  11627. ++ rant
  11628. |* sec=rule
  11629. %- star
  11630. ;~ pfix
  11631. (ifix [into (just '\0a')] (star ace))
  11632. (plus (ifix [into (just '\0a')] sec))
  11633. ==
  11634. ::
  11635. ++ skip :: non-doccord comment
  11636. ;~ plug
  11637. col col
  11638. ;~(less ;~(pose larg smol) ;~(plug (star prn) (just '\0a')))
  11639. ==
  11640. ::
  11641. ++ null (cold ~ (star ace))
  11642. ++ text (pick line code)
  11643. ++ teyt (pick line ;~(pfix step code))
  11644. ++ line ;~(less ace (cook crip (star prn)))
  11645. ++ code ;~(pfix step ;~(less ace (cook crip (star prn))))
  11646. ++ step ;~(plug ace ace)
  11647. ::
  11648. ++ into
  11649. ;~(plug (star ace) col col)
  11650. ::
  11651. ++ en-link
  11652. |= a=nail %. a
  11653. %+ knee *link |. ~+
  11654. %- stew
  11655. ^. stet ^. limo
  11656. :~ :- '|' ;~(pfix bar (stag %chat sym))
  11657. :- '.' ;~(pfix dot (stag %frag sym))
  11658. :- '+' ;~(pfix lus (stag %funk sym))
  11659. :- '$' ;~(pfix buc (stag %plan sym))
  11660. :- '%' ;~(pfix cen (stag %cone bisk:so))
  11661. ==
  11662. --
  11663. ::
  11664. ++ clad :: hoon doccords
  11665. |* fel=rule
  11666. %+ cook
  11667. |= [a=whit b=hoon c=whiz]
  11668. =? b !=(c *whiz)
  11669. [%note help/`[c]~ b]
  11670. =+ docs=~(tap by bat.a)
  11671. |-
  11672. ?~ docs b
  11673. $(docs t.docs, b [%note help/i.docs b])
  11674. (seam fel)
  11675. ++ coat :: spec doccords
  11676. |* fel=rule
  11677. %+ cook
  11678. |= [a=whit b=spec c=whiz]
  11679. =? b !=(c *whiz)
  11680. [%gist help/`[c]~ b]
  11681. =+ docs=~(tap by bat.a)
  11682. |-
  11683. ?~ docs b
  11684. $(docs t.docs, b [%gist help/i.docs b])
  11685. (seam fel)
  11686. ++ scye :: with prefix doccords
  11687. |* fel=rule
  11688. ;~(pose ;~(plug apex:docs ;~(pfix gap fel)) ;~(plug (easy *whit) fel))
  11689. ++ seam :: with doccords
  11690. |* fel=rule
  11691. (scye ;~(plug fel apse:docs))
  11692. ::
  11693. ++ plex :: reparse static path
  11694. |= gen=hoon ^- (unit path)
  11695. ?: ?=([%dbug *] gen) :: unwrap %dbug
  11696. $(gen q.gen)
  11697. ?. ?=([%clsg *] gen) ~ :: require :~ hoon
  11698. %+ reel p.gen :: build using elements
  11699. |= [a=hoon b=_`(unit path)`[~ u=/]] :: starting from just /
  11700. ?~ b ~
  11701. ?. ?=([%sand ?(%ta %tas) @] a) ~ :: /foo constants
  11702. `[q.a u.b]
  11703. ::
  11704. ++ phax
  11705. |= ruw=(list (list woof))
  11706. =+ [yun=*(list hoon) cah=*(list @)]
  11707. =+ wod=|=([a=tape b=(list hoon)] ^+(b ?~(a b [[%mcfs %knit (flop a)] b])))
  11708. |- ^+ yun
  11709. ?~ ruw
  11710. (flop (wod cah yun))
  11711. ?~ i.ruw $(ruw t.ruw)
  11712. ?@ i.i.ruw
  11713. $(i.ruw t.i.ruw, cah [i.i.ruw cah])
  11714. $(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)])
  11715. ::
  11716. ++ posh
  11717. |= [pre=(unit tyke) pof=(unit [p=@ud q=tyke])]
  11718. ^- (unit (list hoon))
  11719. =- ?^(- - ~&(%posh-fail -))
  11720. =+ wom=(poof wer)
  11721. %+ biff
  11722. ?~ pre `u=wom
  11723. %+ bind (poon wom u.pre)
  11724. |= moz=(list hoon)
  11725. ?~(pof moz (weld moz (slag (lent u.pre) wom)))
  11726. |= yez=(list hoon)
  11727. ?~ pof `yez
  11728. =+ zey=(flop yez)
  11729. =+ [moz=(scag p.u.pof zey) gul=(slag p.u.pof zey)]
  11730. =+ zom=(poon (flop moz) q.u.pof)
  11731. ?~(zom ~ `(weld (flop gul) u.zom))
  11732. ::
  11733. ++ poof :: path -> (list hoon)
  11734. |=(pax=path ^-((list hoon) (turn pax |=(a=@ta [%sand %ta a]))))
  11735. ::
  11736. :: tyke is =foo== as ~[~ `foo ~ ~]
  11737. :: interpolate '=' path components
  11738. ++ poon :: try to replace '='s
  11739. |= [pag=(list hoon) goo=tyke] :: default to pag
  11740. ^- (unit (list hoon)) :: for null goo's
  11741. ?~ goo `~ :: keep empty goo
  11742. %+ both :: otherwise head comes
  11743. ?^(i.goo i.goo ?~(pag ~ `u=i.pag)) :: from goo or pag
  11744. $(goo t.goo, pag ?~(pag ~ t.pag)) :: recurse on tails
  11745. ::
  11746. ++ poor
  11747. %+ sear posh
  11748. ;~ plug
  11749. (stag ~ gash)
  11750. ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~))
  11751. ==
  11752. ::
  11753. ++ porc
  11754. ;~ plug
  11755. (cook |=(a=(list) (lent a)) (star cen))
  11756. ;~(pfix fas gash)
  11757. ==
  11758. ::
  11759. ++ rump
  11760. %+ sear
  11761. |= [a=wing b=(unit hoon)] ^- (unit hoon)
  11762. ?~(b [~ %wing a] ?.(?=([@ ~] a) ~ [~ [%rock %tas i.a] u.b]))
  11763. ;~(plug rope ;~(pose (stag ~ wede) (easy ~)))
  11764. ::
  11765. ++ rood
  11766. ;~ pfix fas
  11767. (stag %clsg poor)
  11768. ==
  11769. ::
  11770. ++ reed
  11771. ;~ pfix fas
  11772. (stag %clsg (more fas stem))
  11773. ==
  11774. ::
  11775. ++ stem
  11776. %+ knee *hoon |. ~+
  11777. %+ cook
  11778. |= iota=$%([%hoon =hoon] iota)
  11779. ?@ iota [%rock %tas iota]
  11780. ?: ?=(%hoon -.iota) hoon.iota
  11781. [%clhp [%rock %tas -.iota] [%sand iota]]
  11782. |^ %- stew
  11783. ^. stet ^. limo
  11784. :~ :- 'a'^'z' ;~ pose
  11785. (spit (stag %cncl (ifix [pal par] (most ace wide))))
  11786. (spit (ifix [sel ser] wide))
  11787. (slot sym)
  11788. ==
  11789. :- '$' (cold %$ buc)
  11790. :- '0'^'9' (slot bisk:so)
  11791. :- '-' (slot tash:so)
  11792. :- '.' ;~(pfix dot zust:so)
  11793. :- '~' (slot ;~(pfix sig ;~(pose crub:so (easy [%n ~]))))
  11794. :- '\'' (stag %t qut)
  11795. :- '[' (slip (ifix [sel ser] wide))
  11796. :- '(' (slip (stag %cncl (ifix [pal par] (most ace wide))))
  11797. ==
  11798. ::
  11799. ++ slip |*(r=rule (stag %hoon r))
  11800. ++ slot |*(r=rule (sear (soft iota) r))
  11801. ++ spit
  11802. |* r=rule
  11803. %+ stag %hoon
  11804. %+ cook
  11805. |*([a=term b=*] `hoon`[%clhp [%rock %tas a] b])
  11806. ;~((glue lus) sym r)
  11807. --
  11808. ::
  11809. ++ rupl
  11810. %+ cook
  11811. |= [a=? b=(list hoon) c=?]
  11812. ?: a
  11813. ?: c
  11814. [%clsg [%clsg b] ~]
  11815. [%clsg b]
  11816. ?: c
  11817. [%clsg [%cltr b] ~]
  11818. [%cltr b]
  11819. ;~ plug
  11820. ;~ pose
  11821. (cold | (just '['))
  11822. (cold & (jest '~['))
  11823. ==
  11824. ::
  11825. ;~ pose
  11826. (ifix [ace gap] (most gap tall))
  11827. (most ace wide)
  11828. ==
  11829. ::
  11830. ;~ pose
  11831. (cold & (jest ']~'))
  11832. (cold | (just ']'))
  11833. ==
  11834. ==
  11835. ::
  11836. ::
  11837. ++ sail :: xml template
  11838. |= in-tall-form=? =| lin=?
  11839. |%
  11840. ::
  11841. ++ apex :: product hoon
  11842. %+ cook
  11843. |= tum=(each manx:hoot marl:hoot) ^- hoon
  11844. ?- -.tum
  11845. %& [%xray p.tum]
  11846. %| [%mcts p.tum]
  11847. ==
  11848. top-level
  11849. ::
  11850. ++ top-level :: entry-point
  11851. ;~(pfix mic ?:(in-tall-form tall-top wide-top))
  11852. ::
  11853. ++ inline-embed :: brace interpolation
  11854. %+ cook |=(a=tuna:hoot a)
  11855. ;~ pose
  11856. ;~(pfix mic bracketed-elem(in-tall-form |))
  11857. ;~(plug tuna-mode sump)
  11858. (stag %tape sump)
  11859. ==
  11860. ::
  11861. ++ script-or-style :: script or style
  11862. %+ cook |=(a=marx:hoot a)
  11863. ;~ plug
  11864. ;~(pose (jest %script) (jest %style))
  11865. wide-attrs
  11866. ==
  11867. ::
  11868. ++ tuna-mode :: xml node(s) kind
  11869. ;~ pose
  11870. (cold %tape hep)
  11871. (cold %manx lus)
  11872. (cold %marl tar)
  11873. (cold %call cen)
  11874. ==
  11875. ::
  11876. ++ wide-top :: wide outer top
  11877. %+ knee *(each manx:hoot marl:hoot) |. ~+
  11878. ;~ pose
  11879. (stag %| wide-quote)
  11880. (stag %| wide-paren-elems)
  11881. (stag %& ;~(plug tag-head wide-tail))
  11882. ==
  11883. ::
  11884. ++ wide-inner-top :: wide inner top
  11885. %+ knee *(each tuna:hoot marl:hoot) |. ~+
  11886. ;~ pose
  11887. wide-top
  11888. (stag %& ;~(plug tuna-mode wide))
  11889. ==
  11890. ::
  11891. ++ wide-attrs :: wide attributes
  11892. %+ cook |=(a=(unit mart:hoot) (fall a ~))
  11893. %- punt
  11894. %+ ifix [pal par]
  11895. %+ more (jest ', ')
  11896. ;~((glue ace) a-mane hopefully-quote)
  11897. ::
  11898. ++ wide-tail :: wide elements
  11899. %+ cook |=(a=marl:hoot a)
  11900. ;~(pose ;~(pfix col wrapped-elems) (cold ~ mic) (easy ~))
  11901. ::
  11902. ++ wide-elems :: wide elements
  11903. %+ cook |=(a=marl:hoot a)
  11904. %+ cook join-tops
  11905. (star ;~(pfix ace wide-inner-top))
  11906. ::
  11907. ++ wide-paren-elems :: wide flow
  11908. %+ cook |=(a=marl:hoot a)
  11909. %+ cook join-tops
  11910. (ifix [pal par] (more ace wide-inner-top))
  11911. ::
  11912. ::+|
  11913. ::
  11914. ++ drop-top
  11915. |= a=(each tuna:hoot marl:hoot) ^- marl:hoot
  11916. ?- -.a
  11917. %& [p.a]~
  11918. %| p.a
  11919. ==
  11920. ::
  11921. ++ join-tops
  11922. |= a=(list (each tuna:hoot marl:hoot)) ^- marl:hoot
  11923. (zing (turn a drop-top))
  11924. ::
  11925. ::+|
  11926. ::
  11927. ++ wide-quote :: wide quote
  11928. %+ cook |=(a=marl:hoot a)
  11929. ;~ pose
  11930. ;~ less (jest '"""')
  11931. (ifix [doq doq] (cook collapse-chars quote-innards))
  11932. ==
  11933. ::
  11934. %- inde
  11935. %+ ifix [(jest '"""\0a') (jest '\0a"""')]
  11936. (cook collapse-chars quote-innards(lin |))
  11937. ==
  11938. ::
  11939. ++ quote-innards :: wide+tall flow
  11940. %+ cook |=(a=(list $@(@ tuna:hoot)) a)
  11941. %- star
  11942. ;~ pose
  11943. ;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab))
  11944. inline-embed
  11945. ;~(less bas kel ?:(in-tall-form fail doq) prn)
  11946. ?:(lin fail ;~(less (jest '\0a"""') (just '\0a')))
  11947. ==
  11948. ::
  11949. ++ bracketed-elem :: bracketed element
  11950. %+ ifix [kel ker]
  11951. ;~(plug tag-head wide-elems)
  11952. ::
  11953. ++ wrapped-elems :: wrapped tuna
  11954. %+ cook |=(a=marl:hoot a)
  11955. ;~ pose
  11956. wide-paren-elems
  11957. (cook |=(@t `marl`[;/((trip +<))]~) qut)
  11958. (cook drop-top wide-top)
  11959. ==
  11960. ::
  11961. ++ a-mane :: mane as hoon
  11962. %+ cook
  11963. |= [a=@tas b=(unit @tas)]
  11964. ?~(b a [a u.b])
  11965. ;~ plug
  11966. mixed-case-symbol
  11967. ;~ pose
  11968. %+ stag ~
  11969. ;~(pfix cab mixed-case-symbol)
  11970. (easy ~)
  11971. ==
  11972. ==
  11973. ::
  11974. ++ en-class
  11975. |= a=(list [%class p=term])
  11976. ^- (unit [%class tape])
  11977. ?~ a ~
  11978. %- some
  11979. :- %class
  11980. |-
  11981. %+ welp (trip p.i.a)
  11982. ?~ t.a ~
  11983. [' ' $(a t.a)]
  11984. ::
  11985. ++ tag-head :: tag head
  11986. %+ cook
  11987. |= [a=mane:hoot b=mart:hoot c=mart:hoot]
  11988. ^- marx:hoot
  11989. [a (weld b c)]
  11990. ;~ plug
  11991. a-mane
  11992. ::
  11993. %+ cook
  11994. |= a=(list (unit [term (list beer:hoot)]))
  11995. ^- (list [term (list beer:hoot)])
  11996. :: discard nulls
  11997. (murn a same)
  11998. ;~ plug
  11999. (punt ;~(plug (cold %id hax) (cook trip sym)))
  12000. (cook en-class (star ;~(plug (cold %class dot) sym)))
  12001. (punt ;~(plug ;~(pose (cold %href fas) (cold %src pat)) soil))
  12002. (easy ~)
  12003. ==
  12004. ::
  12005. wide-attrs
  12006. ==
  12007. ::
  12008. ++ tall-top :: tall top
  12009. %+ knee *(each manx:hoot marl:hoot) |. ~+
  12010. ;~ pose
  12011. (stag %| ;~(pfix (plus ace) (cook collapse-chars quote-innards)))
  12012. (stag %& ;~(plug script-or-style script-style-tail))
  12013. (stag %& tall-elem)
  12014. (stag %| wide-quote)
  12015. (stag %| ;~(pfix tis tall-tail))
  12016. (stag %& ;~(pfix gar gap (stag [%div ~] cram)))
  12017. (stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~)))
  12018. (easy %| [;/("\0a")]~)
  12019. ==
  12020. ::
  12021. ++ tall-attrs :: tall attributes
  12022. %- star
  12023. ;~ pfix ;~(plug gap tis)
  12024. ;~((glue gap) a-mane hopefully-quote)
  12025. ==
  12026. ::
  12027. ++ tall-elem :: tall preface
  12028. %+ cook
  12029. |= [a=[p=mane:hoot q=mart:hoot] b=mart:hoot c=marl:hoot]
  12030. ^- manx:hoot
  12031. [[p.a (weld q.a b)] c]
  12032. ;~(plug tag-head tall-attrs tall-tail)
  12033. ::
  12034. ::REVIEW is there a better way to do this?
  12035. ++ hopefully-quote :: prefer "quote" form
  12036. %+ cook |=(a=(list beer:hoot) a)
  12037. %+ cook |=(a=hoon ?:(?=(%knit -.a) p.a [~ a]~))
  12038. wide
  12039. ::
  12040. ++ script-style-tail :: unescaped tall tail
  12041. %+ cook |=(a=marl:hoot a)
  12042. %+ ifix [gap ;~(plug gap duz)]
  12043. %+ most gap
  12044. ;~ pfix mic
  12045. %+ cook |=(a=tape ;/(a))
  12046. ;~ pose
  12047. ;~(pfix ace (star prn))
  12048. (easy "\0a")
  12049. ==
  12050. ==
  12051. ::
  12052. ++ tall-tail :: tall tail
  12053. ?> in-tall-form
  12054. %+ cook |=(a=marl:hoot a)
  12055. ;~ pose
  12056. (cold ~ mic)
  12057. ;~(pfix col wrapped-elems(in-tall-form |))
  12058. ;~(pfix col ace (cook collapse-chars(in-tall-form |) quote-innards))
  12059. (ifix [gap ;~(plug gap duz)] tall-kids)
  12060. ==
  12061. ::
  12062. ++ tall-kids :: child elements
  12063. %+ cook join-tops
  12064. :: look for sail first, or markdown if not
  12065. (most gap ;~(pose top-level (stag %| cram)))
  12066. ::
  12067. ++ collapse-chars :: group consec chars
  12068. |= reb=(list $@(@ tuna:hoot))
  12069. ^- marl:hoot
  12070. =| [sim=(list @) tuz=marl:hoot]
  12071. |- ^- marl:hoot
  12072. ?~ reb
  12073. =. sim
  12074. ?. in-tall-form sim
  12075. [10 |-(?~(sim sim ?:(=(32 i.sim) $(sim t.sim) sim)))]
  12076. ?~(sim tuz [;/((flop sim)) tuz])
  12077. ?@ i.reb
  12078. $(reb t.reb, sim [i.reb sim])
  12079. ?~ sim [i.reb $(reb t.reb, sim ~)]
  12080. [;/((flop sim)) i.reb $(reb t.reb, sim ~)]
  12081. --
  12082. ++ cram :: parse unmark
  12083. => |%
  12084. ++ item (pair mite marl:hoot) :: xml node generator
  12085. ++ colm @ud :: column
  12086. ++ tarp marl:hoot :: node or generator
  12087. ++ mite :: context
  12088. $? %down :: outer embed
  12089. %lunt :: unordered list
  12090. %lime :: list item
  12091. %lord :: ordered list
  12092. %poem :: verse
  12093. %bloc :: blockquote
  12094. %head :: heading
  12095. == ::
  12096. ++ trig :: line style
  12097. $: col=@ud :: start column
  12098. sty=trig-style :: style
  12099. == ::
  12100. ++ trig-style :: type of parsed line
  12101. $% $: %end :: terminator
  12102. $? %done :: end of input
  12103. %stet :: == end of markdown
  12104. %dent :: outdent
  12105. == == ::
  12106. $: %one :: leaf node
  12107. $? %rule :: --- horz rule
  12108. %fens :: ``` code fence
  12109. %expr :: ;sail expression
  12110. == == ::
  12111. [%new p=trig-new] :: open container
  12112. [%old %text] :: anything else
  12113. == ::
  12114. ++ trig-new :: start a
  12115. $? %lite :: + line item
  12116. %lint :: - line item
  12117. %head :: # heading
  12118. %bloc :: > block-quote
  12119. %poem :: [ ]{8} poem
  12120. == ::
  12121. ++ graf :: paragraph element
  12122. $% [%bold p=(list graf)] :: *bold*
  12123. [%talc p=(list graf)] :: _italics_
  12124. [%quod p=(list graf)] :: "double quote"
  12125. [%code p=tape] :: code literal
  12126. [%text p=tape] :: text symbol
  12127. [%link p=(list graf) q=tape] :: URL
  12128. [%mage p=tape q=tape] :: image
  12129. [%expr p=tuna:hoot] :: interpolated hoon
  12130. ==
  12131. --
  12132. =< (non-empty:parse |=(nail `(like tarp)`~($ main +<)))
  12133. |%
  12134. ++ main
  12135. ::
  12136. :: state of the parsing loop.
  12137. ::
  12138. :: we maintain a construction stack for elements and a line
  12139. :: stack for lines in the current block. a blank line
  12140. :: causes the current block to be parsed and thrown in the
  12141. :: current element. when the indent column retreats, the
  12142. :: element stack rolls up.
  12143. ::
  12144. :: .verbose: debug printing enabled
  12145. :: .err: error position
  12146. :: .ind: outer and inner indent level
  12147. :: .hac: stack of items under construction
  12148. :: .cur: current item under construction
  12149. :: .par: current "paragraph" being read in
  12150. :: .[loc txt]: parsing state
  12151. ::
  12152. =/ verbose &
  12153. =| err=(unit hair)
  12154. =| ind=[out=@ud inr=@ud]
  12155. =| hac=(list item)
  12156. =/ cur=item [%down ~]
  12157. =| par=(unit (pair hair wall))
  12158. |_ [loc=hair txt=tape]
  12159. ::
  12160. ++ $ :: resolve
  12161. ^- (like tarp)
  12162. => line
  12163. ::
  12164. :: if error position is set, produce error
  12165. ?. =(~ err)
  12166. ~& err+err
  12167. [+.err ~]
  12168. ::
  12169. :: all data was consumed
  12170. =- [loc `[- [loc txt]]]
  12171. => close-par
  12172. |- ^- tarp
  12173. ::
  12174. :: fold all the way to top
  12175. ?~ hac cur-to-tarp
  12176. $(..^$ close-item)
  12177. ::
  12178. ::+|
  12179. ::
  12180. ++ cur-indent
  12181. ?- p.cur
  12182. %down 2
  12183. %head 0
  12184. %lunt 0
  12185. %lime 2
  12186. %lord 0
  12187. %poem 8
  12188. %bloc 2
  12189. ==
  12190. ::
  12191. ++ back :: column retreat
  12192. |= luc=@ud
  12193. ^+ +>
  12194. ?: (gte luc inr.ind) +>
  12195. ::
  12196. :: nex: next backward step that terminates this context
  12197. =/ nex=@ud cur-indent :: REVIEW code and poem blocks are
  12198. :: handled elsewhere
  12199. ?: (gth nex (sub inr.ind luc))
  12200. ::
  12201. :: indenting pattern violation
  12202. ~? verbose indent-pattern-violation+[p.cur nex inr.ind luc]
  12203. ..^$(inr.ind luc, err `[p.loc luc])
  12204. =. ..^$ close-item
  12205. $(inr.ind (sub inr.ind nex))
  12206. ::
  12207. ++ cur-to-tarp :: item to tarp
  12208. ^- tarp
  12209. ?: ?=(?(%down %head %expr) p.cur)
  12210. (flop q.cur)
  12211. =- [[- ~] (flop q.cur)]~
  12212. ?- p.cur
  12213. %lunt %ul
  12214. %lord %ol
  12215. %lime %li
  12216. %poem %div ::REVIEW actual container element?
  12217. %bloc %blockquote
  12218. ==
  12219. ::
  12220. ++ close-item ^+ . :: complete and pop
  12221. ?~ hac .
  12222. %= .
  12223. hac t.hac
  12224. cur [p.i.hac (weld cur-to-tarp q.i.hac)]
  12225. ==
  12226. ::
  12227. ++ read-line :: capture raw line
  12228. =| lin=tape
  12229. |- ^+ [[lin *(unit _err)] +<.^$] :: parsed tape and halt/error
  12230. ::
  12231. :: no unterminated lines
  12232. ?~ txt
  12233. ~? verbose %unterminated-line
  12234. [[~ ``loc] +<.^$]
  12235. ?. =(`@`10 i.txt)
  12236. ?: (gth inr.ind q.loc)
  12237. ?. =(' ' i.txt)
  12238. ~? verbose expected-indent+[inr.ind loc txt]
  12239. [[~ ``loc] +<.^$]
  12240. $(txt t.txt, q.loc +(q.loc))
  12241. ::
  12242. :: save byte and repeat
  12243. $(txt t.txt, q.loc +(q.loc), lin [i.txt lin])
  12244. =. lin
  12245. ::
  12246. :: trim trailing spaces
  12247. |- ^- tape
  12248. ?: ?=([%' ' *] lin)
  12249. $(lin t.lin)
  12250. (flop lin)
  12251. ::
  12252. =/ eat-newline=nail [[+(p.loc) 1] t.txt]
  12253. =/ saw look(+<.$ eat-newline)
  12254. ::
  12255. ?: ?=([~ @ %end ?(%stet %dent)] saw) :: stop on == or dedent
  12256. [[lin `~] +<.^$]
  12257. [[lin ~] eat-newline]
  12258. ::
  12259. ++ look :: inspect line
  12260. ^- (unit trig)
  12261. %+ bind (wonk (look:parse loc txt))
  12262. |= a=trig ^+ a
  12263. ::
  12264. :: treat a non-terminator as a terminator
  12265. :: if it's outdented
  12266. ?: =(%end -.sty.a) a
  12267. ?: (lth col.a out.ind)
  12268. a(sty [%end %dent])
  12269. a
  12270. ::
  12271. ++ close-par :: make block
  12272. ^+ .
  12273. ::
  12274. :: empty block, no action
  12275. ?~ par .
  12276. ::
  12277. :: if block is verse
  12278. ?: ?=(%poem p.cur)
  12279. ::
  12280. :: add break between stanzas
  12281. =. q.cur ?~(q.cur q.cur [[[%br ~] ~] q.cur])
  12282. =- close-item(par ~, q.cur (weld - q.cur), inr.ind (sub inr.ind 8))
  12283. %+ turn q.u.par
  12284. |= tape ^- manx
  12285. ::
  12286. :: each line is a paragraph
  12287. :- [%p ~]
  12288. :_ ~
  12289. ;/("{+<}\0a")
  12290. ::
  12291. :: yex: block recomposed, with newlines
  12292. =/ yex=tape
  12293. %- zing
  12294. %+ turn (flop q.u.par)
  12295. |= a=tape
  12296. (runt [(dec inr.ind) ' '] "{a}\0a")
  12297. ::
  12298. :: vex: parse of paragraph
  12299. =/ vex=(like tarp)
  12300. ::
  12301. :: either a one-line header or a paragraph
  12302. %. [p.u.par yex]
  12303. ?: ?=(%head p.cur)
  12304. (full head:parse)
  12305. (full para:parse)
  12306. ::
  12307. :: if error, propagate correctly
  12308. ?~ q.vex
  12309. ~? verbose [%close-par p.cur yex]
  12310. ..$(err `p.vex)
  12311. ::
  12312. :: finish tag if it's a header
  12313. =< ?:(?=(%head p.cur) close-item ..$)
  12314. ::
  12315. :: save good result, clear buffer
  12316. ..$(par ~, q.cur (weld p.u.q.vex q.cur))
  12317. ::
  12318. ++ line ^+ . :: body line loop
  12319. ::
  12320. :: abort after first error
  12321. ?: !=(~ err) .
  12322. ::
  12323. :: saw: profile of this line
  12324. =/ saw look
  12325. ~? [debug=|] [%look ind=ind saw=saw txt=txt]
  12326. ::
  12327. :: if line is blank
  12328. ?~ saw
  12329. ::
  12330. :: break section
  12331. =^ a=[tape fin=(unit _err)] +<.$ read-line
  12332. ?^ fin.a
  12333. ..$(err u.fin.a)
  12334. =>(close-par line)
  12335. ::
  12336. :: line is not blank
  12337. => .(saw u.saw)
  12338. ::
  12339. :: if end of input, complete
  12340. ?: ?=(%end -.sty.saw)
  12341. ..$(q.loc col.saw)
  12342. ::
  12343. =. ind ?~(out.ind [col.saw col.saw] ind) :: init indents
  12344. ::
  12345. ?: ?| ?=(~ par) :: if after a paragraph or
  12346. ?& ?=(?(%down %lime %bloc) p.cur) :: unspaced new container
  12347. |(!=(%old -.sty.saw) (gth col.saw inr.ind))
  12348. == ==
  12349. => .(..$ close-par)
  12350. ::
  12351. :: if column has retreated, adjust stack
  12352. =. ..$ (back col.saw)
  12353. ::
  12354. =^ col-ok sty.saw
  12355. ?+ (sub col.saw inr.ind) [| sty.saw] :: columns advanced
  12356. %0 [& sty.saw]
  12357. %8 [& %new %poem]
  12358. ==
  12359. ?. col-ok
  12360. ~? verbose [%columns-advanced col.saw inr.ind]
  12361. ..$(err `[p.loc col.saw])
  12362. ::
  12363. =. inr.ind col.saw
  12364. ::
  12365. :: unless adding a matching item, close lists
  12366. =. ..$
  12367. ?: ?| &(?=(%lunt p.cur) !?=(%lint +.sty.saw))
  12368. &(?=(%lord p.cur) !?=(%lite +.sty.saw))
  12369. ==
  12370. close-item
  12371. ..$
  12372. ::
  12373. =< line(par `[loc ~]) ^+ ..$ :: continue with para
  12374. ?- -.sty.saw
  12375. %one (read-one +.sty.saw) :: parse leaves
  12376. %new (open-item p.sty.saw) :: open containers
  12377. %old ..$ :: just text
  12378. ==
  12379. ::
  12380. ::
  12381. ::- - - foo
  12382. :: detect bad block structure
  12383. ?. :: first line of container is legal
  12384. ?~ q.u.par &
  12385. ?- p.cur
  12386. ::
  12387. :: can't(/directly) contain text
  12388. ?(%lord %lunt) ~|(bad-leaf-container+p.cur !!)
  12389. ::
  12390. :: only one line in a header
  12391. %head |
  12392. ::
  12393. :: indented literals need to end with a blank line
  12394. %poem (gte col.saw inr.ind)
  12395. ::
  12396. :: text tarps must continue aligned
  12397. ?(%down %lunt %lime %lord %bloc) =(col.saw inr.ind)
  12398. ==
  12399. ~? verbose bad-block-structure+[p.cur inr.ind col.saw]
  12400. ..$(err `[p.loc col.saw])
  12401. ::
  12402. :: accept line and maybe continue
  12403. =^ a=[lin=tape fin=(unit _err)] +<.$ read-line
  12404. =. par par(q.u [lin.a q.u.par])
  12405. ?^ fin.a ..$(err u.fin.a)
  12406. line
  12407. ++ parse-block :: execute parser
  12408. |= fel=$-(nail (like tarp)) ^+ +>
  12409. =/ vex=(like tarp) (fel loc txt)
  12410. ?~ q.vex
  12411. ~? verbose [%parse-block txt]
  12412. +>.$(err `p.vex)
  12413. =+ [res loc txt]=u.q.vex
  12414. %_ +>.$
  12415. loc loc
  12416. txt txt
  12417. q.cur (weld (flop `tarp`res) q.cur) :: prepend to the stack
  12418. ==
  12419. ::
  12420. ++ read-one :: read %one item
  12421. |= sty=?(%expr %rule %fens) ^+ +>
  12422. ?- sty
  12423. %expr (parse-block expr:parse)
  12424. %rule (parse-block hrul:parse)
  12425. %fens (parse-block (fens:parse inr.ind))
  12426. ==
  12427. ::
  12428. ++ open-item :: enter list/quote
  12429. |= saw=trig-new
  12430. =< +>.$:apex
  12431. |%
  12432. ++ apex ^+ . :: open container
  12433. ?- saw
  12434. %poem (push %poem) :: verse literal
  12435. %head (push %head) :: heading
  12436. %bloc (entr %bloc) :: blockquote line
  12437. %lint (lent %lunt) :: unordered list
  12438. %lite (lent %lord) :: ordered list
  12439. ==
  12440. ::
  12441. ++ push :: push context
  12442. |=(mite +>(hac [cur hac], cur [+< ~]))
  12443. ::
  12444. ++ entr :: enter container
  12445. |= typ=mite
  12446. ^+ +>
  12447. ::
  12448. :: indent by 2
  12449. =. inr.ind (add 2 inr.ind)
  12450. ::
  12451. :: "parse" marker
  12452. =. txt (slag (sub inr.ind q.loc) txt)
  12453. =. q.loc inr.ind
  12454. ::
  12455. (push typ)
  12456. ::
  12457. ++ lent :: list entry
  12458. |= ord=?(%lord %lunt)
  12459. ^+ +>
  12460. => ?:(=(ord p.cur) +>.$ (push ord)) :: push list if new
  12461. (entr %lime)
  12462. --
  12463. --
  12464. ::
  12465. ++ parse :: individual parsers
  12466. |%
  12467. ++ look :: classify line
  12468. %+ cook |=(a=(unit trig) a)
  12469. ;~ pfix (star ace)
  12470. %+ here :: report indent
  12471. |=([a=pint b=?(~ trig-style)] ?~(b ~ `[q.p.a b]))
  12472. ;~ pose
  12473. (cold ~ (just `@`10)) :: blank line
  12474. ::
  12475. (full (easy [%end %done])) :: end of input
  12476. (cold [%end %stet] duz) :: == end of markdown
  12477. ::
  12478. (cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler
  12479. (cold [%one %fens] ;~(plug tic tic tic)) :: ``` code fence
  12480. (cold [%one %expr] mic) :: ;sail expression
  12481. ::
  12482. (cold [%new %head] ;~(plug (star hax) ace)) :: # heading
  12483. (cold [%new %lint] ;~(plug hep ace)) :: - line item
  12484. (cold [%new %lite] ;~(plug lus ace)) :: + line item
  12485. (cold [%new %bloc] ;~(plug gar ace)) :: > block-quote
  12486. ::
  12487. (easy [%old %text]) :: anything else
  12488. ==
  12489. ==
  12490. ::
  12491. ::
  12492. ++ calf :: cash but for tic tic
  12493. |* tem=rule
  12494. %- star
  12495. ;~ pose
  12496. ;~(pfix bas tem)
  12497. ;~(less tem prn)
  12498. ==
  12499. ++ cash :: escaped fence
  12500. |* tem=rule
  12501. %- echo
  12502. %- star
  12503. ;~ pose
  12504. whit
  12505. ;~(plug bas tem)
  12506. ;~(less tem prn)
  12507. ==
  12508. ::
  12509. ++ cool :: reparse
  12510. |* $: :: fex: primary parser
  12511. :: sab: secondary parser
  12512. ::
  12513. fex=rule
  12514. sab=rule
  12515. ==
  12516. |= [loc=hair txt=tape]
  12517. ^+ *sab
  12518. ::
  12519. :: vex: fenced span
  12520. =/ vex=(like tape) (fex loc txt)
  12521. ?~ q.vex vex
  12522. ::
  12523. :: hav: reparse full fenced text
  12524. =/ hav ((full sab) [loc p.u.q.vex])
  12525. ::
  12526. :: reparsed error position is always at start
  12527. ?~ q.hav [loc ~]
  12528. ::
  12529. :: the complete type with the main product
  12530. :- p.vex
  12531. `[p.u.q.hav q.u.q.vex]
  12532. ::
  12533. ::REVIEW surely there is a less hacky "first or after space" solution
  12534. ++ easy-sol :: parse start of line
  12535. |* a=*
  12536. |= b=nail
  12537. ?: =(1 q.p.b) ((easy a) b)
  12538. (fail b)
  12539. ::
  12540. ++ echo :: hoon literal
  12541. |* sab=rule
  12542. |= [loc=hair txt=tape]
  12543. ^- (like tape)
  12544. ::
  12545. :: vex: result of parsing wide hoon
  12546. =/ vex (sab loc txt)
  12547. ::
  12548. :: use result of expression parser
  12549. ?~ q.vex vex
  12550. =- [p.vex `[- q.u.q.vex]]
  12551. ::
  12552. :: but replace payload with bytes consumed
  12553. |- ^- tape
  12554. ?: =(q.q.u.q.vex txt) ~
  12555. ?~ txt ~
  12556. [i.txt $(txt +.txt)]
  12557. ::
  12558. ++ non-empty
  12559. |* a=rule
  12560. |= tub=nail ^+ (a)
  12561. =/ vex (a tub)
  12562. ~! vex
  12563. ?~ q.vex vex
  12564. ?. =(tub q.u.q.vex) vex
  12565. (fail tub)
  12566. ::
  12567. ::
  12568. ++ word :: tarp parser
  12569. %+ knee *(list graf) |. ~+
  12570. %+ cook
  12571. |= a=$%(graf [%list (list graf)])
  12572. ^- (list graf)
  12573. ?:(?=(%list -.a) +.a [a ~])
  12574. ;~ pose
  12575. ::
  12576. :: ordinary word
  12577. ::
  12578. %+ stag %text
  12579. ;~(plug ;~(pose low hig) (star ;~(pose nud low hig hep)))
  12580. ::
  12581. :: naked \escape
  12582. ::
  12583. (stag %text ;~(pfix bas (cook trip ;~(less ace prn))))
  12584. ::
  12585. :: trailing \ to add <br>
  12586. ::
  12587. (stag %expr (cold [[%br ~] ~] ;~(plug bas (just '\0a'))))
  12588. ::
  12589. :: *bold literal*
  12590. ::
  12591. (stag %bold (ifix [tar tar] (cool (cash tar) werk)))
  12592. ::
  12593. :: _italic literal_
  12594. ::
  12595. (stag %talc (ifix [cab cab] (cool (cash cab) werk)))
  12596. ::
  12597. :: "quoted text"
  12598. ::
  12599. (stag %quod (ifix [doq doq] (cool (cash doq) werk)))
  12600. ::
  12601. :: `classic markdown quote`
  12602. ::
  12603. (stag %code (ifix [tic tic] (calf tic)))
  12604. ::
  12605. :: ++arm, +$arm, +*arm, ++arm:core, ...
  12606. ::
  12607. %+ stag %code
  12608. ;~ plug
  12609. lus ;~(pose lus buc tar)
  12610. low (star ;~(pose nud low hep col))
  12611. ==
  12612. ::
  12613. :: [arbitrary *content*](url)
  12614. ::
  12615. %+ stag %link
  12616. ;~ (glue (punt whit))
  12617. (ifix [sel ser] (cool (cash ser) werk))
  12618. (ifix [pal par] (cash par))
  12619. ==
  12620. ::
  12621. :: ![alt text](url)
  12622. ::
  12623. %+ stag %mage
  12624. ;~ pfix zap
  12625. ;~ (glue (punt whit))
  12626. (ifix [sel ser] (cash ser))
  12627. (ifix [pal par] (cash par))
  12628. ==
  12629. ==
  12630. ::
  12631. :: #hoon
  12632. ::
  12633. %+ stag %list
  12634. ;~ plug
  12635. (stag %text ;~(pose (cold " " whit) (easy-sol ~)))
  12636. (stag %code ;~(pfix hax (echo wide)))
  12637. ;~(simu whit (easy ~))
  12638. ==
  12639. ::
  12640. :: direct hoon constant
  12641. ::
  12642. %+ stag %list
  12643. ;~ plug
  12644. (stag %text ;~(pose (cold " " whit) (easy-sol ~)))
  12645. ::
  12646. %+ stag %code
  12647. %- echo
  12648. ;~ pose
  12649. ::REVIEW just copy in 0x... parsers directly?
  12650. ;~(simu ;~(plug (just '0') alp) bisk:so)
  12651. ::
  12652. tash:so
  12653. ;~(pfix dot perd:so)
  12654. ;~(pfix sig ;~(pose twid:so (easy [%$ %n 0])))
  12655. ;~(pfix cen ;~(pose sym buc pam bar qut nuck:so))
  12656. ==
  12657. ::
  12658. ;~(simu whit (easy ~))
  12659. ==
  12660. ::
  12661. :: whitespace
  12662. ::
  12663. (stag %text (cold " " whit))
  12664. ::
  12665. :: {interpolated} sail
  12666. ::
  12667. (stag %expr inline-embed:(sail |))
  12668. ::
  12669. :: just a byte
  12670. ::
  12671. (stag %text (cook trip ;~(less ace prn)))
  12672. ==
  12673. ::
  12674. ++ werk (cook zing (star word)) :: indefinite tarp
  12675. ::
  12676. ++ down :: parse inline tarp
  12677. %+ knee *tarp |. ~+
  12678. =- (cook - werk)
  12679. ::
  12680. :: collect raw tarp into xml tags
  12681. |= gaf=(list graf)
  12682. ^- tarp
  12683. =< main
  12684. |%
  12685. ++ main
  12686. ^- tarp
  12687. ?~ gaf ~
  12688. ?. ?=(%text -.i.gaf)
  12689. (weld (item i.gaf) $(gaf t.gaf))
  12690. ::
  12691. :: fip: accumulate text blocks
  12692. =/ fip=(list tape) [p.i.gaf]~
  12693. |- ^- tarp
  12694. ?~ t.gaf [;/((zing (flop fip))) ~]
  12695. ?. ?=(%text -.i.t.gaf)
  12696. [;/((zing (flop fip))) ^$(gaf t.gaf)]
  12697. $(gaf t.gaf, fip :_(fip p.i.t.gaf))
  12698. ::
  12699. ++ item
  12700. |= nex=graf
  12701. ^- tarp ::CHECK can be tuna:hoot?
  12702. ?- -.nex
  12703. %text !! :: handled separately
  12704. %expr [p.nex]~
  12705. %bold [[%b ~] ^$(gaf p.nex)]~
  12706. %talc [[%i ~] ^$(gaf p.nex)]~
  12707. %code [[%code ~] ;/(p.nex) ~]~
  12708. %quod ::
  12709. :: smart quotes
  12710. %= ^$
  12711. gaf
  12712. :- [%text (tufa ~-~201c. ~)]
  12713. %+ weld p.nex
  12714. `(list graf)`[%text (tufa ~-~201d. ~)]~
  12715. ==
  12716. %link [[%a [%href q.nex] ~] ^$(gaf p.nex)]~
  12717. %mage [[%img [%src q.nex] ?~(p.nex ~ [%alt p.nex]~)] ~]~
  12718. ==
  12719. --
  12720. ::
  12721. ++ hrul :: empty besides fence
  12722. %+ cold [[%hr ~] ~]~
  12723. ;~(plug (star ace) hep hep hep (star hep) (just '\0a'))
  12724. ::
  12725. ++ tics
  12726. ;~(plug tic tic tic (just '\0a'))
  12727. ::
  12728. ++ fens
  12729. |= col=@u ~+
  12730. =/ ind (stun [(dec col) (dec col)] ace)
  12731. =/ ind-tics ;~(plug ind tics)
  12732. %+ cook |=(txt=tape `tarp`[[%pre ~] ;/(txt) ~]~)
  12733. ::
  12734. :: leading outdent is ok since container may
  12735. :: have already been parsed and consumed
  12736. %+ ifix [;~(plug (star ace) tics) ind-tics]
  12737. %^ stir "" |=([a=tape b=tape] "{a}\0a{b}")
  12738. ;~ pose
  12739. %+ ifix [ind (just '\0a')]
  12740. ;~(less tics (star prn))
  12741. ::
  12742. (cold "" ;~(plug (star ace) (just '\0a')))
  12743. ==
  12744. ::
  12745. ++ para :: paragraph
  12746. %+ cook
  12747. |=(a=tarp ?~(a ~ [[%p ~] a]~))
  12748. ;~(pfix (punt whit) down)
  12749. ::
  12750. ++ expr :: expression
  12751. => (sail &) :: tall-form
  12752. %+ ifix [(star ace) ;~(simu gap (easy))] :: look-ahead for gap
  12753. (cook drop-top top-level) :: list of tags
  12754. ::
  12755. ::
  12756. ++ whit :: whitespace
  12757. (cold ' ' (plus ;~(pose (just ' ') (just '\0a'))))
  12758. ::
  12759. ++ head :: parse heading
  12760. %+ cook
  12761. |= [haxes=tape kids=tarp] ^- tarp
  12762. =/ tag (crip 'h' <(lent haxes)>) :: e.g. ### -> %h3
  12763. =/ id (contents-to-id kids)
  12764. [[tag [%id id]~] kids]~
  12765. ::
  12766. ;~(pfix (star ace) ;~((glue whit) (stun [1 6] hax) down))
  12767. ::
  12768. ++ contents-to-id :: # text into elem id
  12769. |= a=(list tuna:hoot) ^- tape
  12770. =; raw=tape
  12771. %+ turn raw
  12772. |= @tD
  12773. ^- @tD
  12774. ?: ?| &((gte +< 'a') (lte +< 'z'))
  12775. &((gte +< '0') (lte +< '9'))
  12776. ==
  12777. +<
  12778. ?: &((gte +< 'A') (lte +< 'Z'))
  12779. (add 32 +<)
  12780. '-'
  12781. ::
  12782. :: collect all text in header tarp
  12783. |- ^- tape
  12784. ?~ a ~
  12785. %+ weld
  12786. ^- tape
  12787. ?- i.a
  12788. [[%$ [%$ *] ~] ~] :: text node contents
  12789. (murn v.i.a.g.i.a |=(a=beer:hoot ?^(a ~ (some a))))
  12790. [^ *] $(a c.i.a) :: concatenate children
  12791. [@ *] ~ :: ignore interpolation
  12792. ==
  12793. $(a t.a)
  12794. --
  12795. --
  12796. ::
  12797. ++ scad
  12798. %+ knee *spec |. ~+
  12799. %- stew
  12800. ^. stet ^. limo
  12801. :~
  12802. :- '_'
  12803. ;~(pfix cab (stag %bccb wide))
  12804. :- ','
  12805. ;~(pfix com (stag %bcmc wide))
  12806. :- '$'
  12807. (stag %like (most col rope))
  12808. :- '%'
  12809. ;~ pose
  12810. ;~ pfix cen
  12811. ;~ pose
  12812. (stag %leaf (stag %tas (cold %$ buc)))
  12813. (stag %leaf (stag %f (cold & pam)))
  12814. (stag %leaf (stag %f (cold | bar)))
  12815. (stag %leaf (stag %t qut))
  12816. (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so))
  12817. ==
  12818. ==
  12819. ==
  12820. :- '('
  12821. %+ cook |=(spec +<)
  12822. %+ stag %make
  12823. %+ ifix [pal par]
  12824. ;~ plug
  12825. wide
  12826. ;~(pose ;~(pfix ace (most ace wyde)) (easy ~))
  12827. ==
  12828. :- '['
  12829. (stag %bccl (ifix [sel ser] (most ace wyde)))
  12830. :- '*'
  12831. (cold [%base %noun] tar)
  12832. :- '/'
  12833. ;~(pfix fas (stag %loop ;~(pose (cold %$ buc) sym)))
  12834. :- '@'
  12835. ;~(pfix pat (stag %base (stag %atom mota)))
  12836. :- '?'
  12837. ;~ pose
  12838. %+ stag %bcwt
  12839. ;~(pfix wut (ifix [pal par] (most ace wyde)))
  12840. ::
  12841. (cold [%base %flag] wut)
  12842. ==
  12843. :- '~'
  12844. (cold [%base %null] sig)
  12845. :- '!'
  12846. (cold [%base %void] ;~(plug zap zap))
  12847. :- '^'
  12848. ;~ pose
  12849. (stag %like (most col rope))
  12850. (cold [%base %cell] ket)
  12851. ==
  12852. :- '='
  12853. ;~ pfix tis
  12854. %+ sear
  12855. |= [=(unit term) =spec]
  12856. %+ bind
  12857. ~(autoname ax spec)
  12858. |= =term
  12859. =* name ?~(unit term (cat 3 u.unit (cat 3 '-' term)))
  12860. [%bcts name spec]
  12861. ;~ pose
  12862. ;~(plug (stag ~ ;~(sfix sym tis)) wyde)
  12863. (stag ~ wyde)
  12864. ==
  12865. ==
  12866. :- ['a' 'z']
  12867. ;~ pose
  12868. (stag %bcts ;~(plug sym ;~(pfix tis wyde)))
  12869. (stag %like (most col rope))
  12870. ==
  12871. ==
  12872. ::
  12873. ++ scat
  12874. %+ knee *hoon |. ~+
  12875. %- stew
  12876. ^. stet ^. limo
  12877. :~
  12878. :- ','
  12879. ;~ pose
  12880. (stag %ktcl ;~(pfix com wyde))
  12881. (stag %wing rope)
  12882. ==
  12883. :- '!'
  12884. ;~ pose
  12885. (stag %wtzp ;~(pfix zap wide))
  12886. (stag %zpzp (cold ~ ;~(plug zap zap)))
  12887. ==
  12888. :- '_'
  12889. ;~(pfix cab (stag %ktcl (stag %bccb wide)))
  12890. :- '$'
  12891. ;~ pose
  12892. ;~ pfix buc
  12893. ;~ pose
  12894. :: XX: these are all obsolete in hoon 142
  12895. ::
  12896. (stag %leaf (stag %tas (cold %$ buc)))
  12897. (stag %leaf (stag %t qut))
  12898. (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so))
  12899. ==
  12900. ==
  12901. rump
  12902. ==
  12903. :- '%'
  12904. ;~ pfix cen
  12905. ;~ pose
  12906. (stag %clsg (sear |~([a=@ud b=tyke] (posh ~ ~ a b)) porc))
  12907. (stag %rock (stag %tas (cold %$ buc)))
  12908. (stag %rock (stag %f (cold & pam)))
  12909. (stag %rock (stag %f (cold | bar)))
  12910. (stag %rock (stag %t qut))
  12911. (cook (jock &) nuck:so)
  12912. (stag %clsg (sear |=(a=(list) (posh ~ ~ (lent a) ~)) (star cen)))
  12913. ==
  12914. ==
  12915. :- '&'
  12916. ;~ pose
  12917. (cook |=(a=wing [%cnts a ~]) rope)
  12918. (stag %wtpm ;~(pfix pam (ifix [pal par] (most ace wide))))
  12919. ;~(plug (stag %rock (stag %f (cold & pam))) wede)
  12920. (stag %sand (stag %f (cold & pam)))
  12921. ==
  12922. :- '\''
  12923. (stag %sand (stag %t qut))
  12924. :- '('
  12925. (stag %cncl (ifix [pal par] (most ace wide)))
  12926. :- '*'
  12927. ;~ pose
  12928. (stag %kttr ;~(pfix tar wyde))
  12929. (cold [%base %noun] tar)
  12930. ==
  12931. :- '@'
  12932. ;~(pfix pat (stag %base (stag %atom mota)))
  12933. :- '+'
  12934. ;~ pose
  12935. (stag %dtls ;~(pfix lus (ifix [pal par] wide)))
  12936. ::
  12937. %+ cook
  12938. |= a=(list (list woof))
  12939. :- %mcfs
  12940. [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
  12941. (most dog ;~(pfix lus soil))
  12942. ::
  12943. (cook |=(a=wing [%cnts a ~]) rope)
  12944. ==
  12945. :- '-'
  12946. ;~ pose
  12947. (stag %sand tash:so)
  12948. ::
  12949. %+ cook
  12950. |= a=(list (list woof))
  12951. [%clsg (phax a)]
  12952. (most dog ;~(pfix hep soil))
  12953. ::
  12954. (cook |=(a=wing [%cnts a ~]) rope)
  12955. ==
  12956. :- '.'
  12957. ;~ pose
  12958. (cook (jock |) ;~(pfix dot perd:so))
  12959. (cook |=(a=wing [%cnts a ~]) rope)
  12960. ==
  12961. :- ['0' '9']
  12962. %+ cook
  12963. |= [a=dime b=(unit hoon)]
  12964. ?~(b [%sand a] [[%rock a] u.b])
  12965. ;~(plug bisk:so (punt wede))
  12966. :- ':'
  12967. ;~ pfix col
  12968. ;~ pose
  12969. (stag %mccl (ifix [pal par] (most ace wide)))
  12970. ;~(pfix fas (stag %mcfs wide))
  12971. ==
  12972. ==
  12973. :- '='
  12974. ;~ pfix tis
  12975. ;~ pose
  12976. (stag %dtts (ifix [pal par] ;~(glam wide wide)))
  12977. ::
  12978. %+ sear
  12979. :: mainly used for +skin formation
  12980. ::
  12981. |= =spec
  12982. ^- (unit hoon)
  12983. %+ bind ~(autoname ax spec)
  12984. |=(=term `hoon`[%ktts term %kttr spec])
  12985. wyde
  12986. ==
  12987. ==
  12988. :- '?'
  12989. ;~ pose
  12990. %+ stag %ktcl
  12991. (stag %bcwt ;~(pfix wut (ifix [pal par] (most ace wyde))))
  12992. ::
  12993. (cold [%base %flag] wut)
  12994. ==
  12995. :- '['
  12996. rupl
  12997. :- '^'
  12998. ;~ pose
  12999. (stag %wing rope)
  13000. (cold [%base %cell] ket)
  13001. ==
  13002. :- '`'
  13003. ;~ pfix tic
  13004. ;~ pose
  13005. %+ cook
  13006. |=([a=@ta b=hoon] [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]])
  13007. ;~(pfix pat ;~(plug mota ;~(pfix tic wide)))
  13008. ;~ pfix tar
  13009. (stag %kthp (stag [%base %noun] ;~(pfix tic wide)))
  13010. ==
  13011. (stag %kthp ;~(plug wyde ;~(pfix tic wide)))
  13012. (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tic wide))))
  13013. (cook |=(a=hoon [[%rock %n ~] a]) wide)
  13014. ==
  13015. ==
  13016. :- '"'
  13017. %+ cook
  13018. |= a=(list (list woof))
  13019. [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
  13020. (most dog soil)
  13021. :- ['a' 'z']
  13022. rump
  13023. :- '|'
  13024. ;~ pose
  13025. (cook |=(a=wing [%cnts a ~]) rope)
  13026. (stag %wtbr ;~(pfix bar (ifix [pal par] (most ace wide))))
  13027. ;~(plug (stag %rock (stag %f (cold | bar))) wede)
  13028. (stag %sand (stag %f (cold | bar)))
  13029. ==
  13030. :- '~'
  13031. ;~ pose
  13032. rupl
  13033. ::
  13034. ;~ pfix sig
  13035. ;~ pose
  13036. (stag %clsg (ifix [sel ser] (most ace wide)))
  13037. ::
  13038. %+ stag %cnsg
  13039. %+ ifix
  13040. [pal par]
  13041. ;~(glam rope wide (most ace wide))
  13042. ::
  13043. (cook (jock |) twid:so)
  13044. (stag [%bust %null] wede)
  13045. (easy [%bust %null])
  13046. ==
  13047. ==
  13048. ==
  13049. :- '/'
  13050. rood
  13051. :- '<'
  13052. (ifix [gal gar] (stag %tell (most ace wide)))
  13053. :- '>'
  13054. (ifix [gar gal] (stag %yell (most ace wide)))
  13055. :- '#'
  13056. ;~(pfix hax reed)
  13057. ==
  13058. ++ soil
  13059. ;~ pose
  13060. ;~ less (jest '"""')
  13061. %+ ifix [doq doq]
  13062. %- star
  13063. ;~ pose
  13064. ;~(pfix bas ;~(pose bas doq kel bix:ab))
  13065. ;~(less doq bas kel prn)
  13066. (stag ~ sump)
  13067. ==
  13068. ==
  13069. ::
  13070. %- iny %+ ifix
  13071. [(jest '"""\0a') (jest '\0a"""')]
  13072. %- star
  13073. ;~ pose
  13074. ;~(pfix bas ;~(pose bas kel bix:ab))
  13075. ;~(less bas kel prn)
  13076. ;~(less (jest '\0a"""') (just `@`10))
  13077. (stag ~ sump)
  13078. ==
  13079. ==
  13080. ++ sump (ifix [kel ker] (stag %cltr (most ace wide)))
  13081. ++ norm :: rune regular form
  13082. |= tol=?
  13083. |%
  13084. ++ structure
  13085. %- stew
  13086. ^. stet ^. limo
  13087. :~ :- '$'
  13088. ;~ pfix buc
  13089. %- stew
  13090. ^. stet ^. limo
  13091. :~ [':' (rune col %bccl exqs)]
  13092. ['%' (rune cen %bccn exqs)]
  13093. ['<' (rune gal %bcgl exqb)]
  13094. ['>' (rune gar %bcgr exqb)]
  13095. ['^' (rune ket %bckt exqb)]
  13096. ['~' (rune sig %bcsg exqd)]
  13097. ['|' (rune bar %bcbr exqc)]
  13098. ['&' (rune pam %bcpm exqc)]
  13099. ['@' (rune pat %bcpt exqb)]
  13100. ['_' (rune cab %bccb expa)]
  13101. ['-' (rune hep %bchp exqb)]
  13102. ['=' (rune tis %bcts exqg)]
  13103. ['?' (rune wut %bcwt exqs)]
  13104. [';' (rune mic %bcmc expa)]
  13105. ['+' (rune lus %bcls exqg)]
  13106. ==
  13107. ==
  13108. :- '%'
  13109. ;~ pfix cen
  13110. %- stew
  13111. ^. stet ^. limo
  13112. :~ :- '^'
  13113. %+ cook
  13114. |= [%cnkt a=hoon b=spec c=spec d=spec]
  13115. [%make a b c d ~]
  13116. (rune ket %cnkt exqy)
  13117. ::
  13118. :- '+'
  13119. %+ cook
  13120. |= [%cnls a=hoon b=spec c=spec]
  13121. [%make a b c ~]
  13122. (rune lus %cnls exqx)
  13123. ::
  13124. :- '-'
  13125. %+ cook
  13126. |= [%cnhp a=hoon b=spec]
  13127. [%make a b ~]
  13128. (rune hep %cnhp exqd)
  13129. ::
  13130. :- '.'
  13131. %+ cook
  13132. |= [%cndt a=spec b=hoon]
  13133. [%make b a ~]
  13134. (rune dot %cndt exqc)
  13135. ::
  13136. :- ':'
  13137. %+ cook
  13138. |= [%cncl a=hoon b=(list spec)]
  13139. [%make a b]
  13140. (rune col %cncl exqz)
  13141. ==
  13142. ==
  13143. :- '#'
  13144. ;~ pfix hax fas
  13145. %+ stag %bccl
  13146. %+ cook
  13147. |= [[i=spec t=(list spec)] e=spec]
  13148. [i (snoc t e)]
  13149. ;~ plug
  13150. %+ most ;~(less ;~(plug fas tar) fas)
  13151. %- stew
  13152. ^. stet ^. limo
  13153. :~ :- ['a' 'z']
  13154. ;~ pose
  13155. :: /name=@aura
  13156. ::
  13157. %+ cook
  13158. |= [=term =aura]
  13159. ^- spec
  13160. :+ %bccl
  13161. [%leaf %tas aura]
  13162. :_ ~
  13163. :+ %bcts term
  13164. ?+ aura [%base %atom aura]
  13165. %f [%base %flag]
  13166. %n [%base %null]
  13167. ==
  13168. ;~(plug sym ;~(pfix tis pat mota))
  13169. ::
  13170. :: /constant
  13171. ::
  13172. (stag %leaf (stag %tas ;~(pose sym (cold %$ buc))))
  13173. ==
  13174. ::
  13175. :: /@aura
  13176. ::
  13177. :- '@'
  13178. %+ cook
  13179. |= =aura
  13180. ^- spec
  13181. :+ %bccl
  13182. [%leaf %tas aura]
  13183. [%base %atom aura]~
  13184. ;~(pfix pat mota)
  13185. ::
  13186. :: /?
  13187. ::
  13188. :- '?'
  13189. (cold [%bccl [%leaf %tas %f] [%base %flag] ~] wut)
  13190. ::
  13191. :: /~
  13192. ::
  13193. :- '~'
  13194. (cold [%bccl [%leaf %tas %n] [%base %null] ~] sig)
  13195. ==
  13196. ::
  13197. :: open-ended or fixed-length
  13198. ::
  13199. ;~ pose
  13200. (cold [%base %noun] ;~(plug fas tar))
  13201. (easy %base %null)
  13202. ==
  13203. ==
  13204. ==
  13205. ==
  13206. ++ expression
  13207. %- stew
  13208. ^. stet ^. limo
  13209. :~ :- '|'
  13210. ;~ pfix bar
  13211. %- stew
  13212. ^. stet ^. limo
  13213. :~ ['_' (rune cab %brcb exqr)]
  13214. ['%' (runo cen %brcn ~ expe)]
  13215. ['@' (runo pat %brpt ~ expe)]
  13216. [':' (rune col %brcl expb)]
  13217. ['.' (rune dot %brdt expa)]
  13218. ['-' (rune hep %brhp expa)]
  13219. ['^' (rune ket %brkt expr)]
  13220. ['~' (rune sig %brsg exqc)]
  13221. ['*' (rune tar %brtr exqc)]
  13222. ['=' (rune tis %brts exqc)]
  13223. ['?' (rune wut %brwt expa)]
  13224. ['$' (rune buc %brbc exqe)]
  13225. ==
  13226. ==
  13227. :- '$'
  13228. ;~ pfix buc
  13229. %- stew
  13230. ^. stet ^. limo
  13231. :~ ['@' (stag %ktcl (rune pat %bcpt exqb))]
  13232. ['_' (stag %ktcl (rune cab %bccb expa))]
  13233. [':' (stag %ktcl (rune col %bccl exqs))]
  13234. ['%' (stag %ktcl (rune cen %bccn exqs))]
  13235. ['<' (stag %ktcl (rune gal %bcgl exqb))]
  13236. ['>' (stag %ktcl (rune gar %bcgr exqb))]
  13237. ['|' (stag %ktcl (rune bar %bcbr exqc))]
  13238. ['&' (stag %ktcl (rune pam %bcpm exqc))]
  13239. ['^' (stag %ktcl (rune ket %bckt exqb))]
  13240. ['~' (stag %ktcl (rune sig %bcsg exqd))]
  13241. ['-' (stag %ktcl (rune hep %bchp exqb))]
  13242. ['=' (stag %ktcl (rune tis %bcts exqg))]
  13243. ['?' (stag %ktcl (rune wut %bcwt exqs))]
  13244. ['+' (stag %ktcl (rune lus %bcls exqg))]
  13245. ['.' (rune dot %kttr exqa)]
  13246. [',' (rune com %ktcl exqa)]
  13247. ==
  13248. ==
  13249. :- '%'
  13250. ;~ pfix cen
  13251. %- stew
  13252. ^. stet ^. limo
  13253. :~ ['_' (rune cab %cncb exph)]
  13254. ['.' (rune dot %cndt expb)]
  13255. ['^' (rune ket %cnkt expd)]
  13256. ['+' (rune lus %cnls expc)]
  13257. ['-' (rune hep %cnhp expb)]
  13258. [':' (rune col %cncl expi)]
  13259. ['~' (rune sig %cnsg expn)]
  13260. ['*' (rune tar %cntr expm)]
  13261. ['=' (rune tis %cnts exph)]
  13262. ==
  13263. ==
  13264. :- ':'
  13265. ;~ pfix col
  13266. %- stew
  13267. ^. stet ^. limo
  13268. :~ ['_' (rune cab %clcb expb)]
  13269. ['^' (rune ket %clkt expd)]
  13270. ['+' (rune lus %clls expc)]
  13271. ['-' (rune hep %clhp expb)]
  13272. ['~' (rune sig %clsg exps)]
  13273. ['*' (rune tar %cltr exps)]
  13274. ==
  13275. ==
  13276. :- '.'
  13277. ;~ pfix dot
  13278. %- stew
  13279. ^. stet ^. limo
  13280. :~ ['+' (rune lus %dtls expa)]
  13281. ['*' (rune tar %dttr expb)]
  13282. ['=' (rune tis %dtts expb)]
  13283. ['?' (rune wut %dtwt expa)]
  13284. ['^' (rune ket %dtkt exqn)]
  13285. ==
  13286. ==
  13287. :- '^'
  13288. ;~ pfix ket
  13289. %- stew
  13290. ^. stet ^. limo
  13291. :~ ['|' (rune bar %ktbr expa)]
  13292. ['.' (rune dot %ktdt expb)]
  13293. ['-' (rune hep %kthp exqc)]
  13294. ['+' (rune lus %ktls expb)]
  13295. ['&' (rune pam %ktpm expa)]
  13296. ['~' (rune sig %ktsg expa)]
  13297. ['=' (rune tis %ktts expj)]
  13298. ['?' (rune wut %ktwt expa)]
  13299. ['*' (rune tar %kttr exqa)]
  13300. [':' (rune col %ktcl exqa)]
  13301. ==
  13302. ==
  13303. :- '~'
  13304. ;~ pfix sig
  13305. %- stew
  13306. ^. stet ^. limo
  13307. :~ ['|' (rune bar %sgbr expb)]
  13308. ['$' (rune buc %sgbc expf)]
  13309. ['_' (rune cab %sgcb expb)]
  13310. ['%' (rune cen %sgcn hind)]
  13311. ['/' (rune fas %sgfs hine)]
  13312. ['<' (rune gal %sggl hinb)]
  13313. ['>' (rune gar %sggr hinb)]
  13314. ['+' (rune lus %sgls hinc)]
  13315. ['&' (rune pam %sgpm hinf)]
  13316. ['?' (rune wut %sgwt hing)]
  13317. ['=' (rune tis %sgts expb)]
  13318. ['!' (rune zap %sgzp expb)]
  13319. ==
  13320. ==
  13321. :- ';'
  13322. ;~ pfix mic
  13323. %- stew
  13324. ^. stet ^. limo
  13325. :~ [':' (rune col %mccl expi)]
  13326. ['/' (rune fas %mcfs expa)]
  13327. ['<' (rune gal %mcgl expz)]
  13328. ['~' (rune sig %mcsg expi)]
  13329. [';' (rune mic %mcmc exqc)]
  13330. ==
  13331. ==
  13332. :- '='
  13333. ;~ pfix tis
  13334. %- stew
  13335. ^. stet ^. limo
  13336. :~ ['|' (rune bar %tsbr exqc)]
  13337. ['.' (rune dot %tsdt expq)]
  13338. ['?' (rune wut %tswt expw)]
  13339. ['^' (rune ket %tskt expt)]
  13340. [':' (rune col %tscl expp)]
  13341. ['/' (rune fas %tsfs expo)]
  13342. [';' (rune mic %tsmc expo)]
  13343. ['<' (rune gal %tsgl expb)]
  13344. ['>' (rune gar %tsgr expb)]
  13345. ['-' (rune hep %tshp expb)]
  13346. ['*' (rune tar %tstr expg)]
  13347. [',' (rune com %tscm expb)]
  13348. ['+' (rune lus %tsls expb)]
  13349. ['~' (rune sig %tssg expi)]
  13350. ==
  13351. ==
  13352. :- '?'
  13353. ;~ pfix wut
  13354. %- stew
  13355. ^. stet ^. limo
  13356. :~ ['|' (rune bar %wtbr exps)]
  13357. [':' (rune col %wtcl expc)]
  13358. ['.' (rune dot %wtdt expc)]
  13359. ['<' (rune gal %wtgl expb)]
  13360. ['>' (rune gar %wtgr expb)]
  13361. ['-' ;~(pfix hep (toad txhp))]
  13362. ['^' ;~(pfix ket (toad tkkt))]
  13363. ['=' ;~(pfix tis (toad txts))]
  13364. ['#' ;~(pfix hax (toad txhx))]
  13365. ['+' ;~(pfix lus (toad txls))]
  13366. ['&' (rune pam %wtpm exps)]
  13367. ['@' ;~(pfix pat (toad tkvt))]
  13368. ['~' ;~(pfix sig (toad tksg))]
  13369. ['!' (rune zap %wtzp expa)]
  13370. ==
  13371. ==
  13372. :- '!'
  13373. ;~ pfix zap
  13374. %- stew
  13375. ^. stet ^. limo
  13376. :~ [':' ;~(pfix col (toad expy))]
  13377. ['.' ;~(pfix dot (toad |.(loaf(bug |))))]
  13378. [',' (rune com %zpcm expb)]
  13379. [';' (rune mic %zpmc expb)]
  13380. ['>' (rune gar %zpgr expa)]
  13381. ['<' (rune gal %zpgl exqc)]
  13382. ['@' (rune pat %zppt expx)]
  13383. ['=' (rune tis %zpts expa)]
  13384. ['?' (rune wut %zpwt hinh)]
  13385. ==
  13386. ==
  13387. ==
  13388. ::
  13389. ++ boog !:
  13390. %+ knee [p=*whit q=*term r=*help s=*hoon]
  13391. |.(~+((scye ;~(pose bola boba))))
  13392. ++ bola :: ++ arms
  13393. %+ knee [q=*term r=*help s=*hoon] |. ~+
  13394. %+ cook
  13395. |= [q=term r=whiz s=hoon]
  13396. ?: =(r *whiz)
  13397. [q *help s]
  13398. [q [[%funk q]~ [r]~] s]
  13399. ;~ pfix (jest '++')
  13400. ;~ plug
  13401. ;~(pfix gap ;~(pose (cold %$ buc) sym))
  13402. apse:docs
  13403. ;~(pfix jump loaf)
  13404. ==
  13405. ==
  13406. ::TODO consider special casing $%
  13407. ++ boba :: +$ arms
  13408. %+ knee [q=*term r=*help s=*hoon] |. ~+
  13409. %+ cook
  13410. |= [q=term r=whiz s=spec]
  13411. ?: =(r *whiz)
  13412. [q *help [%ktcl %name q s]]
  13413. [q [[%plan q]~ [r]~] [%ktcl %name q s]]
  13414. ;~ pfix (jest '+$')
  13415. ;~ plug
  13416. ;~(pfix gap sym)
  13417. apse:docs
  13418. ;~(pfix jump loan)
  13419. ==
  13420. ==
  13421. ::
  13422. :: parses a or [a b c] or a b c ==
  13423. ++ lynx
  13424. =/ wid (ifix [sel ser] (most ace sym))
  13425. =/ tal
  13426. ;~ sfix
  13427. (most gap sym)
  13428. ;~(plug gap duz)
  13429. ==
  13430. =/ one
  13431. %- cook :_ sym
  13432. |= a=term
  13433. `(list term)`~[a]
  13434. %- cook
  13435. :_ ;~(pose (runq wid tal) one)
  13436. :: lestify
  13437. |= a=(list term)
  13438. ?~(a !! a)
  13439. ::
  13440. ++ whap !: :: chapter
  13441. %+ cook
  13442. |= a=(list (qual whit term help hoon))
  13443. :: separate $helps into their own list to be passed to +glow
  13444. =/ [duds=(list help) nude=(list (pair term hoon))]
  13445. %+ roll a
  13446. |= $: $= bog
  13447. (qual whit term help hoon)
  13448. ::
  13449. $= gob
  13450. [duds=(list help) nude=(list (pair term hoon))]
  13451. ==
  13452. =/ [unt=(list help) tag=(list help)]
  13453. %+ skid ~(tap by bat.p.bog) |=(=help =(~ cuff.help))
  13454. :- ?: =(*help r.bog)
  13455. (weld tag duds.gob)
  13456. [r.bog (weld tag duds.gob)]
  13457. |-
  13458. ?~ unt [[q.bog s.bog] nude.gob]
  13459. =. s.bog [%note help/i.unt s.bog]
  13460. $(unt t.unt)
  13461. ::
  13462. %+ glow duds
  13463. |- ^- (map term hoon)
  13464. ?~ nude ~
  13465. =+ $(nude t.nude)
  13466. %+ ~(put by -)
  13467. p.i.nude
  13468. ?: (~(has by -) p.i.nude)
  13469. [%eror (weld "duplicate arm: +" (trip p.i.nude))]
  13470. q.i.nude
  13471. ::
  13472. (most mush boog)
  13473. ::
  13474. :: +glow: moves batch comments to the correct arm
  13475. ++ glow
  13476. |= [duds=(list help) nude=(map term hoon)]
  13477. ^- (map term hoon)
  13478. |-
  13479. ?~ duds nude
  13480. :: if there is no link, its not part of a batch comment
  13481. ?~ cuff.i.duds
  13482. :: this shouldn't happen yet until we look for cuffs of length >1
  13483. :: but we need to prove that cuff is nonempty anyways
  13484. $(duds t.duds)
  13485. ::
  13486. ::TODO: look past the first link. this probably requires
  13487. ::a major rethink on how batch comments work
  13488. =/ nom=(unit term)
  13489. ?+ i.cuff.i.duds ~
  13490. :: we only support ++ and +$ batch comments right now
  13491. ::
  13492. ?([%funk *] [%plan *])
  13493. `p.i.cuff.i.duds
  13494. ==
  13495. %= $
  13496. duds t.duds
  13497. nude ?~ nom nude
  13498. ?. (~(has by nude) u.nom)
  13499. :: ~> %slog.[0 leaf+"glow: unmatched link"]
  13500. nude
  13501. (~(jab by nude) u.nom |=(a=hoon [%note help+i.duds a]))
  13502. ==
  13503. ::
  13504. ++ whip :: chapter declare
  13505. %+ cook
  13506. |= [[a=whit b=term c=whiz] d=(map term hoon)]
  13507. ^- [whit (pair term (map term hoon))]
  13508. ?. =(*whit a)
  13509. [a b d]
  13510. ?: =(*whiz c)
  13511. [*whit b d]
  13512. [%*(. *whit bat (malt [[%chat b]~ [c]~]~)) b d]
  13513. ;~(plug (seam ;~(pfix (jest '+|') gap cen sym)) whap)
  13514. ::
  13515. ++ wasp :: $brcb aliases
  13516. ;~ pose
  13517. %+ ifix
  13518. [;~(plug lus tar muck) muck]
  13519. (most muck ;~(gunk sym loll))
  13520. ::
  13521. (easy ~)
  13522. ==
  13523. ::
  13524. ++ wisp !: :: core tail
  13525. ?. tol fail
  13526. %+ cook
  13527. |= a=(list [wit=whit wap=(pair term (map term hoon))])
  13528. ^- (map term tome)
  13529. =< p
  13530. |- ^- (pair (map term tome) (map term hoon))
  13531. ?~ a [~ ~]
  13532. =/ mor $(a t.a)
  13533. =. q.wap.i.a
  13534. %- ~(urn by q.wap.i.a)
  13535. |= b=(pair term hoon) ^+ +.b
  13536. :: tests for duplicate arms between two chapters
  13537. ?. (~(has by q.mor) p.b) +.b
  13538. [%eror (weld "duplicate arm: +" (trip p.b))]
  13539. :_ (~(uni by q.mor) q.wap.i.a)
  13540. %+ ~(put by p.mor)
  13541. p.wap.i.a
  13542. :- %- ~(get by bat.wit.i.a)
  13543. ?: (~(has by bat.wit.i.a) [%chat p.wap.i.a]~)
  13544. [%chat p.wap.i.a]~
  13545. ~
  13546. ?. (~(has by p.mor) p.wap.i.a)
  13547. q.wap.i.a
  13548. [[%$ [%eror (weld "duplicate chapter: |" (trip p.wap.i.a))]] ~ ~]
  13549. ::
  13550. ::TODO: allow cores with unnamed chapter as well as named chapters?
  13551. ;~ pose
  13552. dun
  13553. ;~ sfix
  13554. ;~ pose
  13555. (most mush whip)
  13556. ;~(plug (stag *whit (stag %$ whap)) (easy ~))
  13557. ==
  13558. gap
  13559. dun
  13560. ==
  13561. ==
  13562. ::
  13563. ::TODO: check parser performance
  13564. ++ toad :: untrap parser expr
  13565. |* har=_expa
  13566. =+ dur=(ifix [pal par] $:har(tol |))
  13567. ?. tol
  13568. dur
  13569. ;~(pose ;~(pfix jump $:har(tol &)) ;~(pfix gap $:har(tol &)) dur)
  13570. ::
  13571. ++ rune :: build rune
  13572. |* [dif=rule tuq=* har=_expa]
  13573. ;~(pfix dif (stag tuq (toad har)))
  13574. ::
  13575. ++ runo :: rune plus
  13576. |* [dif=rule hil=* tuq=* har=_expa]
  13577. ;~(pfix dif (stag hil (stag tuq (toad har))))
  13578. ::
  13579. ++ runq :: wide or tall if tol
  13580. |* [wid=rule tal=rule] :: else wide
  13581. ?. tol
  13582. wid
  13583. ;~(pose wid tal)
  13584. ::
  13585. ++ butt |* zor=rule :: closing == if tall
  13586. ?:(tol ;~(sfix zor ;~(plug gap duz)) zor)
  13587. ++ ulva |* zor=rule :: closing -- and tall
  13588. ?.(tol fail ;~(sfix zor ;~(plug gap dun)))
  13589. ++ glop ~+((glue mash)) :: separated by space
  13590. ++ gunk ~+((glue muck)) :: separated list
  13591. ++ goop ~+((glue mush)) :: separator list & docs
  13592. ++ hank (most mush loaf) :: gapped hoons
  13593. ++ hunk (most mush loan) :: gapped specs
  13594. ++ jump ;~(pose leap:docs gap) :: gap before docs
  13595. ++ loaf ?:(tol tall wide) :: hoon
  13596. ++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs
  13597. ++ loan ?:(tol till wyde) :: spec
  13598. ++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin
  13599. ++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name
  13600. ++ mash ?:(tol gap ;~(plug com ace)) :: list separator
  13601. ++ muss ?:(tol jump ;~(plug com ace)) :: list w/ doccords
  13602. ++ muck ?:(tol gap ace) :: general separator
  13603. ++ mush ?:(tol jump ace) :: separator w/ docs
  13604. ++ teak %+ knee *tiki |. ~+ :: wing or hoon
  13605. =+ ^= gub
  13606. |= [a=term b=$%([%& p=wing] [%| p=hoon])]
  13607. ^- tiki
  13608. ?-(-.b %& [%& [~ a] p.b], %| [%| [~ a] p.b])
  13609. =+ ^= wyp
  13610. ;~ pose
  13611. %+ cook gub
  13612. ;~ plug
  13613. sym
  13614. ;~(pfix tis ;~(pose (stag %& rope) (stag %| wide)))
  13615. ==
  13616. ::
  13617. (stag %& (stag ~ rope))
  13618. (stag %| (stag ~ wide))
  13619. ==
  13620. ?. tol wyp
  13621. ;~ pose
  13622. wyp
  13623. ::
  13624. ;~ pfix
  13625. ;~(plug ket tis gap)
  13626. %+ cook gub
  13627. ;~ plug
  13628. sym
  13629. ;~(pfix gap ;~(pose (stag %& rope) (stag %| tall)))
  13630. ==
  13631. ==
  13632. ::
  13633. (stag %| (stag ~ tall))
  13634. ==
  13635. ++ rack (most muss ;~(goop loaf loaf)) :: list [hoon hoon]
  13636. ++ ruck (most muss ;~(goop loan loaf)) :: list [spec hoon]
  13637. ++ rick (most mash ;~(goop rope loaf)) :: list [wing hoon]
  13638. :: hoon contents
  13639. ::
  13640. ++ expa |.(loaf) :: one hoon
  13641. ++ expb |.(;~(goop loaf loaf)) :: two hoons
  13642. ++ expc |.(;~(goop loaf loaf loaf)) :: three hoons
  13643. ++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons
  13644. ++ expe |.(wisp) :: core tail
  13645. ++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon
  13646. ++ expg |.(;~(gunk lomp loll loaf)) :: term/spec, two hoons
  13647. ++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s
  13648. ++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons
  13649. ++ expj |.(;~(goop lore loaf)) :: skin and hoon
  13650. :: ++ expk |.(;~(gunk loaf ;~(plug loaf (easy ~)))):: list of two hoons
  13651. :: ++ expl |.(;~(gunk sym loaf loaf)) :: term, two hoons
  13652. ++ expm |.((butt ;~(gunk rope loaf rick))) :: several [spec hoon]s
  13653. ++ expn |. ;~ gunk rope loaf :: wing, hoon,
  13654. ;~(plug loaf (easy ~)) :: list of one hoon
  13655. == ::
  13656. ++ expo |.(;~(goop wise loaf loaf)) :: =;
  13657. ++ expp |.(;~(goop (butt rick) loaf)) :: [wing hoon]s, hoon
  13658. ++ expq |.(;~(goop rope loaf loaf)) :: wing and two hoons
  13659. ++ expr |.(;~(goop loaf wisp)) :: hoon and core tail
  13660. ++ exps |.((butt hank)) :: closed gapped hoons
  13661. ++ expt |.(;~(gunk wise rope loaf loaf)) :: =^
  13662. ++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, hoon, hoons
  13663. :: ++ expv |.((butt rick)) :: just changes
  13664. ++ expw |.(;~(goop rope loaf loaf loaf)) :: wing and three hoons
  13665. ++ expx |.(;~(goop ropa loaf loaf)) :: wings and two hoons
  13666. ++ expy |.(loaf(bug &)) :: hoon with tracing
  13667. ++ expz |.(;~(goop loan loaf loaf loaf)) :: spec and three hoons
  13668. :: spec contents
  13669. ::
  13670. ++ exqa |.(loan) :: one spec
  13671. ++ exqb |.(;~(goop loan loan)) :: two specs
  13672. ++ exqc |.(;~(goop loan loaf)) :: spec then hoon
  13673. ++ exqd |.(;~(goop loaf loan)) :: hoon then spec
  13674. ++ exqe |.(;~(goop lynx loan)) :: list of names then spec
  13675. ++ exqs |.((butt hunk)) :: closed gapped specs
  13676. ++ exqg |.(;~(goop sym loan)) :: term and spec
  13677. ::++ exqk |.(;~(goop loaf ;~(plug loan (easy ~)))):: hoon with one spec
  13678. ++ exqn |.(;~(gunk loan (stag %cltr (butt hank)))):: autoconsed hoons
  13679. ++ exqr |.(;~(gunk loan ;~(plug wasp wisp))) :: spec/aliases?/tail
  13680. ::++ exqw |.(;~(goop loaf loan)) :: hoon and spec
  13681. ++ exqx |.(;~(goop loaf loan loan)) :: hoon, two specs
  13682. ++ exqy |.(;~(goop loaf loan loan loan)) :: hoon, three specs
  13683. ++ exqz |.(;~(goop loaf (butt hunk))) :: hoon, n specs
  13684. ::
  13685. :: tiki expansion for %wt runes
  13686. ::
  13687. ++ txhp |. %+ cook |= [a=tiki b=(list (pair spec hoon))]
  13688. (~(wthp ah a) b)
  13689. (butt ;~(gunk teak ruck))
  13690. ++ tkkt |. %+ cook |= [a=tiki b=hoon c=hoon]
  13691. (~(wtkt ah a) b c)
  13692. ;~(gunk teak loaf loaf)
  13693. ++ txls |. %+ cook |= [a=tiki b=hoon c=(list (pair spec hoon))]
  13694. (~(wtls ah a) b c)
  13695. (butt ;~(gunk teak loaf ruck))
  13696. ++ tkvt |. %+ cook |= [a=tiki b=hoon c=hoon]
  13697. (~(wtpt ah a) b c)
  13698. ;~(gunk teak loaf loaf)
  13699. ++ tksg |. %+ cook |= [a=tiki b=hoon c=hoon]
  13700. (~(wtsg ah a) b c)
  13701. ;~(gunk teak loaf loaf)
  13702. ++ txts |. %+ cook |= [a=spec b=tiki]
  13703. (~(wtts ah b) a)
  13704. ;~(gunk loan teak)
  13705. ++ txhx |. %+ cook |= [a=skin b=tiki]
  13706. (~(wthx ah b) a)
  13707. ;~(gunk lore teak)
  13708. ::
  13709. :: hint syntax
  13710. ::
  13711. ++ hinb |.(;~(goop bont loaf)) :: hint and hoon
  13712. ++ hinc |. :: optional =en, hoon
  13713. ;~(pose ;~(goop bony loaf) (stag ~ loaf)) ::
  13714. ++ hind |.(;~(gunk bonk loaf ;~(goop bonz loaf))) :: jet hoon "bon"s hoon
  13715. ++ hine |.(;~(goop bonk loaf)) :: jet-hint and hoon
  13716. ++ hinf |. :: 0-3 >s, two hoons
  13717. ;~ pose
  13718. ;~(goop (cook lent (stun [1 3] gar)) loaf loaf)
  13719. (stag 0 ;~(goop loaf loaf))
  13720. ==
  13721. ++ hing |. :: 0-3 >s, three hoons
  13722. ;~ pose
  13723. ;~(goop (cook lent (stun [1 3] gar)) loaf loaf loaf)
  13724. (stag 0 ;~(goop loaf loaf loaf))
  13725. ==
  13726. ++ bonk :: jet signature
  13727. ;~ pfix cen
  13728. ;~ pose
  13729. ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot ;~(pfix dot dem)))))
  13730. ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot dem))))
  13731. ;~(plug sym ;~(pfix dot dem))
  13732. sym
  13733. ==
  13734. ==
  13735. ++ hinh |. :: 1/2 numbers, hoon
  13736. ;~ goop
  13737. ;~ pose
  13738. dem
  13739. (ifix [sel ser] ;~(plug dem ;~(pfix ace dem)))
  13740. ==
  13741. loaf
  13742. ==
  13743. ++ bont ;~ (bend) :: term, optional hoon
  13744. ;~(pfix cen sym)
  13745. ;~(pfix dot ;~(pose wide ;~(pfix muck loaf)))
  13746. ==
  13747. ++ bony (cook |=(a=(list) (lent a)) (plus tis)) :: base 1 =en count
  13748. ++ bonz :: term-labelled hoons
  13749. ;~ pose
  13750. (cold ~ sig)
  13751. %+ ifix
  13752. ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pal par])
  13753. (more mash ;~(gunk ;~(pfix cen sym) loaf))
  13754. ==
  13755. --
  13756. ::
  13757. ++ lang :: lung sample
  13758. $: ros=hoon
  13759. $= vil
  13760. $% [%tis p=hoon]
  13761. [%col p=hoon]
  13762. [%ket p=hoon]
  13763. [%lit p=(list (pair wing hoon))]
  13764. ==
  13765. ==
  13766. ::
  13767. ++ lung
  13768. ~+
  13769. %- bend
  13770. |: $:lang
  13771. ^- (unit hoon)
  13772. ?- -.vil
  13773. %col ?:(=([%base %flag] ros) ~ [~ %tsgl ros p.vil])
  13774. %lit (bind ~(reek ap ros) |=(hyp=wing [%cnts hyp p.vil]))
  13775. %ket [~ ros p.vil]
  13776. %tis =+ rud=~(flay ap ros)
  13777. ?~(rud ~ `[%ktts u.rud p.vil])
  13778. ==
  13779. ::
  13780. ++ long
  13781. %+ knee *hoon |. ~+
  13782. ;~ lung
  13783. scat
  13784. ;~ pose
  13785. ;~(plug (cold %tis tis) wide)
  13786. ;~(plug (cold %col col) wide)
  13787. ;~(plug (cold %ket ket) wide)
  13788. ;~ plug
  13789. (easy %lit)
  13790. (ifix [pal par] lobo)
  13791. ==
  13792. ==
  13793. ==
  13794. ::
  13795. ++ lobo (most ;~(plug com ace) ;~(glam rope wide))
  13796. ++ loon (most ;~(plug com ace) ;~(glam wide wide))
  13797. ++ lute :: tall [] noun
  13798. ~+
  13799. %+ cook |=(hoon +<)
  13800. %+ stag %cltr
  13801. %+ ifix
  13802. [;~(plug sel gap) ;~(plug gap ser)]
  13803. (most gap tall)
  13804. ::
  13805. ++ ropa (most col rope)
  13806. ++ rope :: wing form
  13807. %+ knee *wing
  13808. |. ~+
  13809. %+ (slug |=([a=limb b=wing] [a b]))
  13810. dot
  13811. ;~ pose
  13812. (cold [%| 0 ~] com)
  13813. %+ cook
  13814. |=([a=(list) b=term] ?~(a b [%| (lent a) `b]))
  13815. ;~(plug (star ket) ;~(pose sym (cold %$ buc)))
  13816. ::
  13817. %+ cook
  13818. |=(a=axis [%& a])
  13819. ;~ pose
  13820. ;~(pfix lus dim:ag)
  13821. ;~(pfix pam (cook |=(a=@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag))
  13822. ;~(pfix bar (cook |=(a=@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag))
  13823. ven
  13824. (cold 1 dot)
  13825. ==
  13826. ==
  13827. ::
  13828. ++ wise
  13829. ;~ pose
  13830. ;~ pfix tis
  13831. %+ sear
  13832. |= =spec
  13833. ^- (unit skin)
  13834. %+ bind ~(autoname ax spec)
  13835. |= =term
  13836. [%name term %spec spec %base %noun]
  13837. wyde
  13838. ==
  13839. ::
  13840. %+ cook
  13841. |= [=term =(unit spec)]
  13842. ^- skin
  13843. ?~ unit
  13844. term
  13845. [%name term %spec u.unit %base %noun]
  13846. ;~ plug sym
  13847. (punt ;~(pfix ;~(pose fas tis) wyde))
  13848. ==
  13849. ::
  13850. %+ cook
  13851. |= =spec
  13852. ^- skin
  13853. [%spec spec %base %noun]
  13854. wyde
  13855. ==
  13856. ::
  13857. ++ tall :: full tall form
  13858. %+ knee *hoon
  13859. |.(~+((wart (clad ;~(pose expression:(norm &) long lute apex:(sail &))))))
  13860. ++ till :: mold tall form
  13861. %+ knee *spec
  13862. |.(~+((wert (coat ;~(pose structure:(norm &) scad)))))
  13863. ++ wede :: wide bulb
  13864. :: XX: lus deprecated
  13865. ::
  13866. ;~(pfix ;~(pose lus fas) wide)
  13867. ++ wide :: full wide form
  13868. %+ knee *hoon
  13869. |.(~+((wart ;~(pose expression:(norm |) long apex:(sail |)))))
  13870. ++ wyde :: mold wide form
  13871. %+ knee *spec
  13872. |.(~+((wert ;~(pose structure:(norm |) scad))))
  13873. ++ wart
  13874. |* zor=rule
  13875. %+ here
  13876. |= [a=pint b=hoon]
  13877. ?:(bug [%dbug [wer a] b] b)
  13878. zor
  13879. ++ wert
  13880. |* zor=rule
  13881. %+ here
  13882. |= [a=pint b=spec]
  13883. ?:(bug [%dbug [wer a] b] b)
  13884. zor
  13885. --
  13886. ::
  13887. ++ vest
  13888. ~/ %vest
  13889. |= tub=nail
  13890. ^- (like hoon)
  13891. %. tub
  13892. %- full
  13893. (ifix [gay gay] tall:vast)
  13894. ::
  13895. ++ vice
  13896. |= txt=@ta
  13897. ^- hoon
  13898. (rash txt wide:vast)
  13899. ::
  13900. ++ make :: compile cord to nock
  13901. |= txt=@
  13902. q:(~(mint ut %noun) %noun (ream txt))
  13903. ::
  13904. ++ rain :: parse with % path
  13905. |= [bon=path txt=@]
  13906. ^- hoon
  13907. =+ vaz=vast
  13908. ~| bon
  13909. (scan (trip txt) (full (ifix [gay gay] tall:vaz(wer bon))))
  13910. ::
  13911. ++ ream :: parse cord to hoon
  13912. |= txt=@
  13913. ^- hoon
  13914. (rash txt vest)
  13915. ::
  13916. ++ reck :: parse hoon file
  13917. |= bon=path
  13918. (rain bon .^(@t %cx (weld bon `path`[%hoon ~])))
  13919. ::
  13920. ++ ride :: end-to-end compiler
  13921. |= [typ=type txt=@]
  13922. ^- (pair type nock)
  13923. ~> %slog.[0 leaf/"ride: parsing"]
  13924. =/ gen (ream txt)
  13925. ~> %slog.[0 leaf/"ride: compiling"]
  13926. ~< %slog.[0 leaf/"ride: compiled"]
  13927. (~(mint ut typ) %noun gen)
  13928. ::
  13929. :: 5e: molds and mold builders
  13930. +| %molds-and-mold-builders
  13931. ::
  13932. +$ mane $@(@tas [@tas @tas]) :: XML name+space
  13933. +$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
  13934. +$ marl (list manx) :: XML node list
  13935. +$ mars [t=[n=%$ a=[i=[n=%$ v=tape] t=~]] c=~] :: XML cdata
  13936. +$ mart (list [n=mane v=tape]) :: XML attributes
  13937. +$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
  13938. +$ mite (list @ta) :: mime type
  13939. +$ pass @ :: public key
  13940. +$ ring @ :: private key
  13941. +$ ship @p :: network identity
  13942. +$ shop (each ship (list @ta)) :: urbit/dns identity
  13943. +$ spur path :: ship desk case spur
  13944. +$ time @da :: galactic time
  13945. ::
  13946. :: 5f: profiling support (XX move)
  13947. +| %profiling-support
  13948. ::
  13949. ++ pi-heck
  13950. |= [nam=@tas day=doss]
  13951. ^- doss
  13952. =+ lam=(~(get by hit.day) nam)
  13953. day(hit (~(put by hit.day) nam ?~(lam 1 +(u.lam))))
  13954. ::
  13955. ++ pi-noon :: sample trace
  13956. |= [mot=term paz=(list path) day=doss]
  13957. =| lax=(unit path)
  13958. |- ^- doss
  13959. ?~ paz day(mon (pi-mope mot mon.day))
  13960. %= $
  13961. paz t.paz
  13962. lax `i.paz
  13963. cut.day
  13964. %+ ~(put by cut.day) i.paz
  13965. ^- hump
  13966. =+ nax=`(unit path)`?~(t.paz ~ `i.t.paz)
  13967. =+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~]))
  13968. :+ (pi-mope mot mon.hup)
  13969. ?~ lax out.hup
  13970. =+ hag=(~(get by out.hup) u.lax)
  13971. (~(put by out.hup) u.lax ?~(hag 1 +(u.hag)))
  13972. ?~ nax inn.hup
  13973. =+ hag=(~(get by inn.hup) u.nax)
  13974. (~(put by inn.hup) u.nax ?~(hag 1 +(u.hag)))
  13975. ==
  13976. ++ pi-mope :: add sample
  13977. |= [mot=term mon=moan]
  13978. ?+ mot mon
  13979. %fun mon(fun +(fun.mon))
  13980. %noc mon(noc +(noc.mon))
  13981. %glu mon(glu +(glu.mon))
  13982. %mal mon(mal +(mal.mon))
  13983. %far mon(far +(far.mon))
  13984. %coy mon(coy +(coy.mon))
  13985. %euq mon(euq +(euq.mon))
  13986. ==
  13987. ++ pi-moth :: count sample
  13988. |= mon=moan ^- @ud
  13989. :(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon)
  13990. ::
  13991. ++ pi-mumm :: print sample
  13992. |= mon=moan ^- tape
  13993. =+ tot=(pi-moth mon)
  13994. ;: welp
  13995. ^- tape
  13996. ?: =(0 noc.mon) ~
  13997. (welp (scow %ud (div (mul 100 noc.mon) tot)) "n ")
  13998. ::
  13999. ^- tape
  14000. ?: =(0 fun.mon) ~
  14001. (welp (scow %ud (div (mul 100 fun.mon) tot)) "c ")
  14002. ::
  14003. ^- tape
  14004. ?: =(0 glu.mon) ~
  14005. (welp (scow %ud (div (mul 100 glu.mon) tot)) "g ")
  14006. ::
  14007. ^- tape
  14008. ?: =(0 mal.mon) ~
  14009. (welp (scow %ud (div (mul 100 mal.mon) tot)) "m ")
  14010. ::
  14011. ^- tape
  14012. ?: =(0 far.mon) ~
  14013. (welp (scow %ud (div (mul 100 far.mon) tot)) "f ")
  14014. ::
  14015. ^- tape
  14016. ?: =(0 coy.mon) ~
  14017. (welp (scow %ud (div (mul 100 coy.mon) tot)) "y ")
  14018. ::
  14019. ^- tape
  14020. ?: =(0 euq.mon) ~
  14021. (welp (scow %ud (div (mul 100 euq.mon) tot)) "e ")
  14022. ==
  14023. ::
  14024. ++ pi-tell :: produce dump
  14025. |= day=doss
  14026. ^- (list tape)
  14027. ?: =(day *doss) ~
  14028. =+ tot=(pi-moth mon.day)
  14029. ;: welp
  14030. [(welp "events: " (pi-mumm mon.day)) ~]
  14031. ::
  14032. %+ turn
  14033. %+ sort ~(tap by hit.day)
  14034. |= [a=[* @] b=[* @]]
  14035. (lth +.a +.b)
  14036. |= [nam=term num=@ud]
  14037. :(welp (trip nam) ": " (scow %ud num))
  14038. ["" ~]
  14039. ::
  14040. %- zing
  14041. ^- (list (list tape))
  14042. %+ turn
  14043. %+ sort ~(tap by cut.day)
  14044. |= [one=(pair path hump) two=(pair path hump)]
  14045. (gth (pi-moth mon.q.one) (pi-moth mon.q.two))
  14046. |= [pax=path hup=hump]
  14047. =+ ott=(pi-moth mon.hup)
  14048. ;: welp
  14049. [(welp "label: " (spud pax)) ~]
  14050. [(welp "price: " (scow %ud (div (mul 100 ott) tot))) ~]
  14051. [(welp "shape: " (pi-mumm mon.hup)) ~]
  14052. ::
  14053. ?: =(~ out.hup) ~
  14054. :- "into:"
  14055. %+ turn
  14056. %+ sort ~(tap by out.hup)
  14057. |=([[* a=@ud] [* b=@ud]] (gth a b))
  14058. |= [pax=path num=@ud]
  14059. ^- tape
  14060. :(welp " " (spud pax) ": " (scow %ud num))
  14061. ::
  14062. ?: =(~ inn.hup) ~
  14063. :- "from:"
  14064. %+ turn
  14065. %+ sort ~(tap by inn.hup)
  14066. |=([[* a=@ud] [* b=@ud]] (gth a b))
  14067. |= [pax=path num=@ud]
  14068. ^- tape
  14069. :(welp " " (spud pax) ": " (scow %ud num))
  14070. ::
  14071. ["" ~]
  14072. ~
  14073. ==
  14074. ==
  14075. --