| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286132871328813289132901329113292132931329413295132961329713298132991330013301133021330313304133051330613307133081330913310133111331213313133141331513316133171331813319133201332113322133231332413325133261332713328133291333013331133321333313334133351333613337133381333913340133411334213343133441334513346133471334813349133501335113352133531335413355133561335713358133591336013361133621336313364133651336613367133681336913370133711337213373133741337513376133771337813379133801338113382133831338413385133861338713388133891339013391133921339313394133951339613397133981339913400134011340213403134041340513406134071340813409134101341113412134131341413415134161341713418134191342013421134221342313424134251342613427134281342913430134311343213433134341343513436134371343813439134401344113442134431344413445134461344713448134491345013451134521345313454134551345613457134581345913460134611346213463134641346513466134671346813469134701347113472134731347413475134761347713478134791348013481134821348313484134851348613487134881348913490134911349213493134941349513496134971349813499135001350113502135031350413505135061350713508135091351013511135121351313514135151351613517135181351913520135211352213523135241352513526135271352813529135301353113532135331353413535135361353713538135391354013541135421354313544135451354613547135481354913550135511355213553135541355513556135571355813559135601356113562135631356413565135661356713568135691357013571135721357313574135751357613577135781357913580135811358213583135841358513586135871358813589135901359113592135931359413595135961359713598135991360013601136021360313604136051360613607136081360913610136111361213613136141361513616136171361813619136201362113622136231362413625136261362713628136291363013631136321363313634136351363613637136381363913640136411364213643136441364513646136471364813649136501365113652136531365413655136561365713658136591366013661136621366313664136651366613667136681366913670136711367213673136741367513676136771367813679136801368113682136831368413685136861368713688136891369013691136921369313694136951369613697136981369913700137011370213703137041370513706137071370813709137101371113712137131371413715137161371713718137191372013721137221372313724137251372613727137281372913730137311373213733137341373513736137371373813739137401374113742137431374413745137461374713748137491375013751137521375313754137551375613757137581375913760137611376213763137641376513766137671376813769137701377113772137731377413775137761377713778137791378013781137821378313784137851378613787137881378913790137911379213793137941379513796137971379813799138001380113802138031380413805138061380713808138091381013811138121381313814138151381613817138181381913820138211382213823138241382513826138271382813829138301383113832138331383413835138361383713838138391384013841138421384313844138451384613847138481384913850138511385213853138541385513856138571385813859138601386113862138631386413865138661386713868138691387013871138721387313874138751387613877138781387913880138811388213883138841388513886138871388813889138901389113892138931389413895138961389713898138991390013901139021390313904139051390613907139081390913910139111391213913139141391513916139171391813919139201392113922139231392413925139261392713928139291393013931139321393313934139351393613937139381393913940139411394213943139441394513946139471394813949139501395113952139531395413955139561395713958139591396013961139621396313964139651396613967139681396913970139711397213973139741397513976139771397813979139801398113982139831398413985139861398713988139891399013991139921399313994139951399613997139981399914000140011400214003140041400514006140071400814009140101401114012140131401414015140161401714018140191402014021140221402314024140251402614027140281402914030140311403214033140341403514036140371403814039140401404114042140431404414045140461404714048140491405014051140521405314054140551405614057140581405914060140611406214063140641406514066140671406814069140701407114072140731407414075 |
- ::
- :::: /sys/hoon ::
- :: ::
- =< ride
- => %138 =>
- :: ::
- :::: 0: version stub ::
- :: ::
- ~% %k.138 ~ ~ ::
- |%
- ++ hoon-version +
- -- =>
- ~% %one + ~
- :: layer-1
- ::
- :: basic mathematical operations
- |%
- :: unsigned arithmetic
- +| %math
- ++ add
- ~/ %add
- :: unsigned addition
- ::
- :: a: augend
- :: b: addend
- |= [a=@ b=@]
- :: sum
- ^- @
- ?: =(0 a) b
- $(a (dec a), b +(b))
- ::
- ++ dec
- ~/ %dec
- :: unsigned decrement by one.
- |= a=@
- ~_ leaf+"decrement-underflow"
- ?< =(0 a)
- =+ b=0
- :: decremented integer
- |- ^- @
- ?: =(a +(b)) b
- $(b +(b))
- ::
- ++ div
- ~/ %div
- :: unsigned divide
- ::
- :: a: dividend
- :: b: divisor
- |: [a=`@`1 b=`@`1]
- :: quotient
- ^- @
- -:(dvr a b)
- ::
- ++ dvr
- ~/ %dvr
- :: unsigned divide with remainder
- ::
- :: a: dividend
- :: b: divisor
- |: [a=`@`1 b=`@`1]
- :: p: quotient
- :: q: remainder
- ^- [p=@ q=@]
- ~_ leaf+"divide-by-zero"
- ?< =(0 b)
- =+ c=0
- |-
- ?: (lth a b) [c a]
- $(a (sub a b), c +(c))
- ::
- ++ gte
- ~/ %gte
- :: unsigned greater than or equals
- ::
- :: returns whether {a >= b}.
- ::
- :: a: left hand operand (todo: name)
- :: b: right hand operand
- |= [a=@ b=@]
- :: greater than or equal to?
- ^- ?
- !(lth a b)
- ::
- ++ gth
- ~/ %gth
- :: unsigned greater than
- ::
- :: returns whether {a > b}
- ::
- :: a: left hand operand (todo: name)
- :: b: right hand operand
- |= [a=@ b=@]
- :: greater than?
- ^- ?
- !(lte a b)
- ::
- ++ lte
- ~/ %lte
- :: unsigned less than or equals
- ::
- :: returns whether {a >= b}.
- ::
- :: a: left hand operand (todo: name)
- :: b: right hand operand
- |= [a=@ b=@]
- :: less than or equal to?
- |(=(a b) (lth a b))
- ::
- ++ lth
- ~/ %lth
- :: unsigned less than
- ::
- :: a: left hand operand (todo: name)
- :: b: right hand operand
- |= [a=@ b=@]
- :: less than?
- ^- ?
- ?& !=(a b)
- |-
- ?| =(0 a)
- ?& !=(0 b)
- $(a (dec a), b (dec b))
- == == ==
- ::
- ++ max
- ~/ %max
- :: unsigned maximum
- |= [a=@ b=@]
- :: the maximum
- ^- @
- ?: (gth a b) a
- b
- ::
- ++ min
- ~/ %min
- :: unsigned minimum
- |= [a=@ b=@]
- :: the minimum
- ^- @
- ?: (lth a b) a
- b
- ::
- ++ mod
- ~/ %mod
- :: unsigned modulus
- ::
- :: a: dividend
- :: b: divisor
- |: [a=`@`1 b=`@`1]
- :: the remainder
- ^- @
- +:(dvr a b)
- ::
- ++ mul
- ~/ %mul
- :: unsigned multiplication
- ::
- :: a: multiplicand
- :: b: multiplier
- |: [a=`@`1 b=`@`1]
- :: product
- ^- @
- =+ c=0
- |-
- ?: =(0 a) c
- $(a (dec a), c (add b c))
- ::
- ++ sub
- ~/ %sub
- :: unsigned subtraction
- ::
- :: a: minuend
- :: b: subtrahend
- |= [a=@ b=@]
- ~_ leaf+"subtract-underflow"
- :: difference
- ^- @
- ?: =(0 b) a
- $(a (dec a), b (dec b))
- ::
- :: tree addressing
- +| %tree
- ++ cap
- ~/ %cap
- :: tree head
- ::
- :: tests whether an `a` is in the head or tail of a noun. produces %2 if it
- :: is within the head, or %3 if it is within the tail.
- |= a=@
- ^- ?(%2 %3)
- ?- a
- %2 %2
- %3 %3
- ?(%0 %1) !!
- * $(a (div a 2))
- ==
- ::
- ++ mas
- ~/ %mas
- :: axis within head/tail
- ::
- :: computes the axis of `a` within either the head or tail of a noun
- :: (depends whether `a` lies within the the head or tail).
- |= a=@
- ^- @
- ?- a
- ?(%2 %3) 1
- ?(%0 %1) !!
- * (add (mod a 2) (mul $(a (div a 2)) 2))
- ==
- ::
- ++ peg
- ~/ %peg
- :: axis within axis
- ::
- :: computes the axis of {b} within axis {a}.
- |= [a=@ b=@]
- ?< =(0 a)
- ?< =(0 b)
- :: a composed axis
- ^- @
- ?- b
- %1 a
- %2 (mul a 2)
- %3 +((mul a 2))
- * (add (mod b 2) (mul $(b (div b 2)) 2))
- ==
- ::
- :: # %containers
- ::
- :: the most basic of data types
- +| %containers
- ::
- +$ bite
- :: atom slice specifier
- ::
- $@(bloq [=bloq =step])
- ::
- +$ bloq
- :: blocksize
- ::
- :: a blocksize is the power of 2 size of an atom. ie, 3 is a byte as 2^3 is
- :: 8 bits.
- @
- ::
- ++ each
- |$ [this that]
- :: either {a} or {b}, defaulting to {a}.
- ::
- :: mold generator: produces a discriminated fork between two types,
- :: defaulting to {a}.
- ::
- $% [%| p=that]
- [%& p=this]
- ==
- ::
- +$ gate
- :: function
- ::
- :: a core with one arm, `$`--the empty name--which transforms a sample noun
- :: into a product noun. If used dryly as a type, the subject must have a
- :: sample type of `*`.
- $-(* *)
- ::
- ++ list
- |$ [item]
- :: null-terminated list
- ::
- :: mold generator: produces a mold of a null-terminated list of the
- :: homogeneous type {a}.
- ::
- $@(~ [i=item t=(list item)])
- ::
- ++ lone
- |$ [item]
- :: single item tuple
- ::
- :: mold generator: puts the face of `p` on the passed in mold.
- ::
- p=item
- ::
- ++ lest
- |$ [item]
- :: null-terminated non-empty list
- ::
- :: mold generator: produces a mold of a null-terminated list of the
- :: homogeneous type {a} with at least one element.
- [i=item t=(list item)]
- ::
- +$ mold
- :: normalizing gate
- ::
- :: a gate that accepts any noun, and validates its shape, producing the
- :: input if it fits or a default value if it doesn't.
- ::
- :: examples: * @ud ,[p=time q=?(%a %b)]
- $~(* $-(* *))
- ::
- ++ pair
- |$ [head tail]
- :: dual tuple
- ::
- :: mold generator: produces a tuple of the two types passed in.
- ::
- :: a: first type, labeled {p}
- :: b: second type, labeled {q}
- ::
- [p=head q=tail]
- ::
- ++ pole
- |$ [item]
- :: faceless list
- ::
- :: like ++list, but without the faces {i} and {t}.
- ::
- $@(~ [item (pole item)])
- ::
- ++ qual
- |$ [first second third fourth]
- :: quadruple tuple
- ::
- :: mold generator: produces a tuple of the four types passed in.
- ::
- [p=first q=second r=third s=fourth]
- ::
- ++ quip
- |$ [item state]
- :: pair of list of first and second
- ::
- :: a common pattern in hoon code is to return a ++list of changes, along with
- :: a new state.
- ::
- :: a: type of list item
- :: b: type of returned state
- ::
- [(list item) state]
- ::
- ++ step
- :: atom size or offset, in bloqs
- ::
- _`@u`1
- ::
- ++ trap
- |$ [product]
- :: a core with one arm `$`
- ::
- _|?($:product)
- ::
- ++ tree
- |$ [node]
- :: tree mold generator
- ::
- :: a `++tree` can be empty, or contain a node of a type and
- :: left/right sub `++tree` of the same type. pretty-printed with `{}`.
- ::
- $@(~ [n=node l=(tree node) r=(tree node)])
- ::
- ++ trel
- |$ [first second third]
- :: triple tuple
- ::
- :: mold generator: produces a tuple of the three types passed in.
- ::
- [p=first q=second r=third]
- ::
- ++ unit
- |$ [item]
- :: maybe
- ::
- :: mold generator: either `~` or `[~ u=a]` where `a` is the
- :: type that was passed in.
- ::
- $@(~ [~ u=item])
- -- =>
- ::
- ~% %two + ~
- :: layer-2
- ::
- |%
- :: 2a: unit logic
- +| %unit-logc
- ::
- ++ biff :: apply
- |* [a=(unit) b=$-(* (unit))]
- ?~ a ~
- (b u.a)
- ::
- ++ bind :: argue
- |* [a=(unit) b=gate]
- ?~ a ~
- [~ u=(b u.a)]
- ::
- ++ bond :: replace
- |* a=(trap)
- |* b=(unit)
- ?~ b $:a
- u.b
- ::
- ++ both :: all the above
- |* [a=(unit) b=(unit)]
- ?~ a ~
- ?~ b ~
- [~ u=[u.a u.b]]
- ::
- ++ clap :: combine
- |* [a=(unit) b=(unit) c=_=>(~ |=(^ +<-))]
- ?~ a b
- ?~ b a
- [~ u=(c u.a u.b)]
- ::
- ++ clef :: compose
- |* [a=(unit) b=(unit) c=_=>(~ |=(^ `+<-))]
- ?~ a ~
- ?~ b ~
- (c u.a u.b)
- ::
- ++ drop :: enlist
- |* a=(unit)
- ?~ a ~
- [i=u.a t=~]
- ::
- ++ fall :: default
- |* [a=(unit) b=*]
- ?~(a b u.a)
- ::
- ++ flit :: make filter
- |* a=$-(* ?)
- |* b=*
- ?.((a b) ~ [~ u=b])
- ::
- ++ hunt :: first of units
- |* [ord=$-(^ ?) a=(unit) b=(unit)]
- ^- %- unit
- $? _?>(?=(^ a) u.a)
- _?>(?=(^ b) u.b)
- ==
- ?~ a b
- ?~ b a
- ?:((ord u.a u.b) a b)
- ::
- ++ lift :: lift mold (fmap)
- |* a=mold :: flipped
- |* b=(unit) :: curried
- (bind b a) :: bind
- ::
- ++ mate :: choose
- |* [a=(unit) b=(unit)]
- ?~ b a
- ?~ a b
- ?.(=(u.a u.b) ~>(%mean.'mate' !!) a)
- ::
- ++ need :: demand
- ~/ %need
- |* a=(unit)
- ?~ a ~>(%mean.'need' !!)
- u.a
- ::
- ++ some :: lift (pure)
- |* a=*
- [~ u=a]
- ::
- :: 2b: list logic
- +| %list-logic
- :: +snoc: append an element to the end of a list
- ::
- ++ snoc
- |* [a=(list) b=*]
- (weld a ^+(a [b]~))
- ::
- :: +lure: List pURE
- ++ lure
- |* a=*
- [i=a t=~]
- ::
- ++ fand :: all indices
- ~/ %fand
- |= [nedl=(list) hstk=(list)]
- =| i=@ud
- =| fnd=(list @ud)
- |- ^+ fnd
- =+ [n=nedl h=hstk]
- |-
- ?: |(?=(~ n) ?=(~ h))
- (flop fnd)
- ?: =(i.n i.h)
- ?~ t.n
- ^$(i +(i), hstk +.hstk, fnd [i fnd])
- $(n t.n, h t.h)
- ^$(i +(i), hstk +.hstk)
- ::
- ++ find :: first index
- ~/ %find
- |= [nedl=(list) hstk=(list)]
- =| i=@ud
- |- ^- (unit @ud)
- =+ [n=nedl h=hstk]
- |-
- ?: |(?=(~ n) ?=(~ h))
- ~
- ?: =(i.n i.h)
- ?~ t.n
- `i
- $(n t.n, h t.h)
- ^$(i +(i), hstk +.hstk)
- ::
- ++ flop :: reverse
- ~/ %flop
- |* a=(list)
- => .(a (homo a))
- ^+ a
- =+ b=`_a`~
- |-
- ?~ a b
- $(a t.a, b [i.a b])
- ::
- ++ gulf :: range inclusive
- |= [a=@ b=@]
- ?> (lte a b)
- |- ^- (list @)
- ?:(=(a +(b)) ~ [a $(a +(a))])
- ::
- ++ homo :: homogenize
- |* a=(list)
- ^+ =< $
- |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
- --
- a
- :: +join: construct a new list, placing .sep between every pair in .lit
- ::
- ++ join
- |* [sep=* lit=(list)]
- =. sep `_?>(?=(^ lit) i.lit)`sep
- ?~ lit ~
- =| out=(list _?>(?=(^ lit) i.lit))
- |- ^+ out
- ?~ t.lit
- (flop [i.lit out])
- $(out [sep i.lit out], lit t.lit)
- ::
- :: +bake: convert wet gate to dry gate by specifying argument mold
- ::
- ++ bake
- |* [f=gate a=mold]
- |= arg=a
- (f arg)
- ::
- ++ lent :: length
- ~/ %lent
- |= a=(list)
- ^- @
- =+ b=0
- |-
- ?~ a b
- $(a t.a, b +(b))
- ::
- ++ levy
- ~/ %levy :: all of
- |* [a=(list) b=$-(* ?)]
- |- ^- ?
- ?~ a &
- ?. (b i.a) |
- $(a t.a)
- ::
- ++ lien :: some of
- ~/ %lien
- |* [a=(list) b=$-(* ?)]
- |- ^- ?
- ?~ a |
- ?: (b i.a) &
- $(a t.a)
- ::
- ++ limo :: listify
- |* a=*
- ^+ =< $
- |@ ++ $ ?~(a ~ ?:(*? [i=-.a t=$] $(a +.a)))
- --
- a
- ::
- ++ murn :: maybe transform
- ~/ %murn
- |* [a=(list) b=$-(* (unit))]
- => .(a (homo a))
- |- ^- (list _?>(?=(^ a) (need (b i.a))))
- ?~ a ~
- =/ c (b i.a)
- ?~ c $(a t.a)
- [+.c $(a t.a)]
- ::
- ++ oust :: remove
- ~/ %oust
- |* [[a=@ b=@] c=(list)]
- (weld (scag +<-< c) (slag (add +<-< +<->) c))
- ::
- ++ reap :: replicate
- ~/ %reap
- |* [a=@ b=*]
- |- ^- (list _b)
- ?~ a ~
- [b $(a (dec a))]
- ::
- ++ rear :: last item of list
- ~/ %rear
- |* a=(list)
- ^- _?>(?=(^ a) i.a)
- ?> ?=(^ a)
- ?: =(~ t.a) i.a ::NOTE avoiding tmi
- $(a t.a)
- ::
- ++ reel :: right fold
- ~/ %reel
- |* [a=(list) b=_=>(~ |=([* *] +<+))]
- |- ^+ ,.+<+.b
- ?~ a
- +<+.b
- (b i.a $(a t.a))
- ::
- ++ roll :: left fold
- ~/ %roll
- |* [a=(list) b=_=>(~ |=([* *] +<+))]
- |- ^+ ,.+<+.b
- ?~ a
- +<+.b
- $(a t.a, b b(+<+ (b i.a +<+.b)))
- ::
- ++ scag :: prefix
- ~/ %scag
- |* [a=@ b=(list)]
- |- ^+ b
- ?: |(?=(~ b) =(0 a)) ~
- [i.b $(b t.b, a (dec a))]
- ::
- ++ skid :: separate
- ~/ %skid
- |* [a=(list) b=$-(* ?)]
- |- ^+ [p=a q=a]
- ?~ a [~ ~]
- =+ c=$(a t.a)
- ?:((b i.a) [[i.a p.c] q.c] [p.c [i.a q.c]])
- ::
- ++ skim :: only
- ~/ %skim
- |* [a=(list) b=$-(* ?)]
- |-
- ^+ a
- ?~ a ~
- ?:((b i.a) [i.a $(a t.a)] $(a t.a))
- ::
- ++ skip :: except
- ~/ %skip
- |* [a=(list) b=$-(* ?)]
- |-
- ^+ a
- ?~ a ~
- ?:((b i.a) $(a t.a) [i.a $(a t.a)])
- ::
- ++ slag :: suffix
- ~/ %slag
- |* [a=@ b=(list)]
- |- ^+ b
- ?: =(0 a) b
- ?~ b ~
- $(b t.b, a (dec a))
- ::
- ++ snag :: index
- ~/ %snag
- |* [a=@ b=(list)]
- |- ^+ ?>(?=(^ b) i.b)
- ?~ b
- ~_ leaf+"snag-fail"
- !!
- ?: =(0 a) i.b
- $(b t.b, a (dec a))
- ::
- ++ snip :: drop tail off list
- ~/ %snip
- |* a=(list)
- ^+ a
- ?~ a ~
- ?: =(~ t.a) ~
- [i.a $(a t.a)]
- ::
- ++ sort !. :: quicksort
- ~/ %sort
- |* [a=(list) b=$-([* *] ?)]
- => .(a ^.(homo a))
- |- ^+ a
- ?~ a ~
- =+ s=(skid t.a |:(c=i.a (b c i.a)))
- %+ weld
- $(a p.s)
- ^+ t.a
- [i.a $(a q.s)]
- ::
- ++ spin :: stateful turn
- ::
- :: a: list
- :: b: state
- :: c: gate from list-item and state to product and new state
- ~/ %spin
- |* [a=(list) b=* c=_|=(^ [** +<+])]
- => .(c `$-([_?>(?=(^ a) i.a) _b] [_-:(c) _b])`c)
- =/ acc=(list _-:(c)) ~
- :: transformed list and updated state
- |- ^- (pair _acc _b)
- ?~ a
- [(flop acc) b]
- =^ res b (c i.a b)
- $(acc [res acc], a t.a)
- ::
- ++ spun :: internal spin
- ::
- :: a: list
- :: b: gate from list-item and state to product and new state
- ~/ %spun
- |* [a=(list) b=_|=(^ [** +<+])]
- :: transformed list
- p:(spin a +<+.b b)
- ::
- ++ swag :: slice
- |* [[a=@ b=@] c=(list)]
- (scag +<-> (slag +<-< c))
- :: +turn: transform each value of list :a using the function :b
- ::
- ++ turn
- ~/ %turn
- |* [a=(list) b=gate]
- => .(a (homo a))
- ^- (list _?>(?=(^ a) (b i.a)))
- |-
- ?~ a ~
- [i=(b i.a) t=$(a t.a)]
- ::
- ++ weld :: concatenate
- ~/ %weld
- |* [a=(list) b=(list)]
- => .(a ^.(homo a), b ^.(homo b))
- |- ^+ b
- ?~ a b
- [i.a $(a t.a)]
- ::
- ++ snap :: replace item
- ~/ %snap
- |* [a=(list) b=@ c=*]
- ^+ a
- (weld (scag b a) [c (slag +(b) a)])
- ::
- ++ into :: insert item
- ~/ %into
- |* [a=(list) b=@ c=*]
- ^+ a
- (weld (scag b a) [c (slag b a)])
- ::
- ++ welp :: faceless weld
- ~/ %welp
- |* [* *]
- ?~ +<-
- +<-(. +<+)
- +<-(+ $(+<- +<->))
- ::
- ++ zing :: promote
- ~/ %zing
- |* *
- ?~ +<
- +<
- (welp +<- $(+< +<+))
- ::
- :: 2c: bit arithmetic
- +| %bit-arithmetic
- ::
- ++ bex :: binary exponent
- ~/ %bex
- |= a=bloq
- ^- @
- ?: =(0 a) 1
- (mul 2 $(a (dec a)))
- ::
- ++ can :: assemble
- ~/ %can
- |= [a=bloq b=(list [p=step q=@])]
- ^- @
- ?~ b 0
- (add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b)))
- ::
- ++ cat :: concatenate
- ~/ %cat
- |= [a=bloq b=@ c=@]
- (add (lsh [a (met a b)] c) b)
- ::
- ++ cut :: slice
- ~/ %cut
- |= [a=bloq [b=step c=step] d=@]
- (end [a c] (rsh [a b] d))
- ::
- ++ end :: tail
- ~/ %end
- |= [a=bite b=@]
- =/ [=bloq =step] ?^(a a [a *step])
- (mod b (bex (mul (bex bloq) step)))
- ::
- ++ fil :: fill bloqstream
- ~/ %fil
- |= [a=bloq b=step c=@]
- =| n=@ud
- =. c (end a c)
- =/ d c
- |- ^- @
- ?: =(n b)
- (rsh a d)
- $(d (add c (lsh a d)), n +(n))
- ::
- ++ lsh :: left-shift
- ~/ %lsh
- |= [a=bite b=@]
- =/ [=bloq =step] ?^(a a [a *step])
- (mul b (bex (mul (bex bloq) step)))
- ::
- ++ met :: measure
- ~/ %met
- |= [a=bloq b=@]
- ^- @
- =+ c=0
- |-
- ?: =(0 b) c
- $(b (rsh a b), c +(c))
- ::
- ++ rap :: assemble variable
- ~/ %rap
- |= [a=bloq b=(list @)]
- ^- @
- ?~ b 0
- (cat a i.b $(b t.b))
- ::
- ++ rep :: assemble fixed
- ~/ %rep
- |= [a=bite b=(list @)]
- =/ [=bloq =step] ?^(a a [a *step])
- =| i=@ud
- |- ^- @
- ?~ b 0
- %+ add $(i +(i), b t.b)
- (lsh [bloq (mul step i)] (end [bloq step] i.b))
- ::
- ++ rev
- :: reverses block order, accounting for leading zeroes
- ::
- :: boz: block size
- :: len: size of dat, in boz
- :: dat: data to flip
- ~/ %rev
- |= [boz=bloq len=@ud dat=@]
- ^- @
- =. dat (end [boz len] dat)
- %+ lsh
- [boz (sub len (met boz dat))]
- (swp boz dat)
- ::
- ++ rip :: disassemble
- ~/ %rip
- |= [a=bite b=@]
- ^- (list @)
- ?: =(0 b) ~
- [(end a b) $(b (rsh a b))]
- ::
- ++ rsh :: right-shift
- ~/ %rsh
- |= [a=bite b=@]
- =/ [=bloq =step] ?^(a a [a *step])
- (div b (bex (mul (bex bloq) step)))
- ::
- ++ run :: +turn into atom
- ~/ %run
- |= [a=bite b=@ c=$-(@ @)]
- (rep a (turn (rip a b) c))
- ::
- ++ rut :: +turn into list
- ~/ %rut
- |* [a=bite b=@ c=$-(@ *)]
- (turn (rip a b) c)
- ::
- ++ sew :: stitch into
- ~/ %sew
- |= [a=bloq [b=step c=step d=@] e=@]
- ^- @
- %+ add
- (can a b^e c^d ~)
- =/ f [a (add b c)]
- (lsh f (rsh f e))
- ::
- ++ swp :: naive rev bloq order
- ~/ %swp
- |= [a=bloq b=@]
- (rep a (flop (rip a b)))
- ::
- ++ xeb :: binary logarithm
- ~/ %xeb
- |= a=@
- ^- @
- (met 0 a)
- ::
- ++ fe :: modulo bloq
- |_ a=bloq
- ++ dif :: difference
- |=([b=@ c=@] (sit (sub (add out (sit b)) (sit c))))
- ++ inv |=(b=@ (sub (dec out) (sit b))) :: inverse
- ++ net |= b=@ ^- @ :: flip byte endianness
- => .(b (sit b))
- ?: (lte a 3)
- b
- =+ c=(dec a)
- %+ con
- (lsh c $(a c, b (cut c [0 1] b)))
- $(a c, b (cut c [1 1] b))
- ++ out (bex (bex a)) :: mod value
- ++ rol |= [b=bloq c=@ d=@] ^- @ :: roll left
- =+ e=(sit d)
- =+ f=(bex (sub a b))
- =+ g=(mod c f)
- (sit (con (lsh [b g] e) (rsh [b (sub f g)] e)))
- ++ ror |= [b=bloq c=@ d=@] ^- @ :: roll right
- =+ e=(sit d)
- =+ f=(bex (sub a b))
- =+ g=(mod c f)
- (sit (con (rsh [b g] e) (lsh [b (sub f g)] e)))
- ++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add
- ++ sit |=(b=@ (end a b)) :: enforce modulo
- --
- ::
- :: 2d: bit logic
- +| %bit-logic
- ::
- ++ con :: binary or
- ~/ %con
- |= [a=@ b=@]
- =+ [c=0 d=0]
- |- ^- @
- ?: ?&(=(0 a) =(0 b)) d
- %= $
- a (rsh 0 a)
- b (rsh 0 b)
- c +(c)
- d %+ add d
- %+ lsh [0 c]
- ?& =(0 (end 0 a))
- =(0 (end 0 b))
- ==
- ==
- ::
- ++ dis :: binary and
- ~/ %dis
- |= [a=@ b=@]
- =| [c=@ d=@]
- |- ^- @
- ?: ?|(=(0 a) =(0 b)) d
- %= $
- a (rsh 0 a)
- b (rsh 0 b)
- c +(c)
- d %+ add d
- %+ lsh [0 c]
- ?| =(0 (end 0 a))
- =(0 (end 0 b))
- ==
- ==
- ::
- ++ mix :: binary xor
- ~/ %mix
- |= [a=@ b=@]
- ^- @
- =+ [c=0 d=0]
- |-
- ?: ?&(=(0 a) =(0 b)) d
- %= $
- a (rsh 0 a)
- b (rsh 0 b)
- c +(c)
- d (add d (lsh [0 c] =((end 0 a) (end 0 b))))
- ==
- ::
- ++ not |= [a=bloq b=@ c=@] :: binary not (sized)
- (mix c (dec (bex (mul b (bex a)))))
- ::
- :: 2e: insecure hashing
- +| %insecure-hashing
- ::
- ++ muk :: standard murmur3
- ~% %muk ..muk ~
- =+ ~(. fe 5)
- |= [syd=@ len=@ key=@]
- =. syd (end 5 syd)
- =/ pad (sub len (met 3 key))
- =/ data (weld (rip 3 key) (reap pad 0))
- =/ nblocks (div len 4) :: intentionally off-by-one
- =/ h1 syd
- =+ [c1=0xcc9e.2d51 c2=0x1b87.3593]
- =/ blocks (rip 5 key)
- =/ i nblocks
- =. h1 =/ hi h1 |-
- ?: =(0 i) hi
- =/ k1 (snag (sub nblocks i) blocks) :: negative array index
- =. k1 (sit (mul k1 c1))
- =. k1 (rol 0 15 k1)
- =. k1 (sit (mul k1 c2))
- =. hi (mix hi k1)
- =. hi (rol 0 13 hi)
- =. hi (sum (sit (mul hi 5)) 0xe654.6b64)
- $(i (dec i))
- =/ tail (slag (mul 4 nblocks) data)
- =/ k1 0
- =/ tlen (dis len 3)
- =. h1
- ?+ tlen h1 :: fallthrough switch
- %3 =. k1 (mix k1 (lsh [0 16] (snag 2 tail)))
- =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
- =. k1 (mix k1 (snag 0 tail))
- =. k1 (sit (mul k1 c1))
- =. k1 (rol 0 15 k1)
- =. k1 (sit (mul k1 c2))
- (mix h1 k1)
- %2 =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
- =. k1 (mix k1 (snag 0 tail))
- =. k1 (sit (mul k1 c1))
- =. k1 (rol 0 15 k1)
- =. k1 (sit (mul k1 c2))
- (mix h1 k1)
- %1 =. k1 (mix k1 (snag 0 tail))
- =. k1 (sit (mul k1 c1))
- =. k1 (rol 0 15 k1)
- =. k1 (sit (mul k1 c2))
- (mix h1 k1)
- ==
- =. h1 (mix h1 len)
- |^ (fmix32 h1)
- ++ fmix32
- |= h=@
- =. h (mix h (rsh [0 16] h))
- =. h (sit (mul h 0x85eb.ca6b))
- =. h (mix h (rsh [0 13] h))
- =. h (sit (mul h 0xc2b2.ae35))
- =. h (mix h (rsh [0 16] h))
- h
- --
- ::
- ++ mug :: mug with murmur3
- ~/ %mug
- |= a=*
- |^ ?@ a (mum 0xcafe.babe 0x7fff a)
- =/ b (cat 5 $(a -.a) $(a +.a))
- (mum 0xdead.beef 0xfffe b)
- ::
- ++ mum
- |= [syd=@uxF fal=@F key=@]
- =/ wyd (met 3 key)
- =| i=@ud
- |- ^- @F
- ?: =(8 i) fal
- =/ haz=@F (muk syd wyd key)
- =/ ham=@F (mix (rsh [0 31] haz) (end [0 31] haz))
- ?.(=(0 ham) ham $(i +(i), syd +(syd)))
- --
- :: ::
- :: 2f: noun ordering
- +| %noun-ordering
- ::
- :: +aor: alphabetical order
- ::
- :: Orders atoms before cells, and atoms in ascending LSB order.
- ::
- ++ aor
- ~/ %aor
- |= [a=* b=*]
- ^- ?
- ?: =(a b) &
- ?. ?=(@ a)
- ?: ?=(@ b) |
- ?: =(-.a -.b)
- $(a +.a, b +.b)
- $(a -.a, b -.b)
- ?. ?=(@ b) &
- |-
- =+ [c=(end 3 a) d=(end 3 b)]
- ?: =(c d)
- $(a (rsh 3 a), b (rsh 3 b))
- (lth c d)
- :: +dor: depth order
- ::
- :: Orders in ascending tree depth.
- ::
- ++ dor
- ~/ %dor
- |= [a=* b=*]
- ^- ?
- ?: =(a b) &
- ?. ?=(@ a)
- ?: ?=(@ b) |
- ?: =(-.a -.b)
- $(a +.a, b +.b)
- $(a -.a, b -.b)
- ?. ?=(@ b) &
- (lth a b)
- :: +gor: mug order
- ::
- :: Orders in ascending +mug hash order, collisions fall back to +dor.
- ::
- ++ gor
- ~/ %gor
- |= [a=* b=*]
- ^- ?
- =+ [c=(mug a) d=(mug b)]
- ?: =(c d)
- (dor a b)
- (lth c d)
- :: +mor: (more) mug order
- ::
- :: Orders in ascending double +mug hash order, collisions fall back to +dor.
- ::
- ++ mor
- ~/ %mor
- |= [a=* b=*]
- ^- ?
- =+ [c=(mug (mug a)) d=(mug (mug b))]
- ?: =(c d)
- (dor a b)
- (lth c d)
- ::
- :: 2g: unsigned powers
- +| %unsigned-powers
- ::
- ++ pow :: unsigned exponent
- ~/ %pow
- |= [a=@ b=@]
- ?: =(b 0) 1
- |- ?: =(b 1) a
- =+ c=$(b (div b 2))
- =+ d=(mul c c)
- ?~ (dis b 1) d (mul d a)
- ::
- ++ sqt :: unsigned sqrt/rem
- ~/ %sqt
- |= a=@ ^- [p=@ q=@]
- ?~ a [0 0]
- =+ [q=(div (dec (xeb a)) 2) r=0]
- =- [-.b (sub a +.b)]
- ^= b |-
- =+ s=(add r (bex q))
- =+ t=(mul s s)
- ?: =(q 0)
- ?:((lte t a) [s t] [r (mul r r)])
- ?: (lte t a)
- $(r s, q (dec q))
- $(q (dec q))
- ::
- :: 2h: set logic
- +| %set-logic
- ::
- ++ in :: set engine
- ~/ %in
- =| a=(tree) :: (set)
- |@
- ++ all :: logical AND
- ~/ %all
- |* b=$-(* ?)
- |- ^- ?
- ?~ a
- &
- ?&((b n.a) $(a l.a) $(a r.a))
- ::
- ++ any :: logical OR
- ~/ %any
- |* b=$-(* ?)
- |- ^- ?
- ?~ a
- |
- ?|((b n.a) $(a l.a) $(a r.a))
- ::
- ++ apt :: check correctness
- =< $
- ~/ %apt
- =| [l=(unit) r=(unit)]
- |. ^- ?
- ?~ a &
- ?& ?~(l & &((gor n.a u.l) !=(n.a u.l)))
- ?~(r & &((gor u.r n.a) !=(u.r n.a)))
- ?~(l.a & ?&((mor n.a n.l.a) !=(n.a n.l.a) $(a l.a, l `n.a)))
- ?~(r.a & ?&((mor n.a n.r.a) !=(n.a n.r.a) $(a r.a, r `n.a)))
- ==
- ::
- ++ bif :: splits a by b
- ~/ %bif
- |* b=*
- ^+ [l=a r=a]
- =< +
- |- ^+ a
- ?~ a
- [b ~ ~]
- ?: =(b n.a)
- a
- ?: (gor b n.a)
- =+ c=$(a l.a)
- ?> ?=(^ c)
- c(r a(l r.c))
- =+ c=$(a r.a)
- ?> ?=(^ c)
- c(l a(r l.c))
- ::
- ++ del :: b without any a
- ~/ %del
- |* b=*
- |- ^+ a
- ?~ a
- ~
- ?. =(b n.a)
- ?: (gor b n.a)
- a(l $(a l.a))
- a(r $(a r.a))
- |- ^- [$?(~ _a)]
- ?~ l.a r.a
- ?~ r.a l.a
- ?: (mor n.l.a n.r.a)
- l.a(r $(l.a r.l.a))
- r.a(l $(r.a l.r.a))
- ::
- ++ dif :: difference
- ~/ %dif
- |* b=_a
- |- ^+ a
- ?~ b
- a
- =+ c=(bif n.b)
- ?> ?=(^ c)
- =+ d=$(a l.c, b l.b)
- =+ e=$(a r.c, b r.b)
- |- ^- [$?(~ _a)]
- ?~ d e
- ?~ e d
- ?: (mor n.d n.e)
- d(r $(d r.d))
- e(l $(e l.e))
- ::
- ++ dig :: axis of a in b
- |= b=*
- =+ c=1
- |- ^- (unit @)
- ?~ a ~
- ?: =(b n.a) [~ u=(peg c 2)]
- ?: (gor b n.a)
- $(a l.a, c (peg c 6))
- $(a r.a, c (peg c 7))
- ::
- ++ gas :: concatenate
- ~/ %gas
- |= b=(list _?>(?=(^ a) n.a))
- |- ^+ a
- ?~ b
- a
- $(b t.b, a (put i.b))
- :: +has: does :b exist in :a?
- ::
- ++ has
- ~/ %has
- |* b=*
- ^- ?
- :: wrap extracted item type in a unit because bunting fails
- ::
- :: If we used the real item type of _?^(a n.a !!) as the sample type,
- :: then hoon would bunt it to create the default sample for the gate.
- ::
- :: However, bunting that expression fails if :a is ~. If we wrap it
- :: in a unit, the bunted unit doesn't include the bunted item type.
- ::
- :: This way we can ensure type safety of :b without needing to perform
- :: this failing bunt. It's a hack.
- ::
- %. [~ b]
- |= b=(unit _?>(?=(^ a) n.a))
- => .(b ?>(?=(^ b) u.b))
- |- ^- ?
- ?~ a
- |
- ?: =(b n.a)
- &
- ?: (gor b n.a)
- $(a l.a)
- $(a r.a)
- ::
- ++ int :: intersection
- ~/ %int
- |* b=_a
- |- ^+ a
- ?~ b
- ~
- ?~ a
- ~
- ?. (mor n.a n.b)
- $(a b, b a)
- ?: =(n.b n.a)
- a(l $(a l.a, b l.b), r $(a r.a, b r.b))
- ?: (gor n.b n.a)
- %- uni(a $(a l.a, r.b ~)) $(b r.b)
- %- uni(a $(a r.a, l.b ~)) $(b l.b)
- ::
- ++ put :: puts b in a, sorted
- ~/ %put
- |* b=*
- |- ^+ a
- ?~ a
- [b ~ ~]
- ?: =(b n.a)
- a
- ?: (gor b n.a)
- =+ c=$(a l.a)
- ?> ?=(^ c)
- ?: (mor n.a n.c)
- a(l c)
- c(r a(l r.c))
- =+ c=$(a r.a)
- ?> ?=(^ c)
- ?: (mor n.a n.c)
- a(r c)
- c(l a(r l.c))
- ::
- ++ rep :: reduce to product
- ~/ %rep
- |* b=_=>(~ |=([* *] +<+))
- |-
- ?~ a +<+.b
- $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
- ::
- ++ run :: apply gate to values
- ~/ %run
- |* b=gate
- =+ c=`(set _?>(?=(^ a) (b n.a)))`~
- |- ?~ a c
- =. c (~(put in c) (b n.a))
- =. c $(a l.a, c c)
- $(a r.a, c c)
- ::
- ++ tap :: convert to list
- =< $
- ~/ %tap
- =+ b=`(list _?>(?=(^ a) n.a))`~
- |. ^+ b
- ?~ a
- b
- $(a r.a, b [n.a $(a l.a)])
- ::
- ++ uni :: union
- ~/ %uni
- |* b=_a
- ?: =(a b) a
- |- ^+ a
- ?~ b
- a
- ?~ a
- b
- ?: =(n.b n.a)
- b(l $(a l.a, b l.b), r $(a r.a, b r.b))
- ?: (mor n.a n.b)
- ?: (gor n.b n.a)
- $(l.a $(a l.a, r.b ~), b r.b)
- $(r.a $(a r.a, l.b ~), b l.b)
- ?: (gor n.a n.b)
- $(l.b $(b l.b, r.a ~), a r.a)
- $(r.b $(b r.b, l.a ~), a l.a)
- ::
- ++ wyt :: size of set
- =< $
- ~% %wyt + ~
- |. ^- @
- ?~(a 0 +((add $(a l.a) $(a r.a))))
- --
- ::
- :: 2i: map logic
- +| %map-logic
- ::
- ++ by :: map engine
- ~/ %by
- =| a=(tree (pair)) :: (map)
- |@
- ++ all :: logical AND
- ~/ %all
- |* b=$-(* ?)
- |- ^- ?
- ?~ a
- &
- ?&((b q.n.a) $(a l.a) $(a r.a))
- ::
- ++ any :: logical OR
- ~/ %any
- |* b=$-(* ?)
- |- ^- ?
- ?~ a
- |
- ?|((b q.n.a) $(a l.a) $(a r.a))
- ::
- ++ bif :: splits a by b
- ~/ %bif
- |* b=*
- |- ^+ [l=a r=a]
- ?~ a
- [~ ~]
- ?: =(b p.n.a)
- +.a
- ?: (gor b p.n.a)
- =+ d=$(a l.a)
- ?> ?=(^ d)
- [l.d a(l r.d)]
- =+ d=$(a r.a)
- ?> ?=(^ d)
- [a(r l.d) r.d]
- ::
- ++ del :: delete at key b
- ~/ %del
- |* b=*
- |- ^+ a
- ?~ a
- ~
- ?. =(b p.n.a)
- ?: (gor b p.n.a)
- a(l $(a l.a))
- a(r $(a r.a))
- |- ^- [$?(~ _a)]
- ?~ l.a r.a
- ?~ r.a l.a
- ?: (mor p.n.l.a p.n.r.a)
- l.a(r $(l.a r.l.a))
- r.a(l $(r.a l.r.a))
- ::
- ++ dif :: difference
- ~/ %dif
- |* b=_a
- |- ^+ a
- ?~ b
- a
- =+ c=(bif p.n.b)
- ?> ?=(^ c)
- =+ d=$(a l.c, b l.b)
- =+ e=$(a r.c, b r.b)
- |- ^- [$?(~ _a)]
- ?~ d e
- ?~ e d
- ?: (mor p.n.d p.n.e)
- d(r $(d r.d))
- e(l $(e l.e))
- ::
- ++ dig :: axis of b key
- |= b=*
- =+ c=1
- |- ^- (unit @)
- ?~ a ~
- ?: =(b p.n.a) [~ u=(peg c 2)]
- ?: (gor b p.n.a)
- $(a l.a, c (peg c 6))
- $(a r.a, c (peg c 7))
- ::
- ++ apt :: check correctness
- =< $
- ~/ %apt
- =| [l=(unit) r=(unit)]
- |. ^- ?
- ?~ a &
- ?& ?~(l & &((gor p.n.a u.l) !=(p.n.a u.l)))
- ?~(r & &((gor u.r p.n.a) !=(u.r p.n.a)))
- ?~ l.a &
- &((mor p.n.a p.n.l.a) !=(p.n.a p.n.l.a) $(a l.a, l `p.n.a))
- ?~ r.a &
- &((mor p.n.a p.n.r.a) !=(p.n.a p.n.r.a) $(a r.a, r `p.n.a))
- ==
- ::
- ++ gas :: concatenate
- ~/ %gas
- |* b=(list [p=* q=*])
- => .(b `(list _?>(?=(^ a) n.a))`b)
- |- ^+ a
- ?~ b
- a
- $(b t.b, a (put p.i.b q.i.b))
- ::
- ++ get :: grab value by key
- ~/ %get
- |* b=*
- => .(b `_?>(?=(^ a) p.n.a)`b)
- |- ^- (unit _?>(?=(^ a) q.n.a))
- ?~ a
- ~
- ?: =(b p.n.a)
- (some q.n.a)
- ?: (gor b p.n.a)
- $(a l.a)
- $(a r.a)
- ::
- ++ got :: need value by key
- |* b=*
- (need (get b))
- ::
- ++ gut :: fall value by key
- |* [b=* c=*]
- (fall (get b) c)
- ::
- ++ has :: key existence check
- ~/ %has
- |* b=*
- !=(~ (get b))
- ::
- ++ int :: intersection
- ~/ %int
- |* b=_a
- |- ^+ a
- ?~ b
- ~
- ?~ a
- ~
- ?: (mor p.n.a p.n.b)
- ?: =(p.n.b p.n.a)
- b(l $(a l.a, b l.b), r $(a r.a, b r.b))
- ?: (gor p.n.b p.n.a)
- %- uni(a $(a l.a, r.b ~)) $(b r.b)
- %- uni(a $(a r.a, l.b ~)) $(b l.b)
- ?: =(p.n.a p.n.b)
- b(l $(b l.b, a l.a), r $(b r.b, a r.a))
- ?: (gor p.n.a p.n.b)
- %- uni(a $(b l.b, r.a ~)) $(a r.a)
- %- uni(a $(b r.b, l.a ~)) $(a l.a)
- ::
- ++ jab
- ~/ %jab
- |* [key=_?>(?=(^ a) p.n.a) fun=$-(_?>(?=(^ a) q.n.a) _?>(?=(^ a) q.n.a))]
- ^+ a
- ::
- ?~ a !!
- ::
- ?: =(key p.n.a)
- a(q.n (fun q.n.a))
- ::
- ?: (gor key p.n.a)
- a(l $(a l.a))
- ::
- a(r $(a r.a))
- ::
- ++ mar :: add with validation
- |* [b=* c=(unit *)]
- ?~ c
- (del b)
- (put b u.c)
- ::
- ++ put :: adds key-value pair
- ~/ %put
- |* [b=* c=*]
- |- ^+ a
- ?~ a
- [[b c] ~ ~]
- ?: =(b p.n.a)
- ?: =(c q.n.a)
- a
- a(n [b c])
- ?: (gor b p.n.a)
- =+ d=$(a l.a)
- ?> ?=(^ d)
- ?: (mor p.n.a p.n.d)
- a(l d)
- d(r a(l r.d))
- =+ d=$(a r.a)
- ?> ?=(^ d)
- ?: (mor p.n.a p.n.d)
- a(r d)
- d(l a(r l.d))
- ::
- ++ rep :: reduce to product
- ~/ %rep
- |* b=_=>(~ |=([* *] +<+))
- |-
- ?~ a +<+.b
- $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
- ::
- ++ rib :: transform + product
- |* [b=* c=gate]
- |- ^+ [b a]
- ?~ a [b ~]
- =+ d=(c n.a b)
- =. n.a +.d
- =+ e=$(a l.a, b -.d)
- =+ f=$(a r.a, b -.e)
- [-.f a(l +.e, r +.f)]
- ::
- ++ run :: apply gate to values
- ~/ %run
- |* b=gate
- |-
- ?~ a a
- [n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)]
- ::
- ++ tap :: listify pairs
- =< $
- ~/ %tap
- =+ b=`(list _?>(?=(^ a) n.a))`~
- |. ^+ b
- ?~ a
- b
- $(a r.a, b [n.a $(a l.a)])
- ::
- ++ uni :: union, merge
- ~/ %uni
- |* b=_a
- |- ^+ a
- ?~ b
- a
- ?~ a
- b
- ?: =(p.n.b p.n.a)
- b(l $(a l.a, b l.b), r $(a r.a, b r.b))
- ?: (mor p.n.a p.n.b)
- ?: (gor p.n.b p.n.a)
- $(l.a $(a l.a, r.b ~), b r.b)
- $(r.a $(a r.a, l.b ~), b l.b)
- ?: (gor p.n.a p.n.b)
- $(l.b $(b l.b, r.a ~), a r.a)
- $(r.b $(b r.b, l.a ~), a l.a)
- ::
- ++ uno :: general union
- |* b=_a
- |* meg=$-([* * *] *)
- |- ^+ a
- ?~ b
- a
- ?~ a
- b
- ?: =(p.n.b p.n.a)
- :+ [p.n.a `_?>(?=(^ a) q.n.a)`(meg p.n.a q.n.a q.n.b)]
- $(b l.b, a l.a)
- $(b r.b, a r.a)
- ?: (mor p.n.a p.n.b)
- ?: (gor p.n.b p.n.a)
- $(l.a $(a l.a, r.b ~), b r.b)
- $(r.a $(a r.a, l.b ~), b l.b)
- ?: (gor p.n.a p.n.b)
- $(l.b $(b l.b, r.a ~), a r.a)
- $(r.b $(b r.b, l.a ~), a l.a)
- ::
- ++ urn :: apply gate to nodes
- ~/ %urn
- |* b=$-([* *] *)
- |-
- ?~ a ~
- a(n n.a(q (b p.n.a q.n.a)), l $(a l.a), r $(a r.a))
- ::
- ++ wyt :: depth of map
- =< $
- ~% %wyt + ~
- |. ^- @
- ?~(a 0 +((add $(a l.a) $(a r.a))))
- ::
- ++ key :: set of keys
- =< $
- ~/ %key
- =+ b=`(set _?>(?=(^ a) p.n.a))`~
- |. ^+ b
- ?~ a b
- $(a r.a, b $(a l.a, b (~(put in b) p.n.a)))
- ::
- ++ val :: list of vals
- =+ b=`(list _?>(?=(^ a) q.n.a))`~
- |- ^+ b
- ?~ a b
- $(a r.a, b [q.n.a $(a l.a)])
- --
- ::
- :: 2j: jar and jug logic
- +| %jar-and-jug-logic
- ++ ja :: jar engine
- =| a=(tree (pair * (list))) :: (jar)
- |@
- ++ get :: gets list by key
- |* b=*
- =+ c=(~(get by a) b)
- ?~(c ~ u.c)
- ::
- ++ add :: adds key-list pair
- |* [b=* c=*]
- =+ d=(get b)
- (~(put by a) b [c d])
- ::
- ++ zip :: listify jar
- =< $
- ~/ %zip
- =+ b=`(list _?>(?=([[* ^] *] a) [p=p q=i.q]:n.a))`~
- |. ^+ b
- ?~ a b
- %= $
- a r.a
- b |- ^+ b
- ?~ q.n.a ^$(a l.a)
- [[p i.q]:n.a $(q.n.a t.q.n.a)]
- ==
- --
- ++ ju :: jug engine
- =| a=(tree (pair * (tree))) :: (jug)
- |@
- ++ del :: del key-set pair
- |* [b=* c=*]
- ^+ a
- =+ d=(get b)
- =+ e=(~(del in d) c)
- ?~ e
- (~(del by a) b)
- (~(put by a) b e)
- ::
- ++ gas :: concatenate
- |* b=(list [p=* q=*])
- => .(b `(list _?>(?=([[* ^] ^] a) [p=p q=n.q]:n.a))`b)
- |- ^+ a
- ?~ b
- a
- $(b t.b, a (put p.i.b q.i.b))
- ::
- ++ get :: gets set by key
- |* b=*
- =+ c=(~(get by a) b)
- ?~(c ~ u.c)
- ::
- ++ has :: existence check
- |* [b=* c=*]
- ^- ?
- (~(has in (get b)) c)
- ::
- ++ put :: add key-set pair
- |* [b=* c=*]
- ^+ a
- =+ d=(get b)
- (~(put by a) b (~(put in d) c))
- --
- ::
- :: 2k: queue logic
- +| %queue-logic
- ::
- ++ to :: queue engine
- =| a=(tree) :: (qeu)
- |@
- ++ apt :: check correctness
- |- ^- ?
- ?~ a &
- ?& ?~(l.a & ?&((mor n.a n.l.a) $(a l.a)))
- ?~(r.a & ?&((mor n.a n.r.a) $(a r.a)))
- ==
- ::
- ++ bal
- |- ^+ a
- ?~ a ~
- ?. |(?=(~ l.a) (mor n.a n.l.a))
- $(a l.a(r $(a a(l r.l.a))))
- ?. |(?=(~ r.a) (mor n.a n.r.a))
- $(a r.a(l $(a a(r l.r.a))))
- a
- ::
- ++ dep :: max depth of queue
- |- ^- @
- ?~ a 0
- +((max $(a l.a) $(a r.a)))
- ::
- ++ gas :: insert list to que
- |= b=(list _?>(?=(^ a) n.a))
- |- ^+ a
- ?~(b a $(b t.b, a (put i.b)))
- ::
- ++ get :: head-rest pair
- |- ^+ ?>(?=(^ a) [p=n.a q=*(tree _n.a)])
- ?~ a
- !!
- ?~ r.a
- [n.a l.a]
- =+ b=$(a r.a)
- :- p.b
- ?: |(?=(~ q.b) (mor n.a n.q.b))
- a(r q.b)
- a(n n.q.b, l a(r l.q.b), r r.q.b)
- ::
- ++ nip :: removes root
- |- ^+ a
- ?~ a ~
- ?~ l.a r.a
- ?~ r.a l.a
- ?: (mor n.l.a n.r.a)
- l.a(r $(l.a r.l.a))
- r.a(l $(r.a l.r.a))
- ::
- ++ nap :: removes root
- ?> ?=(^ a)
- ?: =(~ l.a) r.a
- =+ b=get(a l.a)
- bal(n.a p.b, l.a q.b)
- ::
- ++ put :: insert new tail
- |* b=*
- |- ^+ a
- ?~ a
- [b ~ ~]
- bal(l.a $(a l.a))
- ::
- ++ run :: apply gate to values
- |* b=gate
- |-
- ?~ a a
- [n=(b n.a) l=$(a l.a) r=$(a r.a)]
- ::
- ++ tap :: adds list to end
- =+ b=`(list _?>(?=(^ a) n.a))`~
- |- ^+ b
- =+ 0 :: hack for jet match
- ?~ a
- b
- $(a r.a, b [n.a $(a l.a)])
- ::
- ++ top :: produces head
- |- ^- (unit _?>(?=(^ a) n.a))
- ?~ a ~
- ?~(r.a [~ n.a] $(a r.a))
- --
- ::
- :: 2l: container from container
- +| %container-from-container
- ::
- ++ malt :: map from list
- |* a=(list)
- (molt `(list [p=_-<.a q=_->.a])`a)
- ::
- ++ molt :: map from pair list
- |* a=(list (pair)) :: ^- =,(i.-.a (map _p _q))
- (~(gas by `(tree [p=_p.i.-.a q=_q.i.-.a])`~) a)
- ::
- ++ silt :: set from list
- |* a=(list) :: ^- (set _i.-.a)
- =+ b=*(tree _?>(?=(^ a) i.a))
- (~(gas in b) a)
- ::
- :: 2m: container from noun
- +| %container-from-noun
- ::
- ++ ly :: list from raw noun
- le:nl
- ::
- ++ my :: map from raw noun
- my:nl
- ::
- ++ sy :: set from raw noun
- si:nl
- ::
- ++ nl
- |%
- :: ::
- ++ le :: construct list
- |* a=(list)
- ^+ =< $
- |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
- --
- a
- :: ::
- ++ my :: construct map
- |* a=(list (pair))
- => .(a ^+((le a) a))
- (~(gas by `(map _p.i.-.a _q.i.-.a)`~) a)
- :: ::
- ++ si :: construct set
- |* a=(list)
- => .(a ^+((le a) a))
- (~(gas in `(set _i.-.a)`~) a)
- :: ::
- ++ snag :: index
- |* [a=@ b=(list)]
- ?~ b
- ~_ leaf+"snag-fail"
- !!
- ?: =(0 a) i.b
- $(b t.b, a (dec a))
- :: ::
- ++ weld :: concatenate
- |* [a=(list) b=(list)]
- => .(a ^+((le a) a), b ^+((le b) b))
- =+ 42
- |-
- ?~ a b
- [i=i.a t=$(a t.a)]
- --
- :: 2n: functional hacks
- +| %functional-hacks
- ::
- ++ aftr |*(a=$-(* *) |*(b=$-(* *) (pair b a))) :: pair after
- ++ cork |*([a=$-(* *) b=$-(* *)] (corl b a)) :: compose forward
- ++ corl :: compose backwards
- |* [a=$-(* *) b=$-(* *)]
- =< +:|.((a (b))) :: type check
- |* c=_,.+<.b
- (a (b c))
- ::
- ++ cury :: curry left
- |* [a=$-(^ *) b=*]
- |* c=_,.+<+.a
- (a b c)
- ::
- ++ curr :: curry right
- |* [a=$-(^ *) c=*]
- |* b=_,.+<-.a
- (a b c)
- ::
- ++ fore |*(a=$-(* *) |*(b=$-(* *) (pair a b))) :: pair before
- ::
- ++ head |*(^ ,:+<-) :: get head
- ++ same |*(* +<) :: identity
- ::
- ++ succ |=(@ +(+<)) :: successor
- ::
- ++ tail |*(^ ,:+<+) :: get tail
- ++ test |=(^ =(+<- +<+)) :: equality
- ::
- ++ lead |*(* |*(* [+>+< +<])) :: put head
- ++ late |*(* |*(* [+< +>+<])) :: put tail
- ::
- :: 2o: containers
- +| %containers
- ++ jar |$ [key value] (map key (list value)) :: map of lists
- ++ jug |$ [key value] (map key (set value)) :: map of sets
- ::
- ++ map
- |$ [key value] :: table
- $| (tree (pair key value))
- |=(a=(tree (pair)) ?:(=(~ a) & ~(apt by a)))
- ::
- ++ qeu
- |$ [item] :: queue
- $| (tree item)
- |=(a=(tree) ?:(=(~ a) & ~(apt to a)))
- ::
- ++ set
- |$ [item] :: set
- $| (tree item)
- |=(a=(tree) ?:(=(~ a) & ~(apt in a)))
- ::
- :: 2p: serialization
- +| %serialization
- ::
- ++ cue :: unpack
- ~/ %cue
- |= a=@
- ^- *
- =+ b=0
- =+ m=`(map @ *)`~
- =< q
- |- ^- [p=@ q=* r=(map @ *)]
- ?: =(0 (cut 0 [b 1] a))
- =+ c=(rub +(b) a)
- [+(p.c) q.c (~(put by m) b q.c)]
- =+ c=(add 2 b)
- ?: =(0 (cut 0 [+(b) 1] a))
- =+ u=$(b c)
- =+ v=$(b (add p.u c), m r.u)
- =+ w=[q.u q.v]
- [(add 2 (add p.u p.v)) w (~(put by r.v) b w)]
- =+ d=(rub c a)
- [(add 2 p.d) (need (~(get by m) q.d)) m]
- ::
- ++ jam :: pack
- ~/ %jam
- |= a=*
- ^- @
- =+ b=0
- =+ m=`(map * @)`~
- =< q
- |- ^- [p=@ q=@ r=(map * @)]
- =+ c=(~(get by m) a)
- ?~ c
- => .(m (~(put by m) a b))
- ?: ?=(@ a)
- =+ d=(mat a)
- [(add 1 p.d) (lsh 0 q.d) m]
- => .(b (add 2 b))
- =+ d=$(a -.a)
- =+ e=$(a +.a, b (add b p.d), m r.d)
- [(add 2 (add p.d p.e)) (mix 1 (lsh [0 2] (cat 0 q.d q.e))) r.e]
- ?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c)))
- =+ d=(mat a)
- [(add 1 p.d) (lsh 0 q.d) m]
- =+ d=(mat u.c)
- [(add 2 p.d) (mix 3 (lsh [0 2] q.d)) m]
- ::
- ++ mat :: length-encode
- ~/ %mat
- |= a=@
- ^- [p=@ q=@]
- ?: =(0 a)
- [1 1]
- =+ b=(met 0 a)
- =+ c=(met 0 b)
- :- (add (add c c) b)
- (cat 0 (bex c) (mix (end [0 (dec c)] b) (lsh [0 (dec c)] a)))
- ::
- ++ rub :: length-decode
- ~/ %rub
- |= [a=@ b=@]
- ^- [p=@ q=@]
- =+ ^= c
- =+ [c=0 m=(met 0 b)]
- |- ?< (gth c m)
- ?. =(0 (cut 0 [(add a c) 1] b))
- c
- $(c +(c))
- ?: =(0 c)
- [1 0]
- =+ d=(add a +(c))
- =+ e=(add (bex (dec c)) (cut 0 [d (dec c)] b))
- [(add (add c c) e) (cut 0 [(add d (dec c)) e] b)]
- ::
- ++ fn :: float, infinity, or NaN
- ::
- :: s=sign, e=exponent, a=arithmetic form
- :: (-1)^s * a * 2^e
- $% [%f s=? e=@s a=@u]
- [%i s=?]
- [%n ~]
- ==
- ::
- ++ dn :: decimal float, infinity, or NaN
- ::
- :: (-1)^s * a * 10^e
- $% [%d s=? e=@s a=@u]
- [%i s=?]
- [%n ~]
- ==
- ::
- ++ rn :: parsed decimal float
- ::
- $% [%d a=? b=[c=@ [d=@ e=@] f=? i=@]]
- [%i a=?]
- [%n ~]
- ==
- ::
- :: 2q: molds and mold builders
- +| %molds-and-mold-builders
- ::
- +$ axis @ :: tree address
- +$ bean ? :: 0=&=yes, 1=|=no
- +$ flag ?
- +$ char @t :: UTF8 byte
- +$ cord @t :: UTF8, LSB first
- +$ byts [wid=@ud dat=@] :: bytes, MSB first
- +$ date [[a=? y=@ud] m=@ud t=tarp] :: parsed date
- +$ knot @ta :: ASCII text
- +$ noun * :: any noun
- +$ path (list knot) :: like unix path
- +$ pith (list iota) :: typed urbit path
- +$ stud :: standard name
- $@ mark=@tas :: auth=urbit
- $: auth=@tas :: standards authority
- type=path :: standard label
- == ::
- +$ tang (list tank) :: bottom-first error
- :: ::
- +$ iota :: typed path segment
- $+ iota
- $~ [%n ~]
- $@ @tas
- $% [%ub @ub] [%uc @uc] [%ud @ud] [%ui @ui]
- [%ux @ux] [%uv @uv] [%uw @uw]
- [%sb @sb] [%sc @sc] [%sd @sd] [%si @si]
- [%sx @sx] [%sv @sv] [%sw @sw]
- [%da @da] [%dr @dr]
- [%f ?] [%n ~]
- [%if @if] [%is @is]
- [%t @t] [%ta @ta] :: @tas
- [%p @p] [%q @q]
- [%rs @rs] [%rd @rd] [%rh @rh] [%rq @rq]
- ==
- ::
- :: $tank: formatted print tree
- ::
- :: just a cord, or
- :: %leaf: just a tape
- :: %palm: backstep list
- :: flat-mid, open, flat-open, flat-close
- :: %rose: flat list
- :: flat-mid, open, close
- ::
- +$ tank
- $+ tank
- $~ leaf/~
- $@ cord
- $% [%leaf p=tape]
- [%palm p=(qual tape tape tape tape) q=(list tank)]
- [%rose p=(trel tape tape tape) q=(list tank)]
- ==
- ::
- +$ tape (list @tD) :: utf8 string as list
- +$ tour (list @c) :: utf32 clusters
- +$ tarp [d=@ud h=@ud m=@ud s=@ud f=(list @ux)] :: parsed time
- +$ term @tas :: ascii symbol
- +$ wain (list cord) :: text lines
- +$ wall (list tape) :: text lines
- ::
- -- =>
- :: ::
- ~% %tri +
- ==
- %year year
- %yore yore
- %ob ob
- ==
- :: layer-3
- ::
- |%
- :: 3a: signed and modular ints
- +| %signed-and-modular-ints
- ::
- ++ egcd :: schneier's egcd
- |= [a=@ b=@]
- =+ si
- =+ [c=(sun a) d=(sun b)]
- =+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]]
- |- ^- [d=@ u=@s v=@s]
- ?: =(--0 c)
- [(abs d) d.u d.v]
- :: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v)))
- :: =(d (sum (pro (sun a) d.u) (pro (sun b) d.v)))
- :: ==
- =+ q=(fra d c)
- %= $
- c (dif d (pro q c))
- d c
- u [(dif d.u (pro q c.u)) c.u]
- v [(dif d.v (pro q c.v)) c.v]
- ==
- ::
- ++ fo :: modulo prime
- ^|
- |_ a=@
- ++ dif
- |= [b=@ c=@]
- (sit (sub (add a b) (sit c)))
- ::
- ++ exp
- |= [b=@ c=@]
- ?: =(0 b)
- 1
- =+ d=$(b (rsh 0 b))
- =+ e=(pro d d)
- ?:(=(0 (end 0 b)) e (pro c e))
- ::
- ++ fra
- |= [b=@ c=@]
- (pro b (inv c))
- ::
- ++ inv
- |= b=@
- =+ c=(dul:si u:(egcd b a) a)
- c
- ::
- ++ pro
- |= [b=@ c=@]
- (sit (mul b c))
- ::
- ++ sit
- |= b=@
- (mod b a)
- ::
- ++ sum
- |= [b=@ c=@]
- (sit (add b c))
- --
- ::
- ++ si :: signed integer
- ^?
- |%
- ++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value
- ++ dif |= [a=@s b=@s] :: subtraction
- (sum a (new !(syn b) (abs b)))
- ++ dul |= [a=@s b=@] :: modulus
- =+(c=(old a) ?:(-.c (mod +.c b) (sub b +.c)))
- ++ fra |= [a=@s b=@s] :: divide
- (new =(0 (mix (syn a) (syn b))) (div (abs a) (abs b)))
- ++ new |= [a=? b=@] :: [sign value] to @s
- `@s`?:(a (mul 2 b) ?:(=(0 b) 0 +((mul 2 (dec b)))))
- ++ old |=(a=@s [(syn a) (abs a)]) :: [sign value]
- ++ pro |= [a=@s b=@s] :: multiplication
- (new =(0 (mix (syn a) (syn b))) (mul (abs a) (abs b)))
- ++ rem |=([a=@s b=@s] (dif a (pro b (fra a b)))) :: remainder
- ++ sum |= [a=@s b=@s] :: addition
- =+ [c=(old a) d=(old b)]
- ?: -.c
- ?: -.d
- (new & (add +.c +.d))
- ?: (gte +.c +.d)
- (new & (sub +.c +.d))
- (new | (sub +.d +.c))
- ?: -.d
- ?: (gte +.c +.d)
- (new | (sub +.c +.d))
- (new & (sub +.d +.c))
- (new | (add +.c +.d))
- ++ sun |=(a=@u (mul 2 a)) :: @u to @s
- ++ syn |=(a=@s =(0 (end 0 a))) :: sign test
- ++ cmp |= [a=@s b=@s] :: compare
- ^- @s
- ?: =(a b)
- --0
- ?: (syn a)
- ?: (syn b)
- ?: (gth a b)
- --1
- -1
- --1
- ?: (syn b)
- -1
- ?: (gth a b)
- -1
- --1
- --
- ::
- :: 3b: floating point
- +| %floating-point
- ::
- ++ fl :: arb. precision fp
- =/ [[p=@u v=@s w=@u] r=$?(%n %u %d %z %a) d=$?(%d %f %i)]
- [[113 -16.494 32.765] %n %d]
- :: p=precision: number of bits in arithmetic form; must be at least 2
- :: v=min exponent: minimum value of e
- :: w=width: max - min value of e, 0 is fixed point
- :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero
- :: d=behavior: return denormals, flush denormals to zero,
- :: infinite exponent range
- =>
- ~% %cofl +> ~
- :: cofl
- ::
- :: internal functions; mostly operating on [e=@s a=@u], in other words
- :: positive numbers. many of these error out if a=0.
- |%
- ++ rou
- |= [a=[e=@s a=@u]] ^- fn (rau a &)
- ::
- ++ rau
- |= [a=[e=@s a=@u] t=?] ^- fn
- ?- r
- %z (lug %fl a t) %d (lug %fl a t)
- %a (lug %ce a t) %u (lug %ce a t)
- %n (lug %ne a t)
- ==
- ::
- ++ add :: add; exact if e
- |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
- =+ q=(dif:si e.a e.b)
- |- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp
- ?: e
- [%f & e.b (^add (lsh [0 (abs:si q)] a.a) a.b)]
- =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
- =+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a
- ?: (gth prc ma) (^sub prc ma) 0
- =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b
- ?: =((cmp:si w x) --1) :: don't need to add
- ?- r
- %z (lug %fl a &) %d (lug %fl a &)
- %a (lug %lg a &) %u (lug %lg a &)
- %n (lug %na a &)
- ==
- (rou [e.b (^add (lsh [0 (abs:si q)] a.a) a.b)])
- ::
- ++ sub :: subtract; exact if e
- |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
- =+ q=(dif:si e.a e.b)
- |- ?. (syn:si q)
- (fli $(b a, a b, q +(q), r swr))
- =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
- =+ ^= w %+ dif:si e.a %- sun:si
- ?: (gth prc ma) (^sub prc ma) 0
- =+ ^= x %+ sum:si e.b (sun:si +(mb))
- ?: &(!e =((cmp:si w x) --1))
- ?- r
- %z (lug %sm a &) %d (lug %sm a &)
- %a (lug %ce a &) %u (lug %ce a &)
- %n (lug %nt a &)
- ==
- =+ j=(lsh [0 (abs:si q)] a.a)
- |- ?. (gte j a.b)
- (fli $(a.b j, j a.b, r swr))
- =+ i=(^sub j a.b)
- ?~ i [%f & zer]
- ?: e [%f & e.b i] (rou [e.b i])
- ::
- ++ mul :: multiply
- |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
- (rou (sum:si e.a e.b) (^mul a.a a.b))
- ::
- ++ div :: divide
- |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
- =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
- =+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc))))
- =. a ?: (syn:si v) a
- a(e (sum:si v e.a), a (lsh [0 (abs:si v)] a.a))
- =+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)]
- (rau [j p.q] =(q.q 0))
- ::
- ++ sqt :: square root
- |= [a=[e=@s a=@u]] ^- fn
- =. a
- =+ [w=(met 0 a.a) x=(^mul +(prc) 2)]
- =+ ?:((^lth w x) (^sub x w) 0)
- =+ ?: =((dis - 1) (dis (abs:si e.a) 1)) -
- (^add - 1)
- a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
- =+ [y=(^sqt a.a) z=(fra:si e.a --2)]
- (rau [z p.y] =(q.y 0))
- ::
- ++ lth :: less-than
- |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
- ?: =(e.a e.b) (^lth a.a a.b)
- =+ c=(cmp:si (ibl a) (ibl b))
- ?: =(c -1) & ?: =(c --1) |
- ?: =((cmp:si e.a e.b) -1)
- (^lth (rsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
- (^lth (lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
- ::
- ++ equ :: equals
- |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
- ?. =((ibl a) (ibl b)) |
- ?: =((cmp:si e.a e.b) -1)
- =((lsh [0 (abs:si (dif:si e.a e.b))] a.b) a.a)
- =((lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
- ::
- :: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1)
- ++ ibl
- |= [a=[e=@s a=@u]] ^- @s
- (sum:si (sun:si (dec (met 0 a.a))) e.a)
- ::
- :: +uni
- ::
- :: change to a representation where a.a is odd
- :: every fn has a unique representation of this kind
- ++ uni
- |= [a=[e=@s a=@u]]
- |- ?: =((end 0 a.a) 1) a
- $(a.a (rsh 0 a.a), e.a (sum:si e.a --1))
- ::
- :: +xpd: expands to either full precision or to denormalized
- ++ xpd
- |= [a=[e=@s a=@u]]
- =+ ma=(met 0 a.a)
- ?: (gte ma prc) a
- =+ ?: =(den %i) (^sub prc ma)
- =+ ^= q
- =+ w=(dif:si e.a emn)
- ?: (syn:si w) (abs:si w) 0
- (min q (^sub prc ma))
- a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
- ::
- :: +lug: central rounding mechanism
- ::
- :: can perform: floor, ceiling, smaller, larger,
- :: nearest (round ties to: even, away from 0, toward 0)
- :: s is sticky bit: represents a value less than ulp(a) = 2^(e.a)
- ::
- ++ lug
- ~/ %lug
- |= [t=$?(%fl %ce %sm %lg %ne %na %nt) a=[e=@s a=@u] s=?] ^- fn
- ?< =(a.a 0)
- =-
- ?. =(den %f) - :: flush denormals
- ?. ?=([%f *] -) -
- ?: =((met 0 ->+>) prc) - [%f & zer]
- ::
- =+ m=(met 0 a.a)
- ?> |(s (gth m prc)) :: require precision
- =+ ^= q %+ max
- ?: (gth m prc) (^sub m prc) 0 :: reduce precision
- %- abs:si ?: =(den %i) --0 :: enforce min. exp
- ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0
- =^ b a :- (end [0 q] a.a)
- a(e (sum:si e.a (sun:si q)), a (rsh [0 q] a.a))
- ::
- ?~ a.a
- ?< =(den %i)
- ?- t
- %fl [%f & zer]
- %sm [%f & zer]
- %ce [%f & spd]
- %lg [%f & spd]
- %ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
- [%f & ?:((^lth b (bex (dec q))) zer spd)]
- %nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
- [%f & ?:((^lth b (bex (dec q))) zer spd)]
- %na [%f & ?:((^lth b (bex (dec q))) zer spd)]
- ==
- ::
- =. a (xpd a)
- ::
- =. a
- ?- t
- %fl a
- %lg a(a +(a.a))
- %sm ?. &(=(b 0) s) a
- ?: &(=(e.a emn) !=(den %i)) a(a (dec a.a))
- =+ y=(dec (^mul a.a 2))
- ?. (lte (met 0 y) prc) a(a (dec a.a))
- [(dif:si e.a --1) y]
- %ce ?: &(=(b 0) s) a a(a +(a.a))
- %ne ?~ b a
- =+ y=(bex (dec q))
- ?: &(=(b y) s) :: round halfs to even
- ?~ (dis a.a 1) a a(a +(a.a))
- ?: (^lth b y) a a(a +(a.a))
- %na ?~ b a
- =+ y=(bex (dec q))
- ?: (^lth b y) a a(a +(a.a))
- %nt ?~ b a
- =+ y=(bex (dec q))
- ?: =(b y) ?: s a a(a +(a.a))
- ?: (^lth b y) a a(a +(a.a))
- ==
- ::
- =. a ?. =((met 0 a.a) +(prc)) a
- a(a (rsh 0 a.a), e (sum:si e.a --1))
- ?~ a.a [%f & zer]
- ::
- ?: =(den %i) [%f & a]
- ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp
- ::
- ++ drg :: dragon4; get
- ~/ %drg :: printable decimal;
- |= [a=[e=@s a=@u]] ^- [@s @u] :: guaranteed accurate
- ?< =(a.a 0) :: for rounded floats
- =. a (xpd a)
- =+ r=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] a.a)
- =+ s=(lsh [0 ?.((syn:si e.a) (abs:si e.a) 0)] 1)
- =+ mn=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] 1)
- =+ mp=mn
- => ?.
- ?& =(a.a (bex (dec prc))) :: if next smallest
- |(!=(e.a emn) =(den %i)) :: float is half ULP,
- == :: tighten lower bound
- .
- %= .
- mp (lsh 0 mp)
- r (lsh 0 r)
- s (lsh 0 s)
- ==
- =+ [k=--0 q=(^div (^add s 9) 10)]
- |- ?: (^lth r q)
- %= $
- k (dif:si k --1)
- r (^mul r 10)
- mn (^mul mn 10)
- mp (^mul mp 10)
- ==
- |- ?: (gte (^add (^mul r 2) mp) (^mul s 2))
- $(s (^mul s 10), k (sum:si k --1))
- =+ [u=0 o=0]
- |- :: r/s+o = a*10^-k
- =+ v=(dvr (^mul r 10) s)
- => %= .
- k (dif:si k --1)
- u p.v
- r q.v
- mn (^mul mn 10)
- mp (^mul mp 10)
- ==
- =+ l=(^lth (^mul r 2) mn) :: in lower bound
- =+ ^= h :: in upper bound
- ?| (^lth (^mul s 2) mp)
- (gth (^mul r 2) (^sub (^mul s 2) mp))
- ==
- ?: &(!l !h)
- $(o (^add (^mul o 10) u))
- =+ q=&(h |(!l (gth (^mul r 2) s)))
- =. o (^add (^mul o 10) ?:(q +(u) u))
- [k o]
- ::
- ++ toj :: round to integer
- |= [a=[e=@s a=@u]] ^- fn
- ?. =((cmp:si e.a --0) -1) [%f & a]
- =+ x=(abs:si e.a)
- =+ y=(rsh [0 x] a.a)
- ?: |(=(r %d) =(r %z)) [%f & --0 y]
- =+ z=(end [0 x] a.a)
- ?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))]
- =+ i=(bex (dec x))
- ?: &(=(z i) =((dis y 1) 0)) [%f & --0 y]
- ?: (^lth z i) [%f & --0 y] [%f & --0 +(y)]
- ::
- ++ ned :: require ?=([%f *] a)
- |= [a=fn] ^- [%f s=? e=@s a=@u]
- ?: ?=([%f *] a) a
- ~_ leaf+"need-float"
- !!
- ::
- ++ shf :: a * 2^b; no rounding
- |= [a=fn b=@s]
- ?: |(?=([%n *] a) ?=([%i *] a)) a
- a(e (sum:si e.a b))
- ::
- ++ fli :: flip sign
- |= [a=fn] ^- fn
- ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a)
- ::
- ++ swr ?+(r r %d %u, %u %d) :: flipped rounding
- ++ prc ?>((gth p 1) p) :: force >= 2 precision
- ++ den d :: denorm+flush+inf exp
- ++ emn v :: minimum exponent
- ++ emx (sum:si emn (sun:si w)) :: maximum exponent
- ++ spd [e=emn a=1] :: smallest denormal
- ++ spn [e=emn a=(bex (dec prc))] :: smallest normal
- ++ lfn [e=emx a=(fil 0 prc 1)] :: largest
- ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all
- ++ zer [e=--0 a=0]
- --
- |%
- ++ rou :: round
- |= [a=fn] ^- fn
- ?. ?=([%f *] a) a
- ?~ a.a [%f s.a zer]
- ?: s.a (^rou +>.a)
- =.(r swr (fli (^rou +>.a)))
- ::
- ++ syn :: get sign
- |= [a=fn] ^- ?
- ?-(-.a %f s.a, %i s.a, %n &)
- ::
- ++ abs :: absolute value
- |= [a=fn] ^- fn
- ?: ?=([%f *] a) [%f & e.a a.a]
- ?: ?=([%i *] a) [%i &] [%n ~]
- ::
- ++ add :: add
- |= [a=fn b=fn] ^- fn
- ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
- ?: |(?=([%i *] a) ?=([%i *] b))
- ?: &(?=([%i *] a) ?=([%i *] b))
- ?: =(a b) a [%n ~]
- ?: ?=([%i *] a) a b
- ?: |(=(a.a 0) =(a.b 0))
- ?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a)
- [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
- %- |= [a=fn]
- ?. ?=([%f *] a) a
- ?. =(a.a 0) a
- [%f !=(r %d) zer]
- ?: =(s.a s.b)
- ?: s.a (^add +>.a +>.b |)
- =.(r swr (fli (^add +>.a +>.b |)))
- ?: s.a (^sub +>.a +>.b |)
- (^sub +>.b +>.a |)
- ::
- ++ ead :: exact add
- |= [a=fn b=fn] ^- fn
- ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
- ?: |(?=([%i *] a) ?=([%i *] b))
- ?: &(?=([%i *] a) ?=([%i *] b))
- ?: =(a b) a [%n ~]
- ?: ?=([%i *] a) a b
- ?: |(=(a.a 0) =(a.b 0))
- ?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a)
- [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
- %- |= [a=fn]
- ?. ?=([%f *] a) a
- ?. =(a.a 0) a
- [%f !=(r %d) zer]
- ?: =(s.a s.b)
- ?: s.a (^add +>.a +>.b &)
- (fli (^add +>.a +>.b &))
- ?: s.a (^sub +>.a +>.b &)
- (^sub +>.b +>.a &)
- ::
- ++ sub :: subtract
- |= [a=fn b=fn] ^- fn (add a (fli b))
- ::
- ++ mul :: multiply
- |= [a=fn b=fn] ^- fn
- ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
- ?: ?=([%i *] a)
- ?: ?=([%i *] b)
- [%i =(s.a s.b)]
- ?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
- ?: ?=([%i *] b)
- ?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
- ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
- ?: =(s.a s.b) (^mul +>.a +>.b)
- =.(r swr (fli (^mul +>.a +>.b)))
- ::
- ++ emu :: exact multiply
- |= [a=fn b=fn] ^- fn
- ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
- ?: ?=([%i *] a)
- ?: ?=([%i *] b)
- [%i =(s.a s.b)]
- ?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
- ?: ?=([%i *] b)
- ?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
- ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
- [%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)]
- ::
- ++ div :: divide
- |= [a=fn b=fn] ^- fn
- ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
- ?: ?=([%i *] a)
- ?: ?=([%i *] b) [%n ~] [%i =(s.a s.b)]
- ?: ?=([%i *] b) [%f =(s.a s.b) zer]
- ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer]
- ?: =(a.b 0) [%i =(s.a s.b)]
- ?: =(s.a s.b) (^div +>.a +>.b)
- =.(r swr (fli (^div +>.a +>.b)))
- ::
- ++ fma :: fused multiply-add
- |= [a=fn b=fn c=fn] ^- fn :: (a * b) + c
- (add (emu a b) c)
- ::
- ++ sqt :: square root
- |= [a=fn] ^- fn
- ?: ?=([%n *] a) [%n ~]
- ?: ?=([%i *] a) ?:(s.a a [%n ~])
- ?~ a.a [%f s.a zer]
- ?: s.a (^sqt +>.a) [%n ~]
- ::
- ++ inv :: inverse
- |= [a=fn] ^- fn
- (div [%f & --0 1] a)
- ::
- ++ sun :: uns integer to float
- |= [a=@u] ^- fn
- (rou [%f & --0 a])
- ::
- ++ san :: sgn integer to float
- |= [a=@s] ^- fn
- =+ b=(old:si a)
- (rou [%f -.b --0 +.b])
- ::
- ++ lth :: less-than
- :: comparisons return ~ in the event of a NaN
- |= [a=fn b=fn] ^- (unit ?)
- ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~
- ?: =(a b) |
- ?: ?=([%i *] a) !s.a ?: ?=([%i *] b) s.b
- ?: |(=(a.a 0) =(a.b 0))
- ?: &(=(a.a 0) =(a.b 0)) |
- ?: =(a.a 0) s.b !s.a
- ?: !=(s.a s.b) s.b
- ?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a)
- ::
- ++ lte :: less-equal
- |= [a=fn b=fn] ^- (unit ?)
- %+ bind (lth b a) |= a=? !a
- ::
- ++ equ :: equal
- |= [a=fn b=fn] ^- (unit ?)
- ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~
- ?: =(a b) &
- ?: |(?=([%i *] a) ?=([%i *] b)) |
- ?: |(=(a.a 0) =(a.b 0))
- ?: &(=(a.a 0) =(a.b 0)) & |
- ?: |(=(e.a e.b) !=(s.a s.b)) |
- (^equ +>.a +>.b)
- ::
- ++ gte :: greater-equal
- |= [a=fn b=fn] ^- (unit ?) (lte b a)
- ::
- ++ gth :: greater-than
- |= [a=fn b=fn] ^- (unit ?) (lth b a)
- ::
- ++ drg :: float to decimal
- |= [a=fn] ^- dn
- ?: ?=([%n *] a) [%n ~]
- ?: ?=([%i *] a) [%i s.a]
- ?~ a.a [%d s.a --0 0]
- [%d s.a (^drg +>.a)]
- ::
- ++ grd :: decimal to float
- |= [a=dn] ^- fn
- ?: ?=([%n *] a) [%n ~]
- ?: ?=([%i *] a) [%i s.a]
- => .(r %n)
- =+ q=(abs:si e.a)
- ?: (syn:si e.a)
- (mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)])
- (div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)])
- ::
- ++ toi :: round to integer @s
- |= [a=fn] ^- (unit @s)
- =+ b=(toj a)
- ?. ?=([%f *] b) ~ :- ~
- =+ c=(^^mul (bex (abs:si e.b)) a.b)
- (new:si s.b c)
- ::
- ++ toj :: round to integer fn
- |= [a=fn] ^- fn
- ?. ?=([%f *] a) a
- ?~ a.a [%f s.a zer]
- ?: s.a (^toj +>.a)
- =.(r swr (fli (^toj +>.a)))
- --
- :: +ff
- ::
- :: this core has no use outside of the functionality
- :: provided to ++rd, ++rs, ++rq, and ++rh
- ::
- :: w=width: bits in exponent field
- :: p=precision: bits in fraction field
- :: b=bias: added to exponent when storing
- :: r=rounding mode: same as in ++fl
- ++ ff :: ieee 754 format fp
- |_ [[w=@u p=@u b=@s] r=$?(%n %u %d %z %a)]
- ::
- ++ sb (bex (^add w p)) :: sign bit
- ++ me (dif:si (dif:si --1 b) (sun:si p)) :: minimum exponent
- ::
- ++ pa
- %*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r)
- ::
- ++ sea :: @r to fn
- |= [a=@r] ^- fn
- =+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)]
- =+ s=(sig a)
- ?: =(e 0)
- ?: =(f 0) [%f s --0 0] [%f s me f]
- ?: =(e (fil 0 w 1))
- ?: =(f 0) [%i s] [%n ~]
- =+ q=:(sum:si (sun:si e) me -1)
- =+ r=(^add f (bex p))
- [%f s q r]
- ::
- ++ bit |= [a=fn] (bif (rou:pa a)) :: fn to @r w+ rounding
- ::
- ++ bif :: fn to @r no rounding
- |= [a=fn] ^- @r
- ?: ?=([%i *] a)
- =+ q=(lsh [0 p] (fil 0 w 1))
- ?: s.a q (^add q sb)
- ?: ?=([%n *] a) (lsh [0 (dec p)] (fil 0 +(w) 1))
- ?~ a.a ?: s.a `@r`0 sb
- =+ ma=(met 0 a.a)
- ?. =(ma +(p))
- ?> =(e.a me)
- ?> (^lth ma +(p))
- ?: s.a `@r`a.a (^add a.a sb)
- =+ q=(sum:si (dif:si e.a me) --1)
- =+ r=(^add (lsh [0 p] (abs:si q)) (end [0 p] a.a))
- ?: s.a r (^add r sb)
- ::
- ++ sig :: get sign
- |= [a=@r] ^- ?
- =(0 (cut 0 [(^add p w) 1] a))
- ::
- ++ exp :: get exponent
- |= [a=@r] ^- @s
- (dif:si (sun:si (cut 0 [p w] a)) b)
- ::
- ++ add :: add
- |= [a=@r b=@r]
- (bif (add:pa (sea a) (sea b)))
- ::
- ++ sub :: subtract
- |= [a=@r b=@r]
- (bif (sub:pa (sea a) (sea b)))
- ::
- ++ mul :: multiply
- |= [a=@r b=@r]
- (bif (mul:pa (sea a) (sea b)))
- ::
- ++ div :: divide
- |= [a=@r b=@r]
- (bif (div:pa (sea a) (sea b)))
- ::
- ++ fma :: fused multiply-add
- |= [a=@r b=@r c=@r]
- (bif (fma:pa (sea a) (sea b) (sea c)))
- ::
- ++ sqt :: square root
- |= [a=@r]
- (bif (sqt:pa (sea a)))
- ::
- ++ lth :: less-than
- |= [a=@r b=@r] (fall (lth:pa (sea a) (sea b)) |)
- ++ lte :: less-equals
- |= [a=@r b=@r] (fall (lte:pa (sea a) (sea b)) |)
- ++ equ :: equals
- |= [a=@r b=@r] (fall (equ:pa (sea a) (sea b)) |)
- ++ gte :: greater-equals
- |= [a=@r b=@r] (fall (gte:pa (sea a) (sea b)) |)
- ++ gth :: greater-than
- |= [a=@r b=@r] (fall (gth:pa (sea a) (sea b)) |)
- ++ sun :: uns integer to @r
- |= [a=@u] (bit [%f & --0 a])
- ++ san :: signed integer to @r
- |= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)])
- ++ toi :: round to integer
- |= [a=@r] (toi:pa (sea a))
- ++ drg :: @r to decimal float
- |= [a=@r] (drg:pa (sea a))
- ++ grd :: decimal float to @r
- |= [a=dn] (bif (grd:pa a))
- --
- ::
- ++ rlyd |= a=@rd ^- dn (drg:rd a) :: prep @rd for print
- ++ rlys |= a=@rs ^- dn (drg:rs a) :: prep @rs for print
- ++ rlyh |= a=@rh ^- dn (drg:rh a) :: prep @rh for print
- ++ rlyq |= a=@rq ^- dn (drg:rq a) :: prep @rq for print
- ++ ryld |= a=dn ^- @rd (grd:rd a) :: finish parsing @rd
- ++ ryls |= a=dn ^- @rs (grd:rs a) :: finish parsing @rs
- ++ rylh |= a=dn ^- @rh (grd:rh a) :: finish parsing @rh
- ++ rylq |= a=dn ^- @rq (grd:rq a) :: finish parsing @rq
- ::
- ++ rd :: double precision fp
- ^|
- ~% %rd +> ~
- |_ r=$?(%n %u %d %z)
- :: round to nearest, round up, round down, round to zero
- ::
- ++ ma
- %*(. ff w 11, p 52, b --1.023, r r)
- ::
- ++ sea :: @rd to fn
- |= [a=@rd] (sea:ma a)
- ::
- ++ bit :: fn to @rd
- |= [a=fn] ^- @rd (bit:ma a)
- ::
- ++ add ~/ %add :: add
- |= [a=@rd b=@rd] ^- @rd
- ~_ leaf+"rd-fail"
- (add:ma a b)
- ::
- ++ sub ~/ %sub :: subtract
- |= [a=@rd b=@rd] ^- @rd
- ~_ leaf+"rd-fail"
- (sub:ma a b)
- ::
- ++ mul ~/ %mul :: multiply
- |= [a=@rd b=@rd] ^- @rd
- ~_ leaf+"rd-fail"
- (mul:ma a b)
- ::
- ++ div ~/ %div :: divide
- |= [a=@rd b=@rd] ^- @rd
- ~_ leaf+"rd-fail"
- (div:ma a b)
- ::
- ++ fma ~/ %fma :: fused multiply-add
- |= [a=@rd b=@rd c=@rd] ^- @rd
- ~_ leaf+"rd-fail"
- (fma:ma a b c)
- ::
- ++ sqt ~/ %sqt :: square root
- |= [a=@rd] ^- @rd ~_ leaf+"rd-fail"
- (sqt:ma a)
- ::
- ++ lth ~/ %lth :: less-than
- |= [a=@rd b=@rd]
- ~_ leaf+"rd-fail"
- (lth:ma a b)
- ::
- ++ lte ~/ %lte :: less-equals
- |= [a=@rd b=@rd]
- ~_ leaf+"rd-fail"
- (lte:ma a b)
- ::
- ++ equ ~/ %equ :: equals
- |= [a=@rd b=@rd]
- ~_ leaf+"rd-fail"
- (equ:ma a b)
- ::
- ++ gte ~/ %gte :: greater-equals
- |= [a=@rd b=@rd]
- ~_ leaf+"rd-fail"
- (gte:ma a b)
- ::
- ++ gth ~/ %gth :: greater-than
- |= [a=@rd b=@rd]
- ~_ leaf+"rd-fail"
- (gth:ma a b)
- ::
- ++ sun |= [a=@u] ^- @rd (sun:ma a) :: uns integer to @rd
- ++ san |= [a=@s] ^- @rd (san:ma a) :: sgn integer to @rd
- ++ sig |= [a=@rd] ^- ? (sig:ma a) :: get sign
- ++ exp |= [a=@rd] ^- @s (exp:ma a) :: get exponent
- ++ toi |= [a=@rd] ^- (unit @s) (toi:ma a) :: round to integer
- ++ drg |= [a=@rd] ^- dn (drg:ma a) :: @rd to decimal float
- ++ grd |= [a=dn] ^- @rd (grd:ma a) :: decimal float to @rd
- --
- ::
- ++ rs :: single precision fp
- ~% %rs +> ~
- ^|
- :: round to nearest, round up, round down, round to zero
- |_ r=$?(%n %u %d %z)
- ::
- ++ ma
- %*(. ff w 8, p 23, b --127, r r)
- ::
- ++ sea :: @rs to fn
- |= [a=@rs] (sea:ma a)
- ::
- ++ bit :: fn to @rs
- |= [a=fn] ^- @rs (bit:ma a)
- ::
- ++ add ~/ %add :: add
- |= [a=@rs b=@rs] ^- @rs
- ~_ leaf+"rs-fail"
- (add:ma a b)
- ::
- ++ sub ~/ %sub :: subtract
- |= [a=@rs b=@rs] ^- @rs
- ~_ leaf+"rs-fail"
- (sub:ma a b)
- ::
- ++ mul ~/ %mul :: multiply
- |= [a=@rs b=@rs] ^- @rs
- ~_ leaf+"rs-fail"
- (mul:ma a b)
- ::
- ++ div ~/ %div :: divide
- |= [a=@rs b=@rs] ^- @rs
- ~_ leaf+"rs-fail"
- (div:ma a b)
- ::
- ++ fma ~/ %fma :: fused multiply-add
- |= [a=@rs b=@rs c=@rs] ^- @rs
- ~_ leaf+"rs-fail"
- (fma:ma a b c)
- ::
- ++ sqt ~/ %sqt :: square root
- |= [a=@rs] ^- @rs
- ~_ leaf+"rs-fail"
- (sqt:ma a)
- ::
- ++ lth ~/ %lth :: less-than
- |= [a=@rs b=@rs]
- ~_ leaf+"rs-fail"
- (lth:ma a b)
- ::
- ++ lte ~/ %lte :: less-equals
- |= [a=@rs b=@rs]
- ~_ leaf+"rs-fail"
- (lte:ma a b)
- ::
- ++ equ ~/ %equ :: equals
- |= [a=@rs b=@rs]
- ~_ leaf+"rs-fail"
- (equ:ma a b)
- ::
- ++ gte ~/ %gte :: greater-equals
- |= [a=@rs b=@rs]
- ~_ leaf+"rs-fail"
- (gte:ma a b)
- ::
- ++ gth ~/ %gth :: greater-than
- |= [a=@rs b=@rs]
- ~_ leaf+"rs-fail"
- (gth:ma a b)
- ::
- ++ sun |= [a=@u] ^- @rs (sun:ma a) :: uns integer to @rs
- ++ san |= [a=@s] ^- @rs (san:ma a) :: sgn integer to @rs
- ++ sig |= [a=@rs] ^- ? (sig:ma a) :: get sign
- ++ exp |= [a=@rs] ^- @s (exp:ma a) :: get exponent
- ++ toi |= [a=@rs] ^- (unit @s) (toi:ma a) :: round to integer
- ++ drg |= [a=@rs] ^- dn (drg:ma a) :: @rs to decimal float
- ++ grd |= [a=dn] ^- @rs (grd:ma a) :: decimal float to @rs
- --
- ::
- ++ rq :: quad precision fp
- ~% %rq +> ~
- ^|
- :: round to nearest, round up, round down, round to zero
- |_ r=$?(%n %u %d %z)
- ::
- ++ ma
- %*(. ff w 15, p 112, b --16.383, r r)
- ::
- ++ sea :: @rq to fn
- |= [a=@rq] (sea:ma a)
- ::
- ++ bit :: fn to @rq
- |= [a=fn] ^- @rq (bit:ma a)
- ::
- ++ add ~/ %add :: add
- |= [a=@rq b=@rq] ^- @rq
- ~_ leaf+"rq-fail"
- (add:ma a b)
- ::
- ++ sub ~/ %sub :: subtract
- |= [a=@rq b=@rq] ^- @rq
- ~_ leaf+"rq-fail"
- (sub:ma a b)
- ::
- ++ mul ~/ %mul :: multiply
- |= [a=@rq b=@rq] ^- @rq
- ~_ leaf+"rq-fail"
- (mul:ma a b)
- ::
- ++ div ~/ %div :: divide
- |= [a=@rq b=@rq] ^- @rq
- ~_ leaf+"rq-fail"
- (div:ma a b)
- ::
- ++ fma ~/ %fma :: fused multiply-add
- |= [a=@rq b=@rq c=@rq] ^- @rq
- ~_ leaf+"rq-fail"
- (fma:ma a b c)
- ::
- ++ sqt ~/ %sqt :: square root
- |= [a=@rq] ^- @rq
- ~_ leaf+"rq-fail"
- (sqt:ma a)
- ::
- ++ lth ~/ %lth :: less-than
- |= [a=@rq b=@rq]
- ~_ leaf+"rq-fail"
- (lth:ma a b)
- ::
- ++ lte ~/ %lte :: less-equals
- |= [a=@rq b=@rq]
- ~_ leaf+"rq-fail"
- (lte:ma a b)
- ::
- ++ equ ~/ %equ :: equals
- |= [a=@rq b=@rq]
- ~_ leaf+"rq-fail"
- (equ:ma a b)
- ::
- ++ gte ~/ %gte :: greater-equals
- |= [a=@rq b=@rq]
- ~_ leaf+"rq-fail"
- (gte:ma a b)
- ::
- ++ gth ~/ %gth :: greater-than
- |= [a=@rq b=@rq]
- ~_ leaf+"rq-fail"
- (gth:ma a b)
- ::
- ++ sun |= [a=@u] ^- @rq (sun:ma a) :: uns integer to @rq
- ++ san |= [a=@s] ^- @rq (san:ma a) :: sgn integer to @rq
- ++ sig |= [a=@rq] ^- ? (sig:ma a) :: get sign
- ++ exp |= [a=@rq] ^- @s (exp:ma a) :: get exponent
- ++ toi |= [a=@rq] ^- (unit @s) (toi:ma a) :: round to integer
- ++ drg |= [a=@rq] ^- dn (drg:ma a) :: @rq to decimal float
- ++ grd |= [a=dn] ^- @rq (grd:ma a) :: decimal float to @rq
- --
- ::
- ++ rh :: half precision fp
- ~% %rh +> ~
- ^|
- :: round to nearest, round up, round down, round to zero
- |_ r=$?(%n %u %d %z)
- ::
- ++ ma
- %*(. ff w 5, p 10, b --15, r r)
- ::
- ++ sea :: @rh to fn
- |= [a=@rh] (sea:ma a)
- ::
- ++ bit :: fn to @rh
- |= [a=fn] ^- @rh (bit:ma a)
- ::
- ++ add ~/ %add :: add
- |= [a=@rh b=@rh] ^- @rh
- ~_ leaf+"rh-fail"
- (add:ma a b)
- ::
- ++ sub ~/ %sub :: subtract
- |= [a=@rh b=@rh] ^- @rh
- ~_ leaf+"rh-fail"
- (sub:ma a b)
- ::
- ++ mul ~/ %mul :: multiply
- |= [a=@rh b=@rh] ^- @rh
- ~_ leaf+"rh-fail"
- (mul:ma a b)
- ::
- ++ div ~/ %div :: divide
- |= [a=@rh b=@rh] ^- @rh
- ~_ leaf+"rh-fail"
- (div:ma a b)
- ::
- ++ fma ~/ %fma :: fused multiply-add
- |= [a=@rh b=@rh c=@rh] ^- @rh
- ~_ leaf+"rh-fail"
- (fma:ma a b c)
- ::
- ++ sqt ~/ %sqt :: square root
- |= [a=@rh] ^- @rh
- ~_ leaf+"rh-fail"
- (sqt:ma a)
- ::
- ++ lth ~/ %lth :: less-than
- |= [a=@rh b=@rh]
- ~_ leaf+"rh-fail"
- (lth:ma a b)
- ::
- ++ lte ~/ %lte :: less-equals
- |= [a=@rh b=@rh]
- ~_ leaf+"rh-fail"
- (lte:ma a b)
- ::
- ++ equ ~/ %equ :: equals
- |= [a=@rh b=@rh]
- ~_ leaf+"rh-fail"
- (equ:ma a b)
- ::
- ++ gte ~/ %gte :: greater-equals
- |= [a=@rh b=@rh]
- ~_ leaf+"rh-fail"
- (gte:ma a b)
- ::
- ++ gth ~/ %gth :: greater-than
- |= [a=@rh b=@rh]
- ~_ leaf+"rh-fail"
- (gth:ma a b)
- ::
- ++ tos :: @rh to @rs
- |= [a=@rh] (bit:rs (sea a))
- ::
- ++ fos :: @rs to @rh
- |= [a=@rs] (bit (sea:rs a))
- ::
- ++ sun |= [a=@u] ^- @rh (sun:ma a) :: uns integer to @rh
- ++ san |= [a=@s] ^- @rh (san:ma a) :: sgn integer to @rh
- ++ sig |= [a=@rh] ^- ? (sig:ma a) :: get sign
- ++ exp |= [a=@rh] ^- @s (exp:ma a) :: get exponent
- ++ toi |= [a=@rh] ^- (unit @s) (toi:ma a) :: round to integer
- ++ drg |= [a=@rh] ^- dn (drg:ma a) :: @rh to decimal float
- ++ grd |= [a=dn] ^- @rh (grd:ma a) :: decimal float to @rh
- --
- ::
- :: 3c: urbit time
- +| %urbit-time
- ::
- ++ year :: date to @d
- |= det=date
- ^- @da
- =+ ^= yer
- ?: a.det
- (add 292.277.024.400 y.det)
- (sub 292.277.024.400 (dec y.det))
- =+ day=(yawn yer m.det d.t.det)
- (yule day h.t.det m.t.det s.t.det f.t.det)
- ::
- ++ yore :: @d to date
- |= now=@da
- ^- date
- =+ rip=(yell now)
- =+ ger=(yall d.rip)
- :- ?: (gth y.ger 292.277.024.400)
- [a=& y=(sub y.ger 292.277.024.400)]
- [a=| y=+((sub 292.277.024.400 y.ger))]
- [m.ger d.ger h.rip m.rip s.rip f.rip]
- ::
- ++ yell :: tarp from @d
- |= now=@d
- ^- tarp
- =+ sec=(rsh 6 now)
- =+ ^= fan
- =+ [muc=4 raw=(end 6 now)]
- |- ^- (list @ux)
- ?: |(=(0 raw) =(0 muc))
- ~
- => .(muc (dec muc))
- [(cut 4 [muc 1] raw) $(raw (end [4 muc] raw))]
- =+ day=(div sec day:yo)
- => .(sec (mod sec day:yo))
- =+ hor=(div sec hor:yo)
- => .(sec (mod sec hor:yo))
- =+ mit=(div sec mit:yo)
- => .(sec (mod sec mit:yo))
- [day hor mit sec fan]
- ::
- ++ yule :: time atom
- |= rip=tarp
- ^- @d
- =+ ^= sec ;: add
- (mul d.rip day:yo)
- (mul h.rip hor:yo)
- (mul m.rip mit:yo)
- s.rip
- ==
- =+ ^= fac =+ muc=4
- |- ^- @
- ?~ f.rip
- 0
- => .(muc (dec muc))
- (add (lsh [4 muc] i.f.rip) $(f.rip t.f.rip))
- (con (lsh 6 sec) fac)
- ::
- ++ yall :: day / to day of year
- |= day=@ud
- ^- [y=@ud m=@ud d=@ud]
- =+ [era=0 cet=0 lep=*?]
- => .(era (div day era:yo), day (mod day era:yo))
- => ^+ .
- ?: (lth day +(cet:yo))
- .(lep &, cet 0)
- => .(lep |, cet 1, day (sub day +(cet:yo)))
- .(cet (add cet (div day cet:yo)), day (mod day cet:yo))
- =+ yer=(add (mul 400 era) (mul 100 cet))
- |- ^- [y=@ud m=@ud d=@ud]
- =+ dis=?:(lep 366 365)
- ?. (lth day dis)
- =+ ner=+(yer)
- $(yer ner, day (sub day dis), lep =(0 (end [0 2] ner)))
- |- ^- [y=@ud m=@ud d=@ud]
- =+ [mot=0 cah=?:(lep moy:yo moh:yo)]
- |- ^- [y=@ud m=@ud d=@ud]
- =+ zis=(snag mot cah)
- ?: (lth day zis)
- [yer +(mot) +(day)]
- $(mot +(mot), day (sub day zis))
- ::
- ++ yawn :: days since Jesus
- |= [yer=@ud mot=@ud day=@ud]
- ^- @ud
- => .(mot (dec mot), day (dec day))
- => ^+ .
- %= .
- day
- =+ cah=?:((yelp yer) moy:yo moh:yo)
- |- ^- @ud
- ?: =(0 mot)
- day
- $(mot (dec mot), cah (slag 1 cah), day (add day (snag 0 cah)))
- ==
- |- ^- @ud
- ?. =(0 (mod yer 4))
- =+ ney=(dec yer)
- $(yer ney, day (add day ?:((yelp ney) 366 365)))
- ?. =(0 (mod yer 100))
- =+ nef=(sub yer 4)
- $(yer nef, day (add day ?:((yelp nef) 1.461 1.460)))
- ?. =(0 (mod yer 400))
- =+ nec=(sub yer 100)
- $(yer nec, day (add day ?:((yelp nec) 36.525 36.524)))
- (add day (mul (div yer 400) (add 1 (mul 4 36.524))))
- ::
- ++ yelp :: leap year
- |= yer=@ud ^- ?
- &(=(0 (mod yer 4)) |(!=(0 (mod yer 100)) =(0 (mod yer 400))))
- ::
- ++ yo :: time constants
- |% ++ cet 36.524 :: (add 24 (mul 100 365))
- ++ day 86.400 :: (mul 24 hor)
- ++ era 146.097 :: (add 1 (mul 4 cet))
- ++ hor 3.600 :: (mul 60 mit)
- ++ jes 106.751.991.084.417 :: (mul 730.692.561 era)
- ++ mit 60
- ++ moh `(list @ud)`[31 28 31 30 31 30 31 31 30 31 30 31 ~]
- ++ moy `(list @ud)`[31 29 31 30 31 30 31 31 30 31 30 31 ~]
- ++ qad 126.144.001 :: (add 1 (mul 4 yer))
- ++ yer 31.536.000 :: (mul 365 day)
- --
- ::
- :: 3d: SHA hash family
- +| %sha-hash-family
- ::
- ++ shad |=(ruz=@ (shax (shax ruz))) :: double sha-256
- ++ shaf :: half sha-256
- |= [sal=@ ruz=@]
- =+ haz=(shas sal ruz)
- (mix (end 7 haz) (rsh 7 haz))
- ::
- ++ sham :: 128bit noun hash
- |= yux=* ^- @uvH ^- @
- ?@ yux
- (shaf %mash yux)
- (shaf %sham (jam yux))
- ::
- ++ shas :: salted hash
- ~/ %shas
- |= [sal=@ ruz=@]
- =/ len (max 32 (met 3 sal))
- (shay len (mix sal (shax ruz)))
- ::
- ++ shax :: sha-256
- ~/ %shax
- |= ruz=@ ^- @
- (shay [(met 3 ruz) ruz])
- ::
- ++ shay :: sha-256 with length
- ~/ %shay
- |= [len=@u ruz=@] ^- @
- => .(ruz (cut 3 [0 len] ruz))
- =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
- =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
- =+ ral=(lsh [0 3] len)
- =+ ^= ful
- %+ can 0
- :~ [ral ruz]
- [8 128]
- [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
- [64 (~(net fe 6) ral)]
- ==
- =+ lex=(met 9 ful)
- =+ ^= kbx 0xc671.78f2.bef9.a3f7.a450.6ceb.90be.fffa.
- 8cc7.0208.84c8.7814.78a5.636f.748f.82ee.
- 682e.6ff3.5b9c.ca4f.4ed8.aa4a.391c.0cb3.
- 34b0.bcb5.2748.774c.1e37.6c08.19a4.c116.
- 106a.a070.f40e.3585.d699.0624.d192.e819.
- c76c.51a3.c24b.8b70.a81a.664b.a2bf.e8a1.
- 9272.2c85.81c2.c92e.766a.0abb.650a.7354.
- 5338.0d13.4d2c.6dfc.2e1b.2138.27b7.0a85.
- 1429.2967.06ca.6351.d5a7.9147.c6e0.0bf3.
- bf59.7fc7.b003.27c8.a831.c66d.983e.5152.
- 76f9.88da.5cb0.a9dc.4a74.84aa.2de9.2c6f.
- 240c.a1cc.0fc1.9dc6.efbe.4786.e49b.69c1.
- c19b.f174.9bdc.06a7.80de.b1fe.72be.5d74.
- 550c.7dc3.2431.85be.1283.5b01.d807.aa98.
- ab1c.5ed5.923f.82a4.59f1.11f1.3956.c25b.
- e9b5.dba5.b5c0.fbcf.7137.4491.428a.2f98
- =+ ^= hax 0x5be0.cd19.1f83.d9ab.9b05.688c.510e.527f.
- a54f.f53a.3c6e.f372.bb67.ae85.6a09.e667
- =+ i=0
- |- ^- @
- ?: =(i lex)
- (run 5 hax net)
- =+ ^= wox
- =+ dux=(cut 9 [i 1] ful)
- =+ wox=(run 5 dux net)
- =+ j=16
- |- ^- @
- ?: =(64 j)
- wox
- =+ :* l=(wac (sub j 15) wox)
- m=(wac (sub j 2) wox)
- n=(wac (sub j 16) wox)
- o=(wac (sub j 7) wox)
- ==
- =+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh [0 3] l))
- =+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh [0 10] m))
- =+ z=:(sum n x o y)
- $(wox (con (lsh [5 j] z) wox), j +(j))
- =+ j=0
- =+ :* a=(wac 0 hax)
- b=(wac 1 hax)
- c=(wac 2 hax)
- d=(wac 3 hax)
- e=(wac 4 hax)
- f=(wac 5 hax)
- g=(wac 6 hax)
- h=(wac 7 hax)
- ==
- |- ^- @
- ?: =(64 j)
- %= ^$
- i +(i)
- hax %+ rep 5
- :~ (sum a (wac 0 hax))
- (sum b (wac 1 hax))
- (sum c (wac 2 hax))
- (sum d (wac 3 hax))
- (sum e (wac 4 hax))
- (sum f (wac 5 hax))
- (sum g (wac 6 hax))
- (sum h (wac 7 hax))
- ==
- ==
- =+ l=:(mix (ror 0 2 a) (ror 0 13 a) (ror 0 22 a)) :: s0
- =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
- =+ n=(sum l m) :: t2
- =+ o=:(mix (ror 0 6 e) (ror 0 11 e) (ror 0 25 e)) :: s1
- =+ p=(mix (dis e f) (dis (inv e) g)) :: ch
- =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
- $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
- ::
- ++ shaw :: hash to nbits
- |= [sal=@ len=@ ruz=@]
- (~(raw og (shas sal (mix len ruz))) len)
- ::
- ++ shaz :: sha-512
- |= ruz=@ ^- @
- (shal [(met 3 ruz) ruz])
- ::
- ++ shal :: sha-512 with length
- ~/ %shal
- |= [len=@ ruz=@] ^- @
- => .(ruz (cut 3 [0 len] ruz))
- =+ [few==>(fe .(a 6)) wac=|=([a=@ b=@] (cut 6 [a 1] b))]
- =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
- =+ ral=(lsh [0 3] len)
- =+ ^= ful
- %+ can 0
- :~ [ral ruz]
- [8 128]
- [(mod (sub 1.920 (mod (add 8 ral) 1.024)) 1.024) 0]
- [128 (~(net fe 7) ral)]
- ==
- =+ lex=(met 10 ful)
- =+ ^= kbx 0x6c44.198c.4a47.5817.5fcb.6fab.3ad6.faec.
- 597f.299c.fc65.7e2a.4cc5.d4be.cb3e.42b6.
- 431d.67c4.9c10.0d4c.3c9e.be0a.15c9.bebc.
- 32ca.ab7b.40c7.2493.28db.77f5.2304.7d84.
- 1b71.0b35.131c.471b.113f.9804.bef9.0dae.
- 0a63.7dc5.a2c8.98a6.06f0.67aa.7217.6fba.
- f57d.4f7f.ee6e.d178.eada.7dd6.cde0.eb1e.
- d186.b8c7.21c0.c207.ca27.3ece.ea26.619c.
- c671.78f2.e372.532b.bef9.a3f7.b2c6.7915.
- a450.6ceb.de82.bde9.90be.fffa.2363.1e28.
- 8cc7.0208.1a64.39ec.84c8.7814.a1f0.ab72.
- 78a5.636f.4317.2f60.748f.82ee.5def.b2fc.
- 682e.6ff3.d6b2.b8a3.5b9c.ca4f.7763.e373.
- 4ed8.aa4a.e341.8acb.391c.0cb3.c5c9.5a63.
- 34b0.bcb5.e19b.48a8.2748.774c.df8e.eb99.
- 1e37.6c08.5141.ab53.19a4.c116.b8d2.d0c8.
- 106a.a070.32bb.d1b8.f40e.3585.5771.202a.
- d699.0624.5565.a910.d192.e819.d6ef.5218.
- c76c.51a3.0654.be30.c24b.8b70.d0f8.9791.
- a81a.664b.bc42.3001.a2bf.e8a1.4cf1.0364.
- 9272.2c85.1482.353b.81c2.c92e.47ed.aee6.
- 766a.0abb.3c77.b2a8.650a.7354.8baf.63de.
- 5338.0d13.9d95.b3df.4d2c.6dfc.5ac4.2aed.
- 2e1b.2138.5c26.c926.27b7.0a85.46d2.2ffc.
- 1429.2967.0a0e.6e70.06ca.6351.e003.826f.
- d5a7.9147.930a.a725.c6e0.0bf3.3da8.8fc2.
- bf59.7fc7.beef.0ee4.b003.27c8.98fb.213f.
- a831.c66d.2db4.3210.983e.5152.ee66.dfab.
- 76f9.88da.8311.53b5.5cb0.a9dc.bd41.fbd4.
- 4a74.84aa.6ea6.e483.2de9.2c6f.592b.0275.
- 240c.a1cc.77ac.9c65.0fc1.9dc6.8b8c.d5b5.
- efbe.4786.384f.25e3.e49b.69c1.9ef1.4ad2.
- c19b.f174.cf69.2694.9bdc.06a7.25c7.1235.
- 80de.b1fe.3b16.96b1.72be.5d74.f27b.896f.
- 550c.7dc3.d5ff.b4e2.2431.85be.4ee4.b28c.
- 1283.5b01.4570.6fbe.d807.aa98.a303.0242.
- ab1c.5ed5.da6d.8118.923f.82a4.af19.4f9b.
- 59f1.11f1.b605.d019.3956.c25b.f348.b538.
- e9b5.dba5.8189.dbbc.b5c0.fbcf.ec4d.3b2f.
- 7137.4491.23ef.65cd.428a.2f98.d728.ae22
- =+ ^= hax 0x5be0.cd19.137e.2179.1f83.d9ab.fb41.bd6b.
- 9b05.688c.2b3e.6c1f.510e.527f.ade6.82d1.
- a54f.f53a.5f1d.36f1.3c6e.f372.fe94.f82b.
- bb67.ae85.84ca.a73b.6a09.e667.f3bc.c908
- =+ i=0
- |- ^- @
- ?: =(i lex)
- (run 6 hax net)
- =+ ^= wox
- =+ dux=(cut 10 [i 1] ful)
- =+ wox=(run 6 dux net)
- =+ j=16
- |- ^- @
- ?: =(80 j)
- wox
- =+ :* l=(wac (sub j 15) wox)
- m=(wac (sub j 2) wox)
- n=(wac (sub j 16) wox)
- o=(wac (sub j 7) wox)
- ==
- =+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh [0 7] l))
- =+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh [0 6] m))
- =+ z=:(sum n x o y)
- $(wox (con (lsh [6 j] z) wox), j +(j))
- =+ j=0
- =+ :* a=(wac 0 hax)
- b=(wac 1 hax)
- c=(wac 2 hax)
- d=(wac 3 hax)
- e=(wac 4 hax)
- f=(wac 5 hax)
- g=(wac 6 hax)
- h=(wac 7 hax)
- ==
- |- ^- @
- ?: =(80 j)
- %= ^$
- i +(i)
- hax %+ rep 6
- :~ (sum a (wac 0 hax))
- (sum b (wac 1 hax))
- (sum c (wac 2 hax))
- (sum d (wac 3 hax))
- (sum e (wac 4 hax))
- (sum f (wac 5 hax))
- (sum g (wac 6 hax))
- (sum h (wac 7 hax))
- ==
- ==
- =+ l=:(mix (ror 0 28 a) (ror 0 34 a) (ror 0 39 a)) :: S0
- =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
- =+ n=(sum l m) :: t2
- =+ o=:(mix (ror 0 14 e) (ror 0 18 e) (ror 0 41 e)) :: S1
- =+ p=(mix (dis e f) (dis (inv e) g)) :: ch
- =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
- $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
- ::
- ++ shan :: sha-1 (deprecated)
- |= ruz=@
- =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
- =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
- =+ ral=(lsh [0 3] (met 3 ruz))
- =+ ^= ful
- %+ can 0
- :~ [ral ruz]
- [8 128]
- [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
- [64 (~(net fe 6) ral)]
- ==
- =+ lex=(met 9 ful)
- =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
- =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
- =+ i=0
- |-
- ?: =(i lex)
- (rep 5 (flop (rip 5 hax)))
- =+ ^= wox
- =+ dux=(cut 9 [i 1] ful)
- =+ wox=(rep 5 (turn (rip 5 dux) net))
- =+ j=16
- |- ^- @
- ?: =(80 j)
- wox
- =+ :* l=(wac (sub j 3) wox)
- m=(wac (sub j 8) wox)
- n=(wac (sub j 14) wox)
- o=(wac (sub j 16) wox)
- ==
- =+ z=(rol 0 1 :(mix l m n o))
- $(wox (con (lsh [5 j] z) wox), j +(j))
- =+ j=0
- =+ :* a=(wac 0 hax)
- b=(wac 1 hax)
- c=(wac 2 hax)
- d=(wac 3 hax)
- e=(wac 4 hax)
- ==
- |- ^- @
- ?: =(80 j)
- %= ^$
- i +(i)
- hax %+ rep 5
- :~
- (sum a (wac 0 hax))
- (sum b (wac 1 hax))
- (sum c (wac 2 hax))
- (sum d (wac 3 hax))
- (sum e (wac 4 hax))
- ==
- ==
- =+ fx=(con (dis b c) (dis (not 5 1 b) d))
- =+ fy=:(mix b c d)
- =+ fz=:(con (dis b c) (dis b d) (dis c d))
- =+ ^= tem
- ?: &((gte j 0) (lte j 19))
- :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
- ?: &((gte j 20) (lte j 39))
- :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
- ?: &((gte j 40) (lte j 59))
- :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
- :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
- $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
- ::
- :: NEVER USE: broken piece of trash
- ++ og :: shax-powered rng
- |_ a=@
- ++ rad :: random in range
- |= b=@ ^- @
- !!
- ::
- ++ rads :: random continuation
- |= b=@
- !!
- ::
- ++ raw :: random bits
- |= b=@ ^- @
- !!
- ::
- ++ raws :: random bits
- |= b=@ :: continuation
- !!
- --
- ::
- ++ sha :: correct byte-order
- ~% %sha ..sha ~
- => |%
- ++ flin |=(a=@ (swp 3 a)) :: flip input
- ++ flim |=(byts [wid (rev 3 wid dat)]) :: flip input w= length
- ++ flip |=(w=@u (cury (cury rev 3) w)) :: flip output of size
- ++ meet |=(a=@ [(met 3 a) a]) :: measure input size
- --
- |%
- ::
- :: use with @
- ::
- ++ sha-1 (cork meet sha-1l)
- ++ sha-256 :(cork flin shax (flip 32))
- ++ sha-512 :(cork flin shaz (flip 64))
- ::
- :: use with byts
- ::
- ++ sha-256l :(cork flim shay (flip 32))
- ++ sha-512l :(cork flim shal (flip 64))
- ::
- ++ sha-1l
- ~/ %sha1
- |= byts
- ^- @
- =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
- =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
- =+ ral=(lsh [0 3] wid)
- =+ ^= ful
- %+ can 0
- :~ [ral (rev 3 wid dat)]
- [8 128]
- [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
- [64 (~(net fe 6) ral)]
- ==
- =+ lex=(met 9 ful)
- =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
- =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
- =+ i=0
- |-
- ?: =(i lex)
- (rep 5 (flop (rip 5 hax)))
- =+ ^= wox
- =+ dux=(cut 9 [i 1] ful)
- =+ wox=(rep 5 (turn (rip 5 dux) net))
- =+ j=16
- |- ^- @
- ?: =(80 j)
- wox
- =+ :* l=(wac (sub j 3) wox)
- m=(wac (sub j 8) wox)
- n=(wac (sub j 14) wox)
- o=(wac (sub j 16) wox)
- ==
- =+ z=(rol 0 1 :(mix l m n o))
- $(wox (con (lsh [5 j] z) wox), j +(j))
- =+ j=0
- =+ :* a=(wac 0 hax)
- b=(wac 1 hax)
- c=(wac 2 hax)
- d=(wac 3 hax)
- e=(wac 4 hax)
- ==
- |- ^- @
- ?: =(80 j)
- %= ^$
- i +(i)
- hax %+ rep 5
- :~
- (sum a (wac 0 hax))
- (sum b (wac 1 hax))
- (sum c (wac 2 hax))
- (sum d (wac 3 hax))
- (sum e (wac 4 hax))
- ==
- ==
- =+ fx=(con (dis b c) (dis (not 5 1 b) d))
- =+ fy=:(mix b c d)
- =+ fz=:(con (dis b c) (dis b d) (dis c d))
- =+ ^= tem
- ?: &((gte j 0) (lte j 19))
- :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
- ?: &((gte j 20) (lte j 39))
- :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
- ?: &((gte j 40) (lte j 59))
- :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
- :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
- $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
- --
- :: 3f: scrambling
- +| %scrambling
- ::
- ++ un :: =(x (wred (wren x)))
- |%
- ++ wren :: conceal structure
- |= pyn=@ ^- @
- =+ len=(met 3 pyn)
- ?: =(0 len)
- 0
- => .(len (dec len))
- =+ mig=(zaft (xafo len (cut 3 [len 1] pyn)))
- %+ can 3
- %- flop ^- (list [@ @])
- :- [1 mig]
- |- ^- (list [@ @])
- ?: =(0 len)
- ~
- => .(len (dec len))
- =+ mog=(zyft :(mix mig (end 3 len) (cut 3 [len 1] pyn)))
- [[1 mog] $(mig mog)]
- ::
- ++ wred :: restore structure
- |= cry=@ ^- @
- =+ len=(met 3 cry)
- ?: =(0 len)
- 0
- => .(len (dec len))
- =+ mig=(cut 3 [len 1] cry)
- %+ can 3
- %- flop ^- (list [@ @])
- :- [1 (xaro len (zart mig))]
- |- ^- (list [@ @])
- ?: =(0 len)
- ~
- => .(len (dec len))
- =+ mog=(cut 3 [len 1] cry)
- [[1 :(mix mig (end 3 len) (zyrt mog))] $(mig mog)]
- ::
- ++ xafo |=([a=@ b=@] +((mod (add (dec b) a) 255)))
- ++ xaro |=([a=@ b=@] +((mod (add (dec b) (sub 255 (mod a 255))) 255)))
- ::
- ++ zaft :: forward 255-sbox
- |= a=@D
- =+ ^= b
- 0xcc.75bc.86c8.2fb1.9a42.f0b3.79a0.92ca.21f6.1e41.cde5.fcc0.
- 7e85.51ae.1005.c72d.1246.07e8.7c64.a914.8d69.d9f4.59c2.8038.
- 1f4a.dca2.6fdf.66f9.f561.a12e.5a16.f7b0.a39f.364e.cb70.7318.
- 1de1.ad31.63d1.abd4.db68.6a33.134d.a760.edee.5434.493a.e323.
- 930d.8f3d.3562.bb81.0b24.43cf.bea5.a6eb.52b4.0229.06b2.6704.
- 78c9.45ec.d75e.58af.c577.b7b9.c40e.017d.90c3.87f8.96fa.1153.
- 0372.7f30.1c32.ac83.ff17.c6e4.d36d.6b55.e2ce.8c71.8a5b.b6f3.
- 9d4b.eab5.8b3c.e7f2.a8fe.9574.5de0.bf20.3f15.9784.9939.5f9c.
- e609.564f.d8a4.b825.9819.94aa.2c08.8e4c.9b22.477a.2840.3ed6.
- 3750.6ef1.44dd.89ef.6576.d00a.fbda.9ed2.3b6c.7b0c.bde9.2ade.
- 5c88.c182.481a.1b0f.2bfd.d591.2726.57ba
- (cut 3 [(dec a) 1] b)
- ::
- ++ zart :: reverse 255-sbox
- |= a=@D
- =+ ^= b
- 0x68.4f07.ea1c.73c9.75c2.efc8.d559.5125.f621.a7a8.8591.5613.
- dd52.40eb.65a2.60b7.4bcb.1123.ceb0.1bd6.3c84.2906.b164.19b3.
- 1e95.5fec.ffbc.f187.fbe2.6680.7c77.d30e.e94a.9414.fd9a.017d.
- 3a7e.5a55.8ff5.8bf9.c181.e5b6.6ab2.35da.50aa.9293.3bc0.cdc6.
- f3bf.1a58.4130.f844.3846.744e.36a0.f205.789e.32d8.5e54.5c22.
- 0f76.fce7.4569.0d99.d26e.e879.dc16.2df4.887f.1ffe.4dba.6f5d.
- bbcc.2663.1762.aed7.af8a.ca20.dbb4.9bc7.a942.834c.105b.c4d4.
- 8202.3e61.a671.90e6.273d.bdab.3157.cfa4.0c2e.df86.2496.f7ed.
- 2b48.2a9d.5318.a343.d128.be9c.a5ad.6bb5.6dfa.c5e1.3408.128d.
- 2c04.0339.97a1.2ff0.49d0.eeb8.6c0a.0b37.b967.c347.d9ac.e072.
- e409.7b9f.1598.1d3f.33de.8ce3.8970.8e7a
- (cut 3 [(dec a) 1] b)
- ::
- ++ zyft :: forward 256-sbox
- |= a=@D
- =+ ^= b
- 0xbb49.b71f.b881.b402.17e4.6b86.69b5.1647.115f.dddb.7ca5.
- 8371.4bd5.19a9.b092.605d.0d9b.e030.a0cc.78ba.5706.4d2d.
- 986a.768c.f8e8.c4c7.2f1c.effe.3cae.01c0.253e.65d3.3872.
- ce0e.7a74.8ac6.daac.7e5c.6479.44ec.4143.3d20.4af0.ee6c.
- c828.deca.0377.249f.ffcd.7b4f.eb7d.66f2.8951.042e.595a.
- 8e13.f9c3.a79a.f788.6199.9391.7fab.6200.4ce5.0758.e2f1.
- 7594.c945.d218.4248.afa1.e61a.54fb.1482.bea4.96a2.3473.
- 63c2.e7cb.155b.120a.4ed7.bfd8.b31b.4008.f329.fca3.5380.
- 9556.0cb2.8722.2bea.e96e.3ac5.d1bc.10e3.2c52.a62a.b1d6.
- 35aa.d05e.f6a8.0f3b.31ed.559d.09ad.f585.6d21.fd1d.8d67.
- 370b.26f4.70c1.b923.4684.6fbd.cf8b.5036.0539.9cdc.d93f.
- 9068.1edf.8f33.b632.d427.97fa.9ee1
- (cut 3 [a 1] b)
- ::
- ++ zyrt :: reverse 256-sbox
- |= a=@D
- =+ ^= b
- 0x9fc8.2753.6e02.8fcf.8b35.2b20.5598.7caa.c9a9.30b0.9b48.
- 47ce.6371.80f6.407d.00dd.0aa5.ed10.ecb7.0f5a.5c3a.e605.
- c077.4337.17bd.9eda.62a4.79a7.ccb8.44cd.8e64.1ec4.5b6b.
- 1842.ffd8.1dfb.fd07.f2f9.594c.3be3.73c6.2cb6.8438.e434.
- 8d3d.ea6a.5268.72db.a001.2e11.de8c.88d3.0369.4f7a.87e2.
- 860d.0991.25d0.16b9.978a.4bf4.2a1a.e96c.fa50.85b5.9aeb.
- 9dbb.b2d9.a2d1.7bba.66be.e81f.1946.29a8.f5d2.f30c.2499.
- c1b3.6583.89e1.ee36.e0b4.6092.937e.d74e.2f6f.513e.9615.
- 9c5d.d581.e7ab.fe74.f01b.78b1.ae75.af57.0ec2.adc7.3245.
- 12bf.2314.3967.0806.31dc.cb94.d43f.493c.54a6.0421.c3a1.
- 1c4a.28ac.fc0b.26ca.5870.e576.f7f1.616d.905f.ef41.33bc.
- df4d.225e.2d56.7fd6.1395.a3f8.c582
- (cut 3 [a 1] b)
- --
- ::
- ++ ob
- ~% %ob ..ob
- ==
- %fein fein
- %fynd fynd
- ==
- |%
- ::
- :: +fein: conceal structure, v3.
- ::
- :: +fein conceals planet-sized atoms. The idea is that it should not be
- :: trivial to tell which planet a star has spawned under.
- ::
- ++ fein
- ~/ %fein
- |= pyn=@ ^- @
- ?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff))
- (add 0x1.0000 (feis (sub pyn 0x1.0000)))
- ?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff))
- =/ lo (dis pyn 0xffff.ffff)
- =/ hi (dis pyn 0xffff.ffff.0000.0000)
- %+ con hi
- $(pyn lo)
- pyn
- ::
- :: +fynd: restore structure, v3.
- ::
- :: Restores obfuscated values that have been enciphered with +fein.
- ::
- ++ fynd
- ~/ %fynd
- |= cry=@ ^- @
- ?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff))
- (add 0x1.0000 (tail (sub cry 0x1.0000)))
- ?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff))
- =/ lo (dis cry 0xffff.ffff)
- =/ hi (dis cry 0xffff.ffff.0000.0000)
- %+ con hi
- $(cry lo)
- cry
- :: +feis: a four-round generalised Feistel cipher over the domain
- :: [0, 2^32 - 2^16 - 1].
- ::
- :: See: Black & Rogaway (2002), Ciphers for arbitrary finite domains.
- ::
- ++ feis
- |= m=@
- ^- @
- (fee 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
- ::
- :: +tail: reverse +feis.
- ::
- ++ tail
- |= m=@
- ^- @
- (feen 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
- ::
- :: +fee: "Fe" in B&R (2002).
- ::
- :: A Feistel cipher given the following parameters:
- ::
- :: r: number of Feistel rounds
- :: a, b: parameters such that ab >= k
- :: k: value such that the domain of the cipher is [0, k - 1]
- :: prf: a gate denoting a family of pseudorandom functions indexed by
- :: its first argument and taking its second argument as input
- :: m: an input value in the domain [0, k - 1]
- ::
- ++ fee
- |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
- ^- @
- =/ c (fe r a b prf m)
- ?: (lth c k)
- c
- (fe r a b prf c)
- ::
- :: +feen: "Fe^-1" in B&R (2002).
- ::
- :: Reverses a Feistel cipher constructed with parameters as described in
- :: +fee.
- ::
- ++ feen
- |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
- ^- @
- =/ c (fen r a b prf m)
- ?: (lth c k)
- c
- (fen r a b prf c)
- ::
- :: +fe: "fe" in B&R (2002).
- ::
- :: An internal function to +fee.
- ::
- :: Note that this implementation differs slightly from the reference paper
- :: to support some legacy behaviour. See urbit/arvo#1105.
- ::
- ++ fe
- |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
- =/ j 1
- =/ ell (mod m a)
- =/ arr (div m a)
- |- ^- @
- ::
- ?: (gth j r)
- ?. =((mod r 2) 0)
- (add (mul arr a) ell)
- ::
- :: Note that +fe differs from B&R (2002)'s "fe" below, as a previous
- :: implementation of this cipher contained a bug such that certain inputs
- :: could encipher to the same output.
- ::
- :: To correct these problem cases while also preserving the cipher's
- :: legacy behaviour on most inputs, we check for a problem case (which
- :: occurs when 'arr' is equal to 'a') and, if detected, use an alternate
- :: permutation instead.
- ::
- ?: =(arr a)
- (add (mul arr a) ell)
- (add (mul ell a) arr)
- ::
- =/ f (prf (sub j 1) arr)
- ::
- =/ tmp
- ?. =((mod j 2) 0)
- (mod (add f ell) a)
- (mod (add f ell) b)
- ::
- $(j +(j), ell arr, arr tmp)
- ::
- :: +fen: "fe^-1" in B&R (2002).
- ::
- :: Note that this implementation differs slightly from the reference paper
- :: to support some legacy behaviour. See urbit/arvo#1105.
- ::
- ++ fen
- |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
- =/ j r
- ::
- =/ ahh
- ?. =((mod r 2) 0)
- (div m a)
- (mod m a)
- ::
- =/ ale
- ?. =((mod r 2) 0)
- (mod m a)
- (div m a)
- ::
- :: Similar to the comment in +fe, +fen differs from B&R (2002)'s "fe^-1"
- :: here in order to preserve the legacy cipher's behaviour on most inputs.
- ::
- :: Here problem cases can be identified by 'ahh' equating with 'a'; we
- :: correct those cases by swapping the values of 'ahh' and 'ale'.
- ::
- =/ ell
- ?: =(ale a)
- ahh
- ale
- ::
- =/ arr
- ?: =(ale a)
- ale
- ahh
- ::
- |- ^- @
- ?: (lth j 1)
- (add (mul arr a) ell)
- =/ f (prf (sub j 1) ell)
- ::
- :: Note that there is a slight deviation here to avoid dealing with
- :: negative values. We add 'a' or 'b' to arr as appropriate and reduce
- :: 'f' modulo the same number before performing subtraction.
- ::
- =/ tmp
- ?. =((mod j 2) 0)
- (mod (sub (add arr a) (mod f a)) a)
- (mod (sub (add arr b) (mod f b)) b)
- ::
- $(j (sub j 1), ell tmp, arr ell)
- ::
- :: +eff: a murmur3-based pseudorandom function. 'F' in B&R (2002).
- ::
- ++ eff
- |= [j=@ r=@]
- ^- @
- (muk (snag j raku) 2 r)
- ::
- :: +raku: seeds for eff.
- ::
- ++ raku
- ^- (list @ux)
- :~ 0xb76d.5eed
- 0xee28.1300
- 0x85bc.ae01
- 0x4b38.7af7
- ==
- ::
- --
- ::
- :: 3g: molds and mold builders
- +| %molds-and-mold-builders
- ::
- +$ coin $~ [%$ %ud 0] :: print format
- $% [%$ p=dime] ::
- [%blob p=*] ::
- [%many p=(list coin)] ::
- == ::
- +$ dime [p=@ta q=@] ::
- +$ edge [p=hair q=(unit [p=* q=nail])] :: parsing output
- +$ hair [p=@ud q=@ud] :: parsing trace
- ++ like |* a=$-(* *) :: generic edge
- |: b=`*`[(hair) ~] ::
- :- p=(hair -.b) ::
- ^= q ::
- ?@ +.b ~ ::
- :- ~ ::
- u=[p=(a +>-.b) q=[p=(hair -.b) q=(tape +.b)]] ::
- +$ nail [p=hair q=tape] :: parsing input
- +$ pint [p=[p=@ q=@] q=[p=@ q=@]] :: line+column range
- +$ rule _|:($:nail $:edge) :: parsing rule
- +$ spot [p=path q=pint] :: range in file
- +$ tone $% [%0 product=*] :: success
- [%1 block=*] :: single block
- [%2 trace=(list [@ta *])] :: error report
- == ::
- +$ toon $% [%0 p=*] :: success
- [%1 p=*] :: block
- [%2 p=(list tank)] :: stack trace
- == ::
- ++ wonk |* veq=_$:edge :: product from edge
- ?~(q.veq !! p.u.q.veq) ::
- -- =>
- ::
- ~% %qua
- +
- ==
- %mure mure
- %mute mute
- %show show
- ==
- :: layer-4
- ::
- |%
- ::
- :: 4a: exotic bases
- +| %exotic-bases
- ::
- ++ po :: phonetic base
- ~/ %po
- =+ :- ^= sis :: prefix syllables
- 'dozmarbinwansamlitsighidfidlissogdirwacsabwissib\
- /rigsoldopmodfoglidhopdardorlorhodfolrintogsilmir\
- /holpaslacrovlivdalsatlibtabhanticpidtorbolfosdot\
- /losdilforpilramtirwintadbicdifrocwidbisdasmidlop\
- /rilnardapmolsanlocnovsitnidtipsicropwitnatpanmin\
- /ritpodmottamtolsavposnapnopsomfinfonbanmorworsip\
- /ronnorbotwicsocwatdolmagpicdavbidbaltimtasmallig\
- /sivtagpadsaldivdactansidfabtarmonranniswolmispal\
- /lasdismaprabtobrollatlonnodnavfignomnibpagsopral\
- /bilhaddocridmocpacravripfaltodtiltinhapmicfanpat\
- /taclabmogsimsonpinlomrictapfirhasbosbatpochactid\
- /havsaplindibhosdabbitbarracparloddosbortochilmac\
- /tomdigfilfasmithobharmighinradmashalraglagfadtop\
- /mophabnilnosmilfopfamdatnoldinhatnacrisfotribhoc\
- /nimlarfitwalrapsarnalmoslandondanladdovrivbacpol\
- /laptalpitnambonrostonfodponsovnocsorlavmatmipfip'
- ^= dex :: suffix syllables
- 'zodnecbudwessevpersutletfulpensytdurwepserwylsun\
- /rypsyxdyrnuphebpeglupdepdysputlughecryttyvsydnex\
- /lunmeplutseppesdelsulpedtemledtulmetwenbynhexfeb\
- /pyldulhetmevruttylwydtepbesdexsefwycburderneppur\
- /rysrebdennutsubpetrulsynregtydsupsemwynrecmegnet\
- /secmulnymtevwebsummutnyxrextebfushepbenmuswyxsym\
- /selrucdecwexsyrwetdylmynmesdetbetbeltuxtugmyrpel\
- /syptermebsetdutdegtexsurfeltudnuxruxrenwytnubmed\
- /lytdusnebrumtynseglyxpunresredfunrevrefmectedrus\
- /bexlebduxrynnumpyxrygryxfeptyrtustyclegnemfermer\
- /tenlusnussyltecmexpubrymtucfyllepdebbermughuttun\
- /bylsudpemdevlurdefbusbeprunmelpexdytbyttyplevmyl\
- /wedducfurfexnulluclennerlexrupnedlecrydlydfenwel\
- /nydhusrelrudneshesfetdesretdunlernyrsebhulryllud\
- /remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\
- /lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes'
- |%
- ++ ins ~/ %ins :: parse prefix
- |= a=@tas
- =+ b=0
- |- ^- (unit @)
- ?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b))))
- ++ ind ~/ %ind :: parse suffix
- |= a=@tas
- =+ b=0
- |- ^- (unit @)
- ?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b))))
- ++ tos ~/ %tos :: fetch prefix
- |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis)))
- ++ tod ~/ %tod :: fetch suffix
- |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex)))
- --
- ::
- ++ fa :: base58check
- =+ key='123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz'
- =/ yek=@ux ~+
- =- yek:(roll (rip 3 key) -)
- =+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)]
- |.
- [+(b) (mix yek (lsh [3 `@u`a] (~(inv fe 3) b)))]
- |%
- ++ cha |=(a=char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b)))
- ++ tok
- |= a=@ux ^- @ux
- =+ b=(pad a)
- =- (~(net fe 5) (end [3 4] (shay 32 -)))
- (shay (add b (met 3 a)) (lsh [3 b] (swp 3 a)))
- ::
- ++ pad |=(a=@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b))))
- ++ enc |=(a=@ux `@ux`(mix (lsh [3 4] a) (tok a)))
- ++ den
- |= a=@ux ^- (unit @ux)
- =+ b=(rsh [3 4] a)
- ?. =((tok b) (end [3 4] a))
- ~
- `b
- --
- :: 4b: text processing
- +| %text-processing
- ::
- ++ at :: basic printing
- |_ a=@
- ++ r
- ?: ?& (gte (met 3 a) 2)
- |-
- ?: =(0 a)
- &
- =+ vis=(end 3 a)
- ?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z')))
- $(a (rsh 3 a))
- ==
- ==
- rtam
- ?: (lte (met 3 a) 2)
- rud
- rux
- ::
- ++ rf `tape`[?-(a %& '&', %| '|', * !!) ~]
- ++ rn `tape`[?>(=(0 a) '~') ~]
- ++ rt `tape`['\'' (weld (mesc (trip a)) `tape`['\'' ~])]
- ++ rta rt
- ++ rtam `tape`['%' (trip a)]
- ++ rub `tape`['0' 'b' (rum 2 ~ |=(b=@ (add '0' b)))]
- ++ rud (rum 10 ~ |=(b=@ (add '0' b)))
- ++ rum
- |= [b=@ c=tape d=$-(@ @)]
- ^- tape
- ?: =(0 a)
- [(d 0) c]
- =+ e=0
- |- ^- tape
- ?: =(0 a)
- c
- =+ f=&(!=(0 e) =(0 (mod e ?:(=(10 b) 3 4))))
- %= $
- a (div a b)
- c [(d (mod a b)) ?:(f [?:(=(10 b) ',' '-') c] c)]
- e +(e)
- ==
- ::
- ++ rup
- =+ b=(met 3 a)
- ^- tape
- :- '-'
- |- ^- tape
- ?: (gth (met 5 a) 1)
- %+ weld
- $(a (rsh 5 a), b (sub b 4))
- `tape`['-' '-' $(a (end 5 a), b 4)]
- ?: =(0 b)
- ['~' ~]
- ?: (lte b 1)
- (trip (tos:po a))
- |- ^- tape
- ?: =(2 b)
- =+ c=(rsh 3 a)
- =+ d=(end 3 a)
- (weld (trip (tod:po c)) (trip (tos:po (mix c d))))
- =+ c=(rsh [3 2] a)
- =+ d=(end [3 2] a)
- (weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)])
- ::
- ++ ruv
- ^- tape
- :+ '0'
- 'v'
- %^ rum
- 64
- ~
- |= b=@
- ?: =(63 b)
- '+'
- ?: =(62 b)
- '-'
- ?:((lth b 26) (add 65 b) ?:((lth b 52) (add 71 b) (sub b 4)))
- ::
- ++ rux `tape`['0' 'x' (rum 16 ~ |=(b=@ (add b ?:((lth b 10) 48 87))))]
- --
- ++ cass :: lowercase
- |= vib=tape
- ^- tape
- (turn vib |=(a=@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a))))
- ::
- ++ cuss :: uppercase
- |= vib=tape
- ^- tape
- (turn vib |=(a=@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32))))
- ::
- ++ crip |=(a=tape `@t`(rap 3 a)) :: tape to cord
- ::
- ++ mesc :: ctrl code escape
- |= vib=tape
- ^- tape
- ?~ vib
- ~
- ?: =('\\' i.vib)
- ['\\' '\\' $(vib t.vib)]
- ?: ?|((gth i.vib 126) (lth i.vib 32) =(`@`39 i.vib))
- ['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))]
- [i.vib $(vib t.vib)]
- ::
- ++ runt :: prepend repeatedly
- |= [[a=@ b=@] c=tape]
- ^- tape
- ?: =(0 a)
- c
- [b $(a (dec a))]
- ::
- ++ sand :: atom sanity
- |= a=@ta
- (flit (sane a))
- ::
- ++ sane :: atom sanity
- |= a=@ta
- |= b=@ ^- ?
- ?. =(%t (end 3 a))
- :: XX more and better sanity
- ::
- &
- =+ [inx=0 len=(met 3 b)]
- ?: =(%tas a)
- |- ^- ?
- ?: =(inx len) &
- =+ cur=(cut 3 [inx 1] b)
- ?& ?| &((gte cur 'a') (lte cur 'z'))
- &(=('-' cur) !=(0 inx) !=(len inx))
- &(&((gte cur '0') (lte cur '9')) !=(0 inx))
- ==
- $(inx +(inx))
- ==
- ?: =(%ta a)
- |- ^- ?
- ?: =(inx len) &
- =+ cur=(cut 3 [inx 1] b)
- ?& ?| &((gte cur 'a') (lte cur 'z'))
- &((gte cur '0') (lte cur '9'))
- |(=('-' cur) =('~' cur) =('_' cur) =('.' cur))
- ==
- $(inx +(inx))
- ==
- |- ^- ?
- ?: =(inx len) &
- =+ cur=(cut 3 [inx 1] b)
- ?: &((lth cur 32) !=(10 cur)) |
- =+ tef=(teff cur)
- ?& ?| =(1 tef)
- =+ i=1
- |- ^- ?
- ?| =(i tef)
- ?& (gte (cut 3 [(add i inx) 1] b) 128)
- $(i +(i))
- == == ==
- $(inx (add inx tef))
- ==
- ::
- ++ ruth :: biblical sanity
- |= [a=@ta b=*]
- ^- @
- ?^ b !!
- :: ?. ((sane a) b) !!
- b
- ::
- ++ trim :: tape split
- |= [a=@ b=tape]
- ^- [p=tape q=tape]
- ?~ b
- [~ ~]
- ?: =(0 a)
- [~ b]
- =+ c=$(a (dec a), b t.b)
- [[i.b p.c] q.c]
- ::
- ++ trip :: cord to tape
- ~/ %trip
- |= a=@ ^- tape
- ?: =(0 (met 3 a))
- ~
- [^-(@ta (end 3 a)) $(a (rsh 3 a))]
- ::
- ++ teff :: length utf8
- |= a=@t ^- @
- =+ b=(end 3 a)
- ?: =(0 b)
- ?>(=(`@`0 a) 0)
- ?> |((gte b 32) =(10 b))
- ?:((lte b 127) 1 ?:((lte b 223) 2 ?:((lte b 239) 3 4)))
- ::
- ++ taft :: utf8 to utf32
- |= a=@t
- ^- @c
- %+ rap 5
- |- ^- (list @c)
- =+ b=(teff a)
- ?: =(0 b) ~
- =+ ^= c
- %+ can 0
- %+ turn
- ^- (list [p=@ q=@])
- ?+ b !!
- %1 [[0 7] ~]
- %2 [[8 6] [0 5] ~]
- %3 [[16 6] [8 6] [0 4] ~]
- %4 [[24 6] [16 6] [8 6] [0 3] ~]
- ==
- |=([p=@ q=@] [q (cut 0 [p q] a)])
- ?> =((tuft c) (end [3 b] a))
- [c $(a (rsh [3 b] a))]
- ::
- ++ tuba :: utf8 to utf32 tape
- |= a=tape
- ^- (list @c)
- (rip 5 (taft (rap 3 a))) :: XX horrible
- ::
- ++ tufa :: utf32 to utf8 tape
- |= a=(list @c)
- ^- tape
- ?~ a ""
- (weld (rip 3 (tuft i.a)) $(a t.a))
- ::
- ++ tuft :: utf32 to utf8 text
- |= a=@c
- ^- @t
- %+ rap 3
- |- ^- (list @)
- ?: =(`@`0 a)
- ~
- =+ b=(end 5 a)
- =+ c=$(a (rsh 5 a))
- ?: (lte b 0x7f)
- [b c]
- ?: (lte b 0x7ff)
- :* (mix 0b1100.0000 (cut 0 [6 5] b))
- (mix 0b1000.0000 (end [0 6] b))
- c
- ==
- ?: (lte b 0xffff)
- :* (mix 0b1110.0000 (cut 0 [12 4] b))
- (mix 0b1000.0000 (cut 0 [6 6] b))
- (mix 0b1000.0000 (end [0 6] b))
- c
- ==
- :* (mix 0b1111.0000 (cut 0 [18 3] b))
- (mix 0b1000.0000 (cut 0 [12 6] b))
- (mix 0b1000.0000 (cut 0 [6 6] b))
- (mix 0b1000.0000 (end [0 6] b))
- c
- ==
- ::
- ++ wack :: knot escape
- |= a=@ta
- ^- @ta
- =+ b=(rip 3 a)
- %+ rap 3
- |- ^- tape
- ?~ b
- ~
- ?: =('~' i.b) ['~' '~' $(b t.b)]
- ?: =('_' i.b) ['~' '-' $(b t.b)]
- [i.b $(b t.b)]
- ::
- ++ wick :: knot unescape
- |= a=@
- ^- (unit @ta)
- =+ b=(rip 3 a)
- =- ?^(b ~ (some (rap 3 (flop c))))
- =| c=tape
- |- ^- [b=tape c=tape]
- ?~ b [~ c]
- ?. =('~' i.b)
- $(b t.b, c [i.b c])
- ?~ t.b [b ~]
- ?- i.t.b
- %'~' $(b t.t.b, c ['~' c])
- %'-' $(b t.t.b, c ['_' c])
- @ [b ~]
- ==
- ::
- ++ woad :: cord unescape
- |= a=@ta
- ^- @t
- %+ rap 3
- |- ^- (list @)
- ?: =(`@`0 a)
- ~
- =+ b=(end 3 a)
- =+ c=(rsh 3 a)
- ?: =('.' b)
- [' ' $(a c)]
- ?. =('~' b)
- [b $(a c)]
- => .(b (end 3 c), c (rsh 3 c))
- ?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d))
- ^= d
- =+ d=0
- |- ^- [p=@ q=@]
- ?: =('.' b)
- [d c]
- ?< =(0 c)
- %= $
- b (end 3 c)
- c (rsh 3 c)
- d %+ add (mul 16 d)
- %+ sub b
- ?: &((gte b '0') (lte b '9')) 48
- ?>(&((gte b 'a') (lte b 'z')) 87)
- ==
- %'.' ['.' $(a c)]
- %'~' ['~' $(a c)]
- ==
- ::
- ++ wood :: cord escape
- |= a=@t
- ^- @ta
- %+ rap 3
- |- ^- (list @)
- ?: =(`@`0 a)
- ~
- =+ b=(teff a)
- =+ c=(taft (end [3 b] a))
- =+ d=$(a (rsh [3 b] a))
- ?: ?| &((gte c 'a') (lte c 'z'))
- &((gte c '0') (lte c '9'))
- =(`@`'-' c)
- ==
- [c d]
- ?+ c
- :- '~'
- =+ e=(met 2 c)
- |- ^- tape
- ?: =(0 e)
- ['.' d]
- =. e (dec e)
- =+ f=(rsh [2 e] c)
- [(add ?:((lte f 9) 48 87) f) $(c (end [2 e] c))]
- ::
- %' ' ['.' d]
- %'.' ['~' '.' d]
- %'~' ['~' '~' d]
- ==
- ::
- :: 4c: tank printer
- +| %tank-printer
- ::
- ++ wash :: render tank at width
- |= [[tab=@ edg=@] tac=tank] ^- wall
- (~(win re tac) tab edg)
- ::
- :: +re: tank renderer
- ::
- ++ re
- |_ tac=tank
- :: +ram: render a tank to one line (flat)
- ::
- ++ ram
- ^- tape
- ?@ tac
- (trip tac)
- ?- -.tac
- %leaf p.tac
- ::
- :: flat %palm rendered as %rose with welded openers
- ::
- %palm
- =* mid p.p.tac
- =* for (weld q.p.tac r.p.tac)
- =* end s.p.tac
- ram(tac [%rose [mid for end] q.tac])
- ::
- :: flat %rose rendered with open/mid/close
- ::
- %rose
- =* mid p.p.tac
- =* for q.p.tac
- =* end r.p.tac
- =* lit q.tac
- %+ weld
- for
- |- ^- tape
- ?~ lit
- end
- %+ weld
- ram(tac i.lit)
- =* voz $(lit t.lit)
- ?~(t.lit voz (weld mid voz))
- ==
- :: +win: render a tank to multiple lines (tall)
- ::
- :: indented by .tab, soft-wrapped at .edg
- ::
- ++ win
- |= [tab=@ud edg=@ud]
- :: output stack
- ::
- =| lug=wall
- |^ ^- wall
- ?@ tac
- (rig (trip tac))
- ?- -.tac
- %leaf (rig p.tac)
- ::
- %palm
- =/ hom ram
- ?: (lte (lent hom) (sub edg tab))
- (rig hom)
- ::
- =* for q.p.tac
- =* lit q.tac
- ?~ lit
- (rig for)
- ?~ t.lit
- =: tab (add 2 tab)
- lug $(tac i.lit)
- ==
- (rig for)
- ::
- => .(lit `(list tank)`lit)
- =/ lyn (mul 2 (lent lit))
- =. lug
- |- ^- wall
- ?~ lit
- lug
- =/ nyl (sub lyn 2)
- %= ^$
- tac i.lit
- tab (add tab nyl)
- lug $(lit t.lit, lyn nyl)
- ==
- (wig for)
- ::
- %rose
- =/ hom ram
- ?: (lte (lent hom) (sub edg tab))
- (rig hom)
- ::
- =* for q.p.tac
- =* end r.p.tac
- =* lit q.tac
- =. lug
- |- ^- wall
- ?~ lit
- ?~(end lug (rig end))
- %= ^$
- tac i.lit
- tab (mod (add 2 tab) (mul 2 (div edg 3)))
- lug $(lit t.lit)
- ==
- ?~(for lug (wig for))
- ==
- :: +rig: indent tape and cons with output stack
- ::
- ++ rig
- |= hom=tape
- ^- wall
- [(runt [tab ' '] hom) lug]
- :: +wig: indent tape and cons with output stack
- ::
- :: joined with the top line if whitespace/indentation allow
- ::
- ++ wig
- |= hom=tape
- ^- wall
- ?~ lug
- (rig hom)
- =/ wug :(add 1 tab (lent hom))
- ?. =+ mir=i.lug
- |- ^- ?
- ?~ mir |
- ?| =(0 wug)
- ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug)))
- ==
- (rig hom) :: ^ XX regular form?
- :_ t.lug
- %+ runt [tab ' ']
- (weld hom `tape`[' ' (slag wug i.lug)])
- --
- --
- ++ show :: XX deprecated!
- |= vem=*
- |^ ^- tank
- ?: ?=(@ vem)
- [%leaf (mesc (trip vem))]
- ?- vem
- [s=~ c=*]
- [%leaf '\'' (weld (mesc (tape +.vem)) `tape`['\'' ~])]
- ::
- [s=%a c=@] [%leaf (mesc (trip c.vem))]
- [s=%b c=*] (shop c.vem |=(a=@ ~(rub at a)))
- [s=[%c p=@] c=*]
- :+ %palm
- [['.' ~] ['-' ~] ~ ~]
- [[%leaf (mesc (trip p.s.vem))] $(vem c.vem) ~]
- ::
- [s=%d c=*] (shop c.vem |=(a=@ ~(rud at a)))
- [s=%k c=*] (tank c.vem)
- [s=%h c=*]
- :+ %rose
- [['/' ~] ['/' ~] ~]
- =+ yol=((list @ta) c.vem)
- (turn yol |=(a=@ta [%leaf (trip a)]))
- ::
- [s=%l c=*] (shol c.vem)
- [s=%o c=*]
- %= $
- vem
- :- [%m '%h::[%d %d].[%d %d]>']
- [-.c.vem +<-.c.vem +<+.c.vem +>-.c.vem +>+.c.vem ~]
- ==
- ::
- [s=%p c=*] (shop c.vem |=(a=@ ~(rup at a)))
- [s=%q c=*] (shop c.vem |=(a=@ ~(r at a)))
- [s=%r c=*] $(vem [[%r ' ' '{' '}'] c.vem])
- [s=%t c=*] (shop c.vem |=(a=@ ~(rt at a)))
- [s=%v c=*] (shop c.vem |=(a=@ ~(ruv at a)))
- [s=%x c=*] (shop c.vem |=(a=@ ~(rux at a)))
- [s=[%m p=@] c=*] (shep p.s.vem c.vem)
- [s=[%r p=@] c=*]
- $(vem [[%r ' ' (cut 3 [0 1] p.s.vem) (cut 3 [1 1] p.s.vem)] c.vem])
- ::
- [s=[%r p=@ q=@ r=@] c=*]
- :+ %rose
- :* p=(mesc (trip p.s.vem))
- q=(mesc (trip q.s.vem))
- r=(mesc (trip r.s.vem))
- ==
- |- ^- (list tank)
- ?@ c.vem
- ~
- [^$(vem -.c.vem) $(c.vem +.c.vem)]
- ::
- [s=%z c=*] $(vem [[%r %$ %$ %$] c.vem])
- * !!
- ==
- ++ shep
- |= [fom=@ gar=*]
- ^- tank
- =+ l=(met 3 fom)
- =+ i=0
- :- %leaf
- |- ^- tape
- ?: (gte i l)
- ~
- =+ c=(cut 3 [i 1] fom)
- ?. =(37 c)
- (weld (mesc [c ~]) $(i +(i)))
- =+ d=(cut 3 [+(i) 1] fom)
- ?. .?(gar)
- ['\\' '#' $(i (add 2 i))]
- (weld ~(ram re (show d -.gar)) $(i (add 2 i), gar +.gar))
- ::
- ++ shop
- |= [aug=* vel=$-(a=@ tape)]
- ^- tank
- ?: ?=(@ aug)
- [%leaf (vel aug)]
- :+ %rose
- [[' ' ~] ['[' ~] [']' ~]]
- => .(aug `*`aug)
- |- ^- (list tank)
- ?: ?=(@ aug)
- [^$ ~]
- [^$(aug -.aug) $(aug +.aug)]
- ::
- ++ shol
- |= lim=*
- :+ %rose
- [['.' ~] ~ ~]
- |- ^- (list tank)
- ?: ?=(@ lim) ~
- :_ $(lim +.lim)
- ?+ -.lim (show '#')
- ~ (show '$')
- c=@ (show c.lim)
- [%& %1] (show '.')
- [%& c=@]
- [%leaf '+' ~(rud at c.lim)]
- ::
- [%| @ ~] (show ',')
- [%| n=@ ~ c=@]
- [%leaf (weld (reap n.lim '^') ?~(c.lim "$" (trip c.lim)))]
- ==
- --
- ::
- :: 4d: parsing (tracing)
- +| %parsing-tracing
- ::
- ++ last |= [zyc=hair naz=hair] :: farther trace
- ^- hair
- ?: =(p.zyc p.naz)
- ?:((gth q.zyc q.naz) zyc naz)
- ?:((gth p.zyc p.naz) zyc naz)
- ::
- ++ lust |= [weq=char naz=hair] :: detect newline
- ^- hair
- ?:(=(`@`10 weq) [+(p.naz) 1] [p.naz +(q.naz)])
- ::
- :: 4e: parsing (combinators)
- +| %parsing-combinators
- ::
- ++ bend :: conditional comp
- ~/ %bend
- |* raq=_|*([a=* b=*] [~ u=[a b]])
- ~/ %fun
- |* [vex=edge sab=rule]
- ?~ q.vex
- vex
- =+ yit=(sab q.u.q.vex)
- =+ yur=(last p.vex p.yit)
- ?~ q.yit
- [p=yur q=q.vex]
- =+ vux=(raq p.u.q.vex p.u.q.yit)
- ?~ vux
- [p=yur q=q.vex]
- [p=yur q=[~ u=[p=u.vux q=q.u.q.yit]]]
- ::
- ++ comp
- ~/ %comp
- |* raq=_|*([a=* b=*] [a b]) :: arbitrary compose
- ~/ %fun
- |* [vex=edge sab=rule]
- ~! +<
- ?~ q.vex
- vex
- =+ yit=(sab q.u.q.vex)
- =+ yur=(last p.vex p.yit)
- ?~ q.yit
- [p=yur q=q.yit]
- [p=yur q=[~ u=[p=(raq p.u.q.vex p.u.q.yit) q=q.u.q.yit]]]
- ::
- ++ fail |=(tub=nail [p=p.tub q=~]) :: never parse
- ++ glue :: add rule
- ~/ %glue
- |* bus=rule
- ~/ %fun
- |* [vex=edge sab=rule]
- (plug vex ;~(pfix bus sab))
- ::
- ++ less :: no first and second
- |* [vex=edge sab=rule]
- ?~ q.vex
- =+ roq=(sab)
- [p=(last p.vex p.roq) q=q.roq]
- (fail +<.sab)
- ::
- ++ pfix :: discard first rule
- ~/ %pfix
- |* sam=[vex=edge sab=rule]
- %. sam
- (comp |*([a=* b=*] b))
- ::
- ++ plug :: first then second
- ~/ %plug
- |* [vex=edge sab=rule]
- ?~ q.vex
- vex
- =+ yit=(sab q.u.q.vex)
- =+ yur=(last p.vex p.yit)
- ?~ q.yit
- [p=yur q=q.yit]
- [p=yur q=[~ u=[p=[p.u.q.vex p.u.q.yit] q=q.u.q.yit]]]
- ::
- ++ pose :: first or second
- ~/ %pose
- |* [vex=edge sab=rule]
- ?~ q.vex
- =+ roq=(sab)
- [p=(last p.vex p.roq) q=q.roq]
- vex
- ::
- ++ simu :: first and second
- |* [vex=edge sab=rule]
- ?~ q.vex
- vex
- =+ roq=(sab)
- roq
- ::
- ++ sfix :: discard second rule
- ~/ %sfix
- |* sam=[vex=edge sab=rule]
- %. sam
- (comp |*([a=* b=*] a))
- ::
- :: 4f: parsing (rule builders)
- +| %parsing-rule-builders
- ::
- ++ bass :: leftmost base
- |* [wuc=@ tyd=rule]
- %+ cook
- |= waq=(list @)
- %+ roll
- waq
- =|([p=@ q=@] |.((add p (mul wuc q))))
- tyd
- ::
- ++ boss :: rightmost base
- |* [wuc=@ tyd=rule]
- %+ cook
- |= waq=(list @)
- %+ reel
- waq
- =|([p=@ q=@] |.((add p (mul wuc q))))
- tyd
- ::
- ++ cold :: replace w+ constant
- ~/ %cold
- |* [cus=* sef=rule]
- ~/ %fun
- |= tub=nail
- =+ vex=(sef tub)
- ?~ q.vex
- vex
- [p=p.vex q=[~ u=[p=cus q=q.u.q.vex]]]
- ::
- ++ cook :: apply gate
- ~/ %cook
- |* [poq=gate sef=rule]
- ~/ %fun
- |= tub=nail
- =+ vex=(sef tub)
- ?~ q.vex
- vex
- [p=p.vex q=[~ u=[p=(poq p.u.q.vex) q=q.u.q.vex]]]
- ::
- ++ easy :: always parse
- ~/ %easy
- |* huf=*
- ~/ %fun
- |= tub=nail
- ^- (like _huf)
- [p=p.tub q=[~ u=[p=huf q=tub]]]
- ::
- ++ fuss
- |= [sic=@t non=@t]
- ;~(pose (cold %& (jest sic)) (cold %| (jest non)))
- ::
- ++ full :: has to fully parse
- |* sef=rule
- |= tub=nail
- =+ vex=(sef tub)
- ?~(q.vex vex ?:(=(~ q.q.u.q.vex) vex [p=p.vex q=~]))
- ::
- ++ funk :: add to tape first
- |* [pre=tape sef=rule]
- |= tub=nail
- (sef p.tub (weld pre q.tub))
- ::
- ++ here :: place-based apply
- ~/ %here
- |* [hez=_|=([a=pint b=*] [a b]) sef=rule]
- ~/ %fun
- |= tub=nail
- =+ vex=(sef tub)
- ?~ q.vex
- vex
- [p=p.vex q=[~ u=[p=(hez [p.tub p.q.u.q.vex] p.u.q.vex) q=q.u.q.vex]]]
- ::
- ++ inde |* sef=rule :: indentation block
- |= nail ^+ (sef)
- =+ [har tap]=[p q]:+<
- =+ lev=(fil 3 (dec q.har) ' ')
- =+ eol=(just `@t`10)
- =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
- ;~(simu ;~(plug eol eol) eol)
- ?~ q.roq roq
- =+ vex=(sef har(q 1) p.u.q.roq)
- =+ fur=p.vex(q (add (dec q.har) q.p.vex))
- ?~ q.vex vex(p fur)
- =- vex(p fur, u.q -)
- :+ &3.vex
- &4.vex(q.p (add (dec q.har) q.p.&4.vex))
- =+ res=|4.vex
- |- ?~ res |4.roq
- ?. =(10 -.res) [-.res $(res +.res)]
- (welp [`@t`10 (trip lev)] $(res +.res))
- ::
- ++ ifix
- |* [fel=[rule rule] hof=rule]
- ~! +<
- ~! +<:-.fel
- ~! +<:+.fel
- ;~(pfix -.fel ;~(sfix hof +.fel))
- ::
- ++ jest :: match a cord
- |= daf=@t
- |= tub=nail
- =+ fad=daf
- |- ^- (like @t)
- ?: =(`@`0 daf)
- [p=p.tub q=[~ u=[p=fad q=tub]]]
- ?: |(?=(~ q.tub) !=((end 3 daf) i.q.tub))
- (fail tub)
- $(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 daf))
- ::
- ++ just :: XX redundant, jest
- ~/ %just :: match a char
- |= daf=char
- ~/ %fun
- |= tub=nail
- ^- (like char)
- ?~ q.tub
- (fail tub)
- ?. =(daf i.q.tub)
- (fail tub)
- (next tub)
- ::
- ++ knee :: callbacks
- |* [gar=* sef=_|.(*rule)]
- |= tub=nail
- ^- (like _gar)
- ((sef) tub)
- ::
- ++ mask :: match char in set
- ~/ %mask
- |= bud=(list char)
- ~/ %fun
- |= tub=nail
- ^- (like char)
- ?~ q.tub
- (fail tub)
- ?. (lien bud |=(a=char =(i.q.tub a)))
- (fail tub)
- (next tub)
- ::
- ++ more :: separated, *
- |* [bus=rule fel=rule]
- ;~(pose (most bus fel) (easy ~))
- ::
- ++ most :: separated, +
- |* [bus=rule fel=rule]
- ;~(plug fel (star ;~(pfix bus fel)))
- ::
- ++ next :: consume a char
- |= tub=nail
- ^- (like char)
- ?~ q.tub
- (fail tub)
- =+ zac=(lust i.q.tub p.tub)
- [zac [~ i.q.tub [zac t.q.tub]]]
- ::
- ++ perk :: parse cube fork
- |* a=(pole @tas)
- ?~ a fail
- ;~ pose
- (cold -.a (jest -.a))
- $(a +.a)
- ==
- ::
- ++ pick :: rule for ++each
- |* [a=rule b=rule]
- ;~ pose
- (stag %& a)
- (stag %| b)
- ==
- ++ plus |*(fel=rule ;~(plug fel (star fel))) ::
- ++ punt |*([a=rule] ;~(pose (stag ~ a) (easy ~))) ::
- ++ sear :: conditional cook
- |* [pyq=$-(* (unit)) sef=rule]
- |= tub=nail
- =+ vex=(sef tub)
- ?~ q.vex
- vex
- =+ gey=(pyq p.u.q.vex)
- ?~ gey
- [p=p.vex q=~]
- [p=p.vex q=[~ u=[p=u.gey q=q.u.q.vex]]]
- ::
- ++ shim :: match char in range
- ~/ %shim
- |= [les=@ mos=@]
- ~/ %fun
- |= tub=nail
- ^- (like char)
- ?~ q.tub
- (fail tub)
- ?. ?&((gte i.q.tub les) (lte i.q.tub mos))
- (fail tub)
- (next tub)
- ::
- ++ stag :: add a label
- ~/ %stag
- |* [gob=* sef=rule]
- ~/ %fun
- |= tub=nail
- =+ vex=(sef tub)
- ?~ q.vex
- vex
- [p=p.vex q=[~ u=[p=[gob p.u.q.vex] q=q.u.q.vex]]]
- ::
- ++ stet ::
- |* leh=(list [?(@ [@ @]) rule])
- |-
- ?~ leh
- ~
- [i=[p=-.i.leh q=+.i.leh] t=$(leh t.leh)]
- ::
- ++ stew :: switch by first char
- ~/ %stew
- |* leh=(list [p=?(@ [@ @]) q=rule]) :: char+range keys
- =+ ^= wor :: range complete lth
- |= [ort=?(@ [@ @]) wan=?(@ [@ @])]
- ?@ ort
- ?@(wan (lth ort wan) (lth ort -.wan))
- ?@(wan (lth +.ort wan) (lth +.ort -.wan))
- =+ ^= hel :: build parser map
- =+ hel=`(tree _?>(?=(^ leh) i.leh))`~
- |- ^+ hel
- ?~ leh
- ~
- =+ yal=$(leh t.leh)
- |- ^+ hel
- ?~ yal
- [i.leh ~ ~]
- ?: (wor p.i.leh p.n.yal)
- =+ nuc=$(yal l.yal)
- ?> ?=(^ nuc)
- ?: (mor p.n.yal p.n.nuc)
- [n.yal nuc r.yal]
- [n.nuc l.nuc [n.yal r.nuc r.yal]]
- =+ nuc=$(yal r.yal)
- ?> ?=(^ nuc)
- ?: (mor p.n.yal p.n.nuc)
- [n.yal l.yal nuc]
- [n.nuc [n.yal l.yal l.nuc] r.nuc]
- ~% %fun ..^$ ~
- |= tub=nail
- ?~ q.tub
- (fail tub)
- |-
- ?~ hel
- (fail tub)
- ?: ?@ p.n.hel
- =(p.n.hel i.q.tub)
- ?&((gte i.q.tub -.p.n.hel) (lte i.q.tub +.p.n.hel))
- :: (q.n.hel [(lust i.q.tub p.tub) t.q.tub])
- (q.n.hel tub)
- ?: (wor i.q.tub p.n.hel)
- $(hel l.hel)
- $(hel r.hel)
- ::
- ++ slug ::
- |* raq=_=>(~ |*([a=* b=*] [a b]))
- |* [bus=rule fel=rule]
- ;~((comp raq) fel (stir +<+.raq raq ;~(pfix bus fel)))
- ::
- ++ star :: 0 or more times
- |* fel=rule
- (stir `(list _(wonk *fel))`~ |*([a=* b=*] [a b]) fel)
- ::
- ++ stir
- ~/ %stir
- |* [rud=* raq=_=>(~ |*([a=* b=*] [a b])) fel=rule]
- ~/ %fun
- |= tub=nail
- ^- (like _rud)
- ::
- :: lef: successful interim parse results (per .fel)
- :: wag: initial accumulator (.rud in .tub at farthest success)
- ::
- =+ ^= [lef wag]
- =| lef=(list _(fel tub))
- |- ^- [_lef (pair hair [~ u=(pair _rud nail)])]
- =+ vex=(fel tub)
- ?~ q.vex
- :- lef
- [p.vex [~ rud tub]]
- $(lef [vex lef], tub q.u.q.vex)
- ::
- :: fold .lef into .wag, combining results with .raq
- ::
- %+ roll lef
- |= _[vex=(fel tub) wag=wag] :: q.vex is always (some)
- ^+ wag
- :- (last p.vex p.wag)
- [~ (raq p.u.+.q.vex p.u.q.wag) q.u.q.wag]
- ::
- ++ stun :: parse several times
- ~/ %stun
- |* [lig=[@ @] fel=rule]
- |= tub=nail
- ^- (like (list _(wonk (fel))))
- ?: =(0 +.lig)
- [p.tub [~ ~ tub]]
- =+ vex=(fel tub)
- ?~ q.vex
- ?: =(0 -.lig)
- [p.vex [~ ~ tub]]
- vex
- =+ ^= wag %= $
- -.lig ?:(=(0 -.lig) 0 (dec -.lig))
- +.lig ?:(=(0 +.lig) 0 (dec +.lig))
- tub q.u.q.vex
- ==
- ?~ q.wag
- wag
- [p.wag [~ [p.u.q.vex p.u.q.wag] q.u.q.wag]]
- ::
- :: 4g: parsing (outside caller)
- +| %parsing-outside-caller
- ::
- ++ rash |*([naf=@ sab=rule] (scan (trip naf) sab))
- ++ rose |* [los=tape sab=rule]
- =+ vex=(sab [[1 1] los])
- =+ len=(lent los)
- ?. =(+(len) q.p.vex) [%| p=(dec q.p.vex)]
- ?~ q.vex
- [%& p=~]
- [%& p=[~ u=p.u.q.vex]]
- ++ rush |*([naf=@ sab=rule] (rust (trip naf) sab))
- ++ rust |* [los=tape sab=rule]
- =+ vex=((full sab) [[1 1] los])
- ?~(q.vex ~ [~ u=p.u.q.vex])
- ++ scan |* [los=tape sab=rule]
- =+ vex=((full sab) [[1 1] los])
- ?~ q.vex
- ~_ (show [%m '{%d %d}'] p.p.vex q.p.vex ~)
- ~_(leaf+"syntax error" !!)
- p.u.q.vex
- ::
- :: 4h: parsing (ascii glyphs)
- +| %parsing-ascii-glyphs
- ::
- ++ ace (just ' ') :: spACE
- ++ bar (just '|') :: vertical BAR
- ++ bas (just '\\') :: Back Slash (escaped)
- ++ buc (just '$') :: dollars BUCks
- ++ cab (just '_') :: CABoose
- ++ cen (just '%') :: perCENt
- ++ col (just ':') :: COLon
- ++ com (just ',') :: COMma
- ++ doq (just '"') :: Double Quote
- ++ dot (just '.') :: dot dot dot ...
- ++ fas (just '/') :: Forward Slash
- ++ gal (just '<') :: Greater Left
- ++ gar (just '>') :: Greater Right
- ++ hax (just '#') :: Hash
- ++ hep (just '-') :: HyPhen
- ++ kel (just '{') :: Curly Left
- ++ ker (just '}') :: Curly Right
- ++ ket (just '^') :: CareT
- ++ lus (just '+') :: pLUS
- ++ mic (just ';') :: seMIColon
- ++ pal (just '(') :: Paren Left
- ++ pam (just '&') :: AMPersand pampersand
- ++ par (just ')') :: Paren Right
- ++ pat (just '@') :: AT pat
- ++ sel (just '[') :: Square Left
- ++ ser (just ']') :: Square Right
- ++ sig (just '~') :: SIGnature squiggle
- ++ soq (just '\'') :: Single Quote
- ++ tar (just '*') :: sTAR
- ++ tic (just '`') :: backTiCk
- ++ tis (just '=') :: 'tis tis, it is
- ++ wut (just '?') :: wut, what?
- ++ zap (just '!') :: zap! bang! crash!!
- ::
- :: 4i: parsing (useful idioms)
- +| %parsing-useful-idioms
- ::
- ++ alf ;~(pose low hig) :: alphabetic
- ++ aln ;~(pose low hig nud) :: alphanumeric
- ++ alp ;~(pose low hig nud hep) :: alphanumeric and -
- ++ bet ;~(pose (cold 2 hep) (cold 3 lus)) :: axis syntax - +
- ++ bin (bass 2 (most gon but)) :: binary to atom
- ++ but (cook |=(a=@ (sub a '0')) (shim '0' '1')) :: binary digit
- ++ cit (cook |=(a=@ (sub a '0')) (shim '0' '7')) :: octal digit
- ++ dem (bass 10 (most gon dit)) :: decimal to atom
- ++ dit (cook |=(a=@ (sub a '0')) (shim '0' '9')) :: decimal digit
- ++ dog ;~(plug dot gay) :: . number separator
- ++ dof ;~(plug hep gay) :: - @q separator
- ++ doh ;~(plug ;~(plug hep hep) gay) :: -- phon separator
- ++ dun (cold ~ ;~(plug hep hep)) :: -- (stop) to ~
- ++ duz (cold ~ ;~(plug tis tis)) :: == (stet) to ~
- ++ gah (mask [`@`10 ' ' ~]) :: newline or ace
- ++ gap (cold ~ ;~(plug gaq (star ;~(pose vul gah)))) :: plural space
- ++ gaq ;~ pose :: end of line
- (just `@`10)
- ;~(plug gah ;~(pose gah vul))
- vul
- ==
- ++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white
- ++ gay ;~(pose gap (easy ~)) ::
- ++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ /
- ++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < >
- ++ hex (bass 16 (most gon hit)) :: hex to atom
- ++ hig (shim 'A' 'Z') :: uppercase
- ++ hit ;~ pose :: hex digits
- dit
- (cook |=(a=char (sub a 87)) (shim 'a' 'f'))
- (cook |=(a=char (sub a 55)) (shim 'A' 'F'))
- ==
- ++ iny :: indentation block
- |* sef=rule
- |= nail ^+ (sef)
- =+ [har tap]=[p q]:+<
- =+ lev=(fil 3 (dec q.har) ' ')
- =+ eol=(just `@t`10)
- =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
- ;~(simu ;~(plug eol eol) eol)
- ?~ q.roq roq
- =+ vex=(sef har(q 1) p.u.q.roq)
- =+ fur=p.vex(q (add (dec q.har) q.p.vex))
- ?~ q.vex vex(p fur)
- =- vex(p fur, u.q -)
- :+ &3.vex
- &4.vex(q.p (add (dec q.har) q.p.&4.vex))
- =+ res=|4.vex
- |- ?~ res |4.roq
- ?. =(10 -.res) [-.res $(res +.res)]
- (welp [`@t`10 (trip lev)] $(res +.res))
- ::
- ++ low (shim 'a' 'z') :: lowercase
- ++ mes %+ cook :: hexbyte
- |=([a=@ b=@] (add (mul 16 a) b))
- ;~(plug hit hit)
- ++ nix (boss 256 (star ;~(pose aln cab))) ::
- ++ nud (shim '0' '9') :: numeric
- ++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control
- ++ qat ;~ pose :: chars in blockcord
- prn
- ;~(less ;~(plug (just `@`10) soz) (just `@`10))
- ==
- ++ qit ;~ pose :: chars in a cord
- ;~(less bas soq prn)
- ;~(pfix bas ;~(pose bas soq mes)) :: escape chars
- ==
- ++ qut ;~ simu soq :: cord
- ;~ pose
- ;~ less soz
- (ifix [soq soq] (boss 256 (more gon qit)))
- ==
- =+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a'))
- %- iny %+ ifix
- :- ;~(plug soz hed)
- ;~(plug (just '\0a') soz)
- (boss 256 (star qat))
- ==
- ==
- ++ soz ;~(plug soq soq soq) :: delimiting '''
- ++ sym :: symbol
- %+ cook
- |=(a=tape (rap 3 ^-((list @) a)))
- ;~(plug low (star ;~(pose nud low hep)))
- ::
- ++ mixed-case-symbol
- %+ cook
- |=(a=tape (rap 3 ^-((list @) a)))
- ;~(plug alf (star alp))
- ::
- ++ ven ;~ (comp |=([a=@ b=@] (peg a b))) :: +>- axis syntax
- bet
- =+ hom=`?`|
- |= tub=nail
- ^- (like @)
- =+ vex=?:(hom (bet tub) (gul tub))
- ?~ q.vex
- [p.tub [~ 1 tub]]
- =+ wag=$(p.tub p.vex, hom !hom, tub q.u.q.vex)
- ?> ?=(^ q.wag)
- [p.wag [~ (peg p.u.q.vex p.u.q.wag) q.u.q.wag]]
- ==
- ++ vit :: base64 digit
- ;~ pose
- (cook |=(a=@ (sub a 65)) (shim 'A' 'Z'))
- (cook |=(a=@ (sub a 71)) (shim 'a' 'z'))
- (cook |=(a=@ (add a 4)) (shim '0' '9'))
- (cold 62 (just '-'))
- (cold 63 (just '+'))
- ==
- ++ vul %+ cold ~ :: comments
- ;~ plug col col
- (star prn)
- (just `@`10)
- ==
- ::
- :: 4j: parsing (bases and base digits)
- +| %parsing-bases-and-base-digits
- ::
- ++ ab
- |%
- ++ bix (bass 16 (stun [2 2] six))
- ++ fem (sear |=(a=@ (cha:fa a)) aln)
- ++ haf (bass 256 ;~(plug tep tiq (easy ~)))
- ++ hef %+ sear |=(a=@ ?:(=(a 0) ~ (some a)))
- %+ bass 256
- ;~(plug tip tiq (easy ~))
- ++ hif (bass 256 ;~(plug tip tiq (easy ~)))
- ++ hof (bass 0x1.0000 ;~(plug hef (stun [1 3] ;~(pfix hep hif))))
- ++ huf (bass 0x1.0000 ;~(plug hef (stun [0 3] ;~(pfix hep hif))))
- ++ hyf (bass 0x1.0000 ;~(plug hif (stun [3 3] ;~(pfix hep hif))))
- ++ pev (bass 32 ;~(plug sev (stun [0 4] siv)))
- ++ pew (bass 64 ;~(plug sew (stun [0 4] siw)))
- ++ piv (bass 32 (stun [5 5] siv))
- ++ piw (bass 64 (stun [5 5] siw))
- ++ qeb (bass 2 ;~(plug seb (stun [0 3] sib)))
- ++ qex (bass 16 ;~(plug sex (stun [0 3] hit)))
- ++ qib (bass 2 (stun [4 4] sib))
- ++ qix (bass 16 (stun [4 4] six))
- ++ seb (cold 1 (just '1'))
- ++ sed (cook |=(a=@ (sub a '0')) (shim '1' '9'))
- ++ sev ;~(pose sed sov)
- ++ sew ;~(pose sed sow)
- ++ sex ;~(pose sed sox)
- ++ sib (cook |=(a=@ (sub a '0')) (shim '0' '1'))
- ++ sid (cook |=(a=@ (sub a '0')) (shim '0' '9'))
- ++ siv ;~(pose sid sov)
- ++ siw ;~(pose sid sow)
- ++ six ;~(pose sid sox)
- ++ sov (cook |=(a=@ (sub a 87)) (shim 'a' 'v'))
- ++ sow ;~ pose
- (cook |=(a=@ (sub a 87)) (shim 'a' 'z'))
- (cook |=(a=@ (sub a 29)) (shim 'A' 'Z'))
- (cold 62 (just '-'))
- (cold 63 (just '~'))
- ==
- ++ sox (cook |=(a=@ (sub a 87)) (shim 'a' 'f'))
- ++ ted (bass 10 ;~(plug sed (stun [0 2] sid)))
- ++ tep (sear |=(a=@ ?:(=(a 'doz') ~ (ins:po a))) til)
- ++ tip (sear |=(a=@ (ins:po a)) til)
- ++ tiq (sear |=(a=@ (ind:po a)) til)
- ++ tid (bass 10 (stun [3 3] sid))
- ++ til (boss 256 (stun [3 3] low))
- ++ urs %+ cook
- |=(a=tape (rap 3 ^-((list @) a)))
- (star ;~(pose nud low hep dot sig cab))
- ++ urt %+ cook
- |=(a=tape (rap 3 ^-((list @) a)))
- (star ;~(pose nud low hep dot sig))
- ++ urx %+ cook
- |=(a=tape (rap 3 ^-((list @) a)))
- %- star
- ;~ pose
- nud
- low
- hep
- cab
- (cold ' ' dot)
- (cook tuft (ifix [sig dot] hex))
- ;~(pfix sig ;~(pose sig dot))
- ==
- ++ voy ;~(pfix bas ;~(pose bas soq bix))
- --
- ++ ag
- |%
- ++ ape |*(fel=rule ;~(pose (cold `@`0 (just '0')) fel))
- ++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab)))))
- ++ bip =+ tod=(ape qex:ab)
- (bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod))))
- ++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab)))))
- ++ dim (ape dip)
- ++ dip (bass 10 ;~(plug sed:ab (star sid:ab)))
- ++ dum (bass 10 (plus sid:ab))
- ++ fed %+ cook fynd:ob
- ;~ pose
- %+ bass 0x1.0000.0000.0000.0000 :: oversized
- ;~ plug
- huf:ab
- (plus ;~(pfix doh hyf:ab))
- ==
- hof:ab :: planet or moon
- haf:ab :: star
- tiq:ab :: galaxy
- ==
- ++ feq %+ cook |=(a=(list @) (rep 4 (flop a)))
- ;~ plug
- ;~(pose hif:ab tiq:ab)
- (star ;~(pfix dof hif:ab))
- ==
- ++ fim (sear den:fa (bass 58 (plus fem:ab)))
- ++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab)))))
- ++ lip =+ tod=(ape ted:ab)
- (bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod))))
- ++ mot ;~ pose
- ;~ pfix
- (just '1')
- (cook |=(a=@ (add 10 (sub a '0'))) (shim '0' '2'))
- ==
- sed:ab
- ==
- ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab)))))
- ++ vum (bass 32 (plus siv:ab))
- ++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab)))))
- --
- ++ mu
- |_ [top=@ bot=@]
- ++ zag [p=(end 4 (add top bot)) q=bot]
- ++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot]
- ++ zug (mix (lsh 4 top) bot)
- --
- ++ ne
- |_ tig=@
- ++ c (cut 3 [tig 1] key:fa)
- ++ d (add tig '0')
- ++ x ?:((gte tig 10) (add tig 87) d)
- ++ v ?:((gte tig 10) (add tig 87) d)
- ++ w ?:(=(tig 63) '~' ?:(=(tig 62) '-' ?:((gte tig 36) (add tig 29) x)))
- --
- ::
- :: 4k: atom printing
- +| %atom-printing
- ::
- ++ co
- !:
- ~% %co ..co ~
- =< |_ lot=coin
- ++ rear |=(rom=tape rend(rep rom))
- ++ rent ~+ `@ta`(rap 3 rend)
- ++ rend
- ^- tape
- ~+
- ?: ?=(%blob -.lot)
- ['~' '0' ((v-co 1) (jam p.lot))]
- ?: ?=(%many -.lot)
- :- '.'
- |- ^- tape
- ?~ p.lot
- ['_' '_' rep]
- ['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))]
- =+ [yed=(end 3 p.p.lot) hay=(cut 3 [1 1] p.p.lot)]
- |- ^- tape
- ?+ yed (z-co q.p.lot)
- %c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)]
- %d
- ?+ hay (z-co q.p.lot)
- %a
- =+ yod=(yore q.p.lot)
- =? rep ?=(^ f.t.yod) ['.' (s-co f.t.yod)]
- =? rep !&(?=(~ f) =(0 h) =(0 m) =(0 s)):t.yod
- =. rep ['.' (y-co s.t.yod)]
- =. rep ['.' (y-co m.t.yod)]
- ['.' '.' (y-co h.t.yod)]
- =. rep ['.' (a-co d.t.yod)]
- =. rep ['.' (a-co m.yod)]
- =? rep !a.yod ['-' rep]
- ['~' (a-co y.yod)]
- ::
- %r
- =+ yug=(yell q.p.lot)
- =? rep ?=(^ f.yug) ['.' (s-co f.yug)]
- :- '~'
- ?: &(=(0 d.yug) =(0 m.yug) =(0 h.yug) =(0 s.yug))
- ['s' '0' rep]
- =? rep !=(0 s.yug) ['.' 's' (a-co s.yug)]
- =? rep !=(0 m.yug) ['.' 'm' (a-co m.yug)]
- =? rep !=(0 h.yug) ['.' 'h' (a-co h.yug)]
- =? rep !=(0 d.yug) ['.' 'd' (a-co d.yug)]
- +.rep
- ==
- ::
- %f
- ?: =(& q.p.lot)
- ['.' 'y' rep]
- ?:(=(| q.p.lot) ['.' 'n' rep] (z-co q.p.lot))
- ::
- %n ['~' rep]
- %i
- ?+ hay (z-co q.p.lot)
- %f ((ro-co [3 10 4] |=(a=@ ~(d ne a))) q.p.lot)
- %s ((ro-co [4 16 8] |=(a=@ ~(x ne a))) q.p.lot)
- ==
- ::
- %p
- =+ sxz=(fein:ob q.p.lot)
- =+ dyx=(met 3 sxz)
- :- '~'
- ?: (lte dyx 1)
- (weld (trip (tod:po sxz)) rep)
- =+ dyy=(met 4 sxz)
- =| imp=@ud
- |- ^- tape
- ?: =(imp dyy)
- rep
- %= $
- imp +(imp)
- rep =/ log (cut 4 [imp 1] sxz)
- ;: weld
- (trip (tos:po (rsh 3 log)))
- (trip (tod:po (end 3 log)))
- ?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-")
- rep
- == ==
- ::
- %q
- :+ '.' '~'
- =; res=(pair ? tape)
- (weld q.res rep)
- %+ roll
- =* val q.p.lot
- ?:(=(0 val) ~[0] (rip 3 val))
- |= [q=@ s=? r=tape]
- :- !s
- %+ weld
- (trip (?:(s tod:po tos:po) q))
- ?.(&(s !=(r "")) r ['-' r])
- ::
- %r
- ?+ hay (z-co q.p.lot)
- %d ['.' '~' (r-co (rlyd q.p.lot))]
- %h ['.' '~' '~' (r-co (rlyh q.p.lot))]
- %q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))]
- %s ['.' (r-co (rlys q.p.lot))]
- ==
- ::
- %u
- ?: ?=(%c hay)
- %+ welp ['0' 'c' (reap (pad:fa q.p.lot) '1')]
- (c-co (enc:fa q.p.lot))
- ::
- =; gam=(pair tape tape)
- (weld p.gam ?:(=(0 q.p.lot) `tape`['0' ~] q.gam))
- ?+ hay [~ ((ox-co [10 3] |=(a=@ ~(d ne a))) q.p.lot)]
- %b [['0' 'b' ~] ((ox-co [2 4] |=(a=@ ~(d ne a))) q.p.lot)]
- %i [['0' 'i' ~] ((d-co 1) q.p.lot)]
- %x [['0' 'x' ~] ((ox-co [16 4] |=(a=@ ~(x ne a))) q.p.lot)]
- %v [['0' 'v' ~] ((ox-co [32 5] |=(a=@ ~(x ne a))) q.p.lot)]
- %w [['0' 'w' ~] ((ox-co [64 5] |=(a=@ ~(w ne a))) q.p.lot)]
- ==
- ::
- %s
- %+ weld
- ?:((syn:si q.p.lot) "--" "-")
- $(yed 'u', q.p.lot (abs:si q.p.lot))
- ::
- %t
- ?: =('a' hay)
- ?: =('s' (cut 3 [2 1] p.p.lot))
- (weld (rip 3 q.p.lot) rep)
- ['~' '.' (weld (rip 3 q.p.lot) rep)]
- ['~' '~' (weld (rip 3 (wood q.p.lot)) rep)]
- ==
- --
- =| rep=tape
- =< |%
- :: rendering idioms, output zero-padded to minimum lengths
- ::
- :: +a-co: decimal
- :: +c-co: base58check
- :: +d-co: decimal, takes minimum output digits
- :: +r-co: floating point
- :: +s-co: list of '.'-prefixed base16, 4 digit minimum
- :: +v-co: base32, takes minimum output digits
- :: +w-co: base64, takes minimum output digits
- :: +x-co: base16, takes minimum output digits
- :: +y-co: decimal, 2 digit minimum
- :: +z-co: '0x'-prefixed base16
- ::
- ++ a-co |=(dat=@ ((d-co 1) dat))
- ++ c-co (em-co [58 1] |=([? b=@ c=tape] [~(c ne b) c]))
- ++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c])))
- ::
- ++ r-co
- |= a=dn
- ?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rep)
- ?: ?=([%n *] a) (weld "nan" rep)
- =; rep ?:(s.a rep ['-' rep])
- =/ f ((d-co 1) a.a)
- =^ e e.a
- =/ e=@s (sun:si (lent f))
- =/ sci :(sum:si e.a e -1)
- ?: (syn:si (dif:si e.a --3)) [--1 sci] :: 12000 -> 12e3 e>+2
- ?: !(syn:si (dif:si sci -2)) [--1 sci] :: 0.001 -> 1e-3 e<-2
- [(sum:si sci --1) --0] :: 1.234e2 -> '.'@3 -> 123 .4
- =? rep !=(--0 e.a)
- :(weld ?:((syn:si e.a) "e" "e-") ((d-co 1) (abs:si e.a)))
- (weld (ed-co e f) rep)
- ::
- ++ s-co
- |= esc=(list @) ^- tape
- ?~ esc rep
- ['.' =>(.(rep $(esc t.esc)) ((x-co 4) i.esc))]
- ::
- ++ v-co |=(min=@ (em-co [32 min] |=([? b=@ c=tape] [~(v ne b) c])))
- ++ w-co |=(min=@ (em-co [64 min] |=([? b=@ c=tape] [~(w ne b) c])))
- ++ x-co |=(min=@ (em-co [16 min] |=([? b=@ c=tape] [~(x ne b) c])))
- ++ y-co |=(dat=@ ((d-co 2) dat))
- ++ z-co |=(dat=@ `tape`['0' 'x' ((x-co 1) dat)])
- --
- |%
- :: +em-co: format in numeric base
- ::
- :: in .bas, format .min digits of .hol with .par
- ::
- :: - .hol is processed least-significant digit first
- :: - all available digits in .hol will be processed, but
- :: .min digits can exceed the number available in .hol
- :: - .par handles all accumulated output on each call,
- :: and can edit it, prepend or append digits, &c
- :: - until .hol is exhausted, .par's sample is [| digit output],
- :: subsequently, it's [& 0 output]
- ::
- ++ em-co
- |= [[bas=@ min=@] par=$-([? @ tape] tape)]
- |= hol=@
- ^- tape
- ?: &(=(0 hol) =(0 min))
- rep
- =/ [dar=@ rad=@] (dvr hol bas)
- %= $
- min ?:(=(0 min) 0 (dec min))
- hol dar
- rep (par =(0 dar) rad rep)
- ==
- ::
- :: +ed-co: format in numeric base, with output length
- ::
- :: - like +em-co, but .par's sample will be [| digit output]
- :: on the first call, regardless of the available digits in .hol
- :: - used only for @r* floats
- ::
- ++ ed-co
- |= [exp=@s int=tape] ^- tape
- =/ [pos=? dig=@u] [=(--1 (cmp:si exp --0)) (abs:si exp)]
- ?. pos
- (into (weld (reap +(dig) '0') int) 1 '.')
- =/ len (lent int)
- ?: (lth dig len) (into int dig '.')
- (weld int (reap (sub dig len) '0'))
- ::
- :: +ox-co: format '.'-separated digit sequences in numeric base
- ::
- :: in .bas, format each digit of .hol with .dug,
- :: with '.' separators every .gop digits.
- ::
- :: - .hol is processed least-significant digit first
- :: - .dug handles individual digits, output is prepended
- :: - every segment but the last is zero-padded to .gop
- ::
- ++ ox-co
- |= [[bas=@ gop=@] dug=$-(@ @)]
- %+ em-co
- [(pow bas gop) 0]
- |= [top=? seg=@ res=tape]
- %+ weld
- ?:(top ~ `tape`['.' ~])
- %. seg
- %+ em-co(rep res)
- [bas ?:(top 0 gop)]
- |=([? b=@ c=tape] [(dug b) c])
- ::
- :: +ro-co: format '.'-prefixed bloqs in numeric base
- ::
- :: in .bas, for .buz bloqs 0 to .dop, format at least one
- :: digit of .hol, prefixed with '.'
- ::
- :: - used only for @i* addresses
- ::
- ++ ro-co
- |= [[buz=@ bas=@ dop=@] dug=$-(@ @)]
- |= hol=@
- ^- tape
- ?: =(0 dop)
- rep
- :- '.'
- =/ pod (dec dop)
- %. (cut buz [pod 1] hol)
- %+ em-co(rep $(dop pod))
- [bas 1]
- |=([? b=@ c=tape] [(dug b) c])
- --
- ::
- :: 4l: atom parsing
- +| %atom-parsing
- ::
- ++ so
- ~% %so + ~
- |%
- ++ bisk
- ~+
- ;~ pose
- ;~ pfix (just '0')
- ;~ pose
- (stag %ub ;~(pfix (just 'b') bay:ag))
- (stag %uc ;~(pfix (just 'c') fim:ag))
- (stag %ui ;~(pfix (just 'i') dim:ag))
- (stag %ux ;~(pfix (just 'x') hex:ag))
- (stag %uv ;~(pfix (just 'v') viz:ag))
- (stag %uw ;~(pfix (just 'w') wiz:ag))
- ==
- ==
- (stag %ud dem:ag)
- ==
- ++ crub
- ~+
- ;~ pose
- (cook |=(det=date `dime`[%da (year det)]) when)
- ::
- %+ cook
- |= [a=(list [p=?(%d %h %m %s) q=@]) b=(list @)]
- =+ rop=`tarp`[0 0 0 0 b]
- |- ^- dime
- ?~ a
- [%dr (yule rop)]
- ?- p.i.a
- %d $(a t.a, d.rop (add q.i.a d.rop))
- %h $(a t.a, h.rop (add q.i.a h.rop))
- %m $(a t.a, m.rop (add q.i.a m.rop))
- %s $(a t.a, s.rop (add q.i.a s.rop))
- ==
- ;~ plug
- %+ most
- dot
- ;~ pose
- ;~(pfix (just 'd') (stag %d dim:ag))
- ;~(pfix (just 'h') (stag %h dim:ag))
- ;~(pfix (just 'm') (stag %m dim:ag))
- ;~(pfix (just 's') (stag %s dim:ag))
- ==
- ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
- ==
- ::
- (stag %p fed:ag)
- ;~(pfix dot (stag %ta urs:ab))
- ;~(pfix sig (stag %t urx:ab))
- ;~(pfix hep (stag %c (cook taft urx:ab)))
- ==
- ++ nuck
- ~/ %nuck |= a=nail %. a
- %+ knee *coin |. ~+
- %- stew
- ^. stet ^. limo
- :~ :- ['a' 'z'] (cook |=(a=@ta [%$ %tas a]) sym)
- :- ['0' '9'] (stag %$ bisk)
- :- '-' (stag %$ tash)
- :- '.' ;~(pfix dot perd)
- :- '~' ;~(pfix sig ;~(pose twid (easy [%$ %n 0])))
- ==
- ++ nusk
- ~+
- :(sear |=(a=@ta (rush a nuck)) wick urt:ab)
- ++ perd
- ~+
- ;~ pose
- (stag %$ zust)
- (stag %many (ifix [cab ;~(plug cab cab)] (more cab nusk)))
- ==
- ++ royl
- ~+
- ;~ pose
- (stag %rh royl-rh)
- (stag %rq royl-rq)
- (stag %rd royl-rd)
- (stag %rs royl-rs)
- ==
- ::
- ++ royl-rh (cook rylh ;~(pfix ;~(plug sig sig) (cook royl-cell royl-rn)))
- ++ royl-rq (cook rylq ;~(pfix ;~(plug sig sig sig) (cook royl-cell royl-rn)))
- ++ royl-rd (cook ryld ;~(pfix sig (cook royl-cell royl-rn)))
- ++ royl-rs (cook ryls (cook royl-cell royl-rn))
- ::
- ++ royl-rn
- =/ moo
- |= a=tape
- :- (lent a)
- (scan a (bass 10 (plus sid:ab)))
- ;~ pose
- ;~ plug
- (easy %d)
- ;~(pose (cold | hep) (easy &))
- ;~ plug dim:ag
- ;~ pose
- ;~(pfix dot (cook moo (plus (shim '0' '9'))))
- (easy [0 0])
- ==
- ;~ pose
- ;~ pfix
- (just 'e')
- ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag)
- ==
- (easy [& 0])
- ==
- ==
- ==
- ::
- ;~ plug
- (easy %i)
- ;~ sfix
- ;~(pose (cold | hep) (easy &))
- (jest 'inf')
- ==
- ==
- ::
- ;~ plug
- (easy %n)
- (cold ~ (jest 'nan'))
- ==
- ==
- ::
- ++ royl-cell
- |= rn
- ^- dn
- ?. ?=([%d *] +<) +<
- =+ ^= h
- (dif:si (new:si f.b i.b) (sun:si d.b))
- [%d a h (add (mul c.b (pow 10 d.b)) e.b)]
- ::
- ++ tash
- ~+
- =+ ^= neg
- |= [syn=? mol=dime] ^- dime
- ?> =('u' (end 3 p.mol))
- [(cat 3 's' (rsh 3 p.mol)) (new:si syn q.mol)]
- ;~ pfix hep
- ;~ pose
- (cook |=(a=dime (neg | a)) bisk)
- ;~(pfix hep (cook |=(a=dime (neg & a)) bisk))
- ==
- ==
- ::
- ++ twid
- ~+
- ;~ pose
- %+ stag %blob
- %+ sear |=(a=@ (mole |.((cue a))))
- ;~(pfix (just '0') vum:ag)
- ::
- (stag %$ crub)
- ==
- ::
- ++ when
- ~+
- ;~ plug
- %+ cook
- |=([a=@ b=?] [b a])
- ;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
- ;~(pfix dot mot:ag) :: month
- ;~(pfix dot dip:ag) :: day
- ;~ pose
- ;~ pfix
- ;~(plug dot dot)
- ;~ plug
- dum:ag
- ;~(pfix dot dum:ag)
- ;~(pfix dot dum:ag)
- ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
- ==
- ==
- (easy [0 0 0 ~])
- ==
- ==
- ::
- ++ zust
- ~+
- ;~ pose
- (stag %is bip:ag)
- (stag %if lip:ag)
- royl
- (stag %f ;~(pose (cold & (just 'y')) (cold | (just 'n'))))
- (stag %q ;~(pfix sig feq:ag))
- ==
- --
- ::
- :: 4m: formatting functions
- +| %formatting-functions
- ++ scot
- ~/ %scot
- |=(mol=dime ~(rent co %$ mol))
- ++ scow
- ~/ %scow
- |=(mol=dime ~(rend co %$ mol))
- ++ slat |=(mod=@tas |=(txt=@ta (slaw mod txt)))
- ++ slav |=([mod=@tas txt=@ta] (need (slaw mod txt)))
- ++ slaw
- ~/ %slaw
- |= [mod=@tas txt=@ta]
- ^- (unit @)
- ?+ mod
- :: slow fallback case to the full slay
- ::
- =+ con=(slay txt)
- ?.(&(?=([~ %$ @ @] con) =(p.p.u.con mod)) ~ [~ q.p.u.con])
- ::
- %da
- (rush txt ;~(pfix sig (cook year when:so)))
- ::
- %p
- (rush txt ;~(pfix sig fed:ag))
- ::
- %ud
- (rush txt dem:ag)
- ::
- %ux
- (rush txt ;~(pfix (jest '0x') hex:ag))
- ::
- %uv
- (rush txt ;~(pfix (jest '0v') viz:ag))
- ::
- %ta
- (rush txt ;~(pfix ;~(plug sig dot) urs:ab))
- ::
- %tas
- (rush txt sym)
- ==
- ::
- ++ slay
- |= txt=@ta ^- (unit coin)
- =+ ^= vex
- ?: (gth 0x7fff.ffff txt) :: XX petty cache
- ~+ ((full nuck:so) [[1 1] (trip txt)])
- ((full nuck:so) [[1 1] (trip txt)])
- ?~ q.vex
- ~
- [~ p.u.q.vex]
- ::
- ++ smyt :: pretty print path
- |= bon=path ^- tank
- :+ %rose [['/' ~] ['/' ~] ~]
- (turn bon |=(a=@ [%leaf (trip a)]))
- ::
- ++ spat |=(pax=path (crip (spud pax))) :: render path to cord
- ++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape
- ++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path
- ++ stap :: path parser
- %+ sear
- |= p=path
- ^- (unit path)
- ?: ?=([~ ~] p) `~
- ?. =(~ (rear p)) `p
- ~
- ;~(pfix fas (most fas urs:ab))
- ::
- ++ stip :: typed path parser
- =< swot
- |%
- ++ swot |=(n=nail (;~(pfix fas (more fas spot)) n))
- ::
- ++ spot
- %+ sear (soft iota)
- %- stew
- ^. stet ^. limo
- :~ :- 'a'^'z' (stag %tas sym)
- :- '$' (cold [%tas %$] buc)
- :- '0'^'9' bisk:so
- :- '-' tash:so
- :- '.' zust:so
- :- '~' ;~(pfix sig ;~(pose crub:so (easy [%n ~])))
- :- '\'' (stag %t qut)
- ==
- --
- ::
- ++ pout
- |= =pith
- ^- path
- %+ turn pith
- |= i=iota
- ?@(i i (scot i))
- ::
- ++ pave
- |= =path
- ^- pith
- %+ turn path
- |= i=@ta
- (fall (rush i spot:stip) [%ta i])
- ::
- :: 4n: virtualization
- +| %virtualization
- ::
- :: +mack: untyped, scry-less, unitary virtualization
- ::
- ++ mack
- |= [sub=* fol=*]
- ^- (unit)
- =/ ton (mink [sub fol] |~(^ ~))
- ?.(?=(%0 -.ton) ~ `product.ton)
- :: +mink: raw virtual nock
- ::
- ++ mink !.
- ~/ %mink
- |= $: [subject=* formula=*]
- scry=$-(^ (unit (unit)))
- ==
- =| trace=(list [@ta *])
- |^ ^- tone
- ?+ formula [%2 trace]
- [^ *]
- =/ head $(formula -.formula)
- ?. ?=(%0 -.head) head
- =/ tail $(formula +.formula)
- ?. ?=(%0 -.tail) tail
- [%0 product.head product.tail]
- ::
- [%0 axis=@]
- =/ part (frag axis.formula subject)
- ?~ part [%2 trace]
- [%0 u.part]
- ::
- [%1 constant=*]
- [%0 constant.formula]
- ::
- [%2 subject=* formula=*]
- =/ subject $(formula subject.formula)
- ?. ?=(%0 -.subject) subject
- =/ formula $(formula formula.formula)
- ?. ?=(%0 -.formula) formula
- %= $
- subject product.subject
- formula product.formula
- ==
- ::
- [%3 argument=*]
- =/ argument $(formula argument.formula)
- ?. ?=(%0 -.argument) argument
- [%0 .?(product.argument)]
- ::
- [%4 argument=*]
- =/ argument $(formula argument.formula)
- ?. ?=(%0 -.argument) argument
- ?^ product.argument [%2 trace]
- [%0 .+(product.argument)]
- ::
- [%5 a=* b=*]
- =/ a $(formula a.formula)
- ?. ?=(%0 -.a) a
- =/ b $(formula b.formula)
- ?. ?=(%0 -.b) b
- [%0 =(product.a product.b)]
- ::
- [%6 test=* yes=* no=*]
- =/ result $(formula test.formula)
- ?. ?=(%0 -.result) result
- ?+ product.result
- [%2 trace]
- %& $(formula yes.formula)
- %| $(formula no.formula)
- ==
- ::
- [%7 subject=* next=*]
- =/ subject $(formula subject.formula)
- ?. ?=(%0 -.subject) subject
- %= $
- subject product.subject
- formula next.formula
- ==
- ::
- [%8 head=* next=*]
- =/ head $(formula head.formula)
- ?. ?=(%0 -.head) head
- %= $
- subject [product.head subject]
- formula next.formula
- ==
- ::
- [%9 axis=@ core=*]
- =/ core $(formula core.formula)
- ?. ?=(%0 -.core) core
- =/ arm (frag axis.formula product.core)
- ?~ arm [%2 trace]
- %= $
- subject product.core
- formula u.arm
- ==
- ::
- [%10 [axis=@ value=*] target=*]
- ?: =(0 axis.formula) [%2 trace]
- =/ target $(formula target.formula)
- ?. ?=(%0 -.target) target
- =/ value $(formula value.formula)
- ?. ?=(%0 -.value) value
- =/ mutant=(unit *)
- (edit axis.formula product.target product.value)
- ?~ mutant [%2 trace]
- [%0 u.mutant]
- ::
- [%11 tag=@ next=*]
- =/ next $(formula next.formula)
- ?. ?=(%0 -.next) next
- :- %0
- .* subject
- [11 tag.formula 1 product.next]
- ::
- [%11 [tag=@ clue=*] next=*]
- =/ clue $(formula clue.formula)
- ?. ?=(%0 -.clue) clue
- =/ next
- =? trace
- ?=(?(%hunk %hand %lose %mean %spot) tag.formula)
- [[tag.formula product.clue] trace]
- $(formula next.formula)
- ?. ?=(%0 -.next) next
- :- %0
- .* subject
- [11 [tag.formula 1 product.clue] 1 product.next]
- ::
- [%12 ref=* path=*]
- =/ ref $(formula ref.formula)
- ?. ?=(%0 -.ref) ref
- =/ path $(formula path.formula)
- ?. ?=(%0 -.path) path
- =/ result (scry product.ref product.path)
- ?~ result
- [%1 product.path]
- ?~ u.result
- [%2 [%hunk product.ref product.path] trace]
- [%0 u.u.result]
- ==
- ::
- ++ frag
- |= [axis=@ noun=*]
- ^- (unit)
- ?: =(0 axis) ~
- |- ^- (unit)
- ?: =(1 axis) `noun
- ?@ noun ~
- =/ pick (cap axis)
- %= $
- axis (mas axis)
- noun ?-(pick %2 -.noun, %3 +.noun)
- ==
- ::
- ++ edit
- |= [axis=@ target=* value=*]
- ^- (unit)
- ?: =(1 axis) `value
- ?@ target ~
- =/ pick (cap axis)
- =/ mutant
- %= $
- axis (mas axis)
- target ?-(pick %2 -.target, %3 +.target)
- ==
- ?~ mutant ~
- ?- pick
- %2 `[u.mutant +.target]
- %3 `[-.target u.mutant]
- ==
- --
- :: +mock: virtual nock
- ::
- ++ mock
- |= [[sub=* fol=*] gul=$-(^ (unit (unit)))]
- (mook (mink [sub fol] gul))
- :: +mook: convert %tone to %toon, rendering stack frames
- ::
- ++ mook
- |= ton=tone
- ^- toon
- ?. ?=([%2 *] ton)
- ton
- |^ [%2 (turn skip rend)]
- ::
- ++ skip
- ^+ trace.ton
- =/ yel (lent trace.ton)
- ?. (gth yel 1.024) trace.ton
- %+ weld
- (scag 512 trace.ton)
- ^+ trace.ton
- :_ (slag (sub yel 512) trace.ton)
- :- %lose
- (crip "[skipped {(scow %ud (sub yel 1.024))} frames]")
- ::
- :: +rend: raw stack frame to tank
- ::
- :: $% [%hunk ref=* path] :: failed scry ([~ ~])
- :: [%lose cord] :: skipped frames
- :: [%hand *] :: mug any
- :: [%mean $@(cord (trap tank))] :: ~_ et al
- :: [%spot spot] :: source location
- :: ==
- ::
- ++ rend
- |= [tag=@ta dat=*]
- ^- tank
- ?+ tag
- ::
- leaf+"mook.{(rip 3 tag)}"
- ::
- %hunk
- ?@ dat leaf+"mook.hunk"
- =/ sof=(unit path) ((soft path) +.dat)
- ?~ sof leaf+"mook.hunk"
- (smyt u.sof)
- ::
- %lose
- ?^ dat leaf+"mook.lose"
- leaf+(rip 3 dat)
- ::
- %hand
- leaf+(scow %p (mug dat))
- ::
- %mean
- ?@ dat leaf+(rip 3 dat)
- =/ mac (mack dat -.dat)
- ?~ mac leaf+"####"
- =/ sof ((soft tank) u.mac)
- ?~ sof leaf+"mook.mean"
- u.sof
- ::
- %spot
- =/ sof=(unit spot) ((soft spot) dat)
- ?~ sof leaf+"mook.spot"
- :+ %rose [":" ~ ~]
- :~ (smyt p.u.sof)
- =* l p.q.u.sof
- =* r q.q.u.sof
- =/ ud |=(a=@u (scow %ud a))
- leaf+"<[{(ud p.l)} {(ud q.l)}].[{(ud p.r)} {(ud q.r)}]>"
- ==
- ==
- --
- :: +mole: typed unitary virtual
- ::
- ++ mole
- ~/ %mole
- |* tap=(trap)
- ^- (unit _$:tap)
- =/ mur (mure tap)
- ?~(mur ~ `$:tap)
- :: +mong: virtual slam
- ::
- ++ mong
- |= [[gat=* sam=*] gul=$-(^ (unit (unit)))]
- ^- toon
- ?. ?=([* ^] gat) [%2 ~]
- (mock [gat(+< sam) %9 2 %0 1] gul)
- :: +mule: typed virtual
- ::
- ++ mule
- ~/ %mule
- |* tap=(trap)
- =/ mud (mute tap)
- ?- -.mud
- %& [%& p=$:tap]
- %| [%| p=p.mud]
- ==
- :: +mure: untyped unitary virtual
- ::
- ++ mure
- |= tap=(trap)
- ^- (unit)
- =/ ton (mink [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3])))
- ?.(?=(%0 -.ton) ~ `product.ton)
- :: +mute: untyped virtual
- ::
- ++ mute
- |= tap=(trap)
- ^- (each * (list tank))
- =/ ton (mock [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3])))
- ?- -.ton
- %0 [%& p.ton]
- ::
- %1 =/ sof=(unit path) ((soft path) p.ton)
- [%| ?~(sof leaf+"mute.hunk" (smyt u.sof)) ~]
- ::
- %2 [%| p.ton]
- ==
- :: +slum: slam a gate on a sample using raw nock, untyped
- ::
- ++ slum
- ~/ %slum
- |= sub=[gat=* sam=*]
- .*(sub [%9 2 %10 [6 %0 3] %0 2])
- :: +soft: virtual clam
- ::
- ++ soft
- |* han=$-(* *)
- |=(fud=* (mole |.((han fud))))
- ::
- :: 4o: molds and mold builders
- +| %molds-and-mold-builders
- ::
- +$ abel typo :: original sin: type
- +$ alas (list (pair term hoon)) :: alias list
- +$ atom @ :: just an atom
- +$ aura @ta :: atom format
- +$ base :: base mold
- $@ $? %noun :: any noun
- %cell :: any cell
- %flag :: loobean
- %null :: ~ == 0
- %void :: empty set
- == ::
- [%atom p=aura] :: atom
- ::
- +$ woof $@(@ [~ p=hoon]) :: simple embed
- +$ chum $? lef=term :: jet name
- [std=term kel=@] :: kelvin version
- [ven=term pro=term kel=@] :: vendor and product
- [ven=term pro=term ver=@ kel=@] :: all of the above
- == ::
- +$ coil $: p=garb :: name, wet=dry, vary
- q=type :: context
- r=(pair seminoun (map term tome)) :: chapters
- == ::
- +$ garb (trel (unit term) poly vair) :: core
- +$ poly ?(%wet %dry) :: polarity
- +$ foot $% [%dry p=hoon] :: dry arm, geometric
- [%wet p=hoon] :: wet arm, generic
- == ::
- +$ link :: lexical segment
- $% [%chat p=term] :: |chapter
- [%cone p=aura q=atom] :: %constant
- [%frag p=term] :: .face
- [%funk p=term] :: +arm
- [%plan p=term] :: $spec
- == ::
- +$ cuff (list link) :: parsed lex segments
- +$ crib [summary=cord details=(list sect)] ::
- +$ help [=cuff =crib] :: documentation
- +$ limb $@ term :: wing element
- $% [%& p=axis] :: by geometry
- [%| p=@ud q=(unit term)] :: by name
- == ::
- :: XX more and better sanity
- ::
- +$ null ~ :: null, nil, etc
- +$ onyx (list (pair type foot)) :: arm activation
- +$ opal :: limb match
- $% [%& p=type] :: leg
- [%| p=axis q=(set [p=type q=foot])] :: arm
- == ::
- +$ pica (pair ? cord) :: & prose, | code
- +$ palo (pair vein opal) :: wing trace, match
- +$ pock (pair axis nock) :: changes
- +$ port (each palo (pair type nock)) :: successful match
- +$ spec :: structure definition
- $~ [%base %null] ::
- $% [%base p=base] :: base type
- [%dbug p=spot q=spec] :: set debug
- [%gist p=[%help p=help] q=spec] :: formal comment
- [%leaf p=term q=@] :: constant atom
- [%like p=wing q=(list wing)] :: reference
- [%loop p=term] :: hygienic reference
- [%made p=(pair term (list term)) q=spec] :: annotate synthetic
- [%make p=hoon q=(list spec)] :: composed spec
- [%name p=term q=spec] :: annotate simple
- [%over p=wing q=spec] :: relative to subject
- :: ::
- [%bcgr p=spec q=spec] :: $>, filter: require
- [%bcbc p=spec q=(map term spec)] :: $$, recursion
- [%bcbr p=spec q=hoon] :: $|, verify
- [%bccb p=hoon] :: $_, example
- [%bccl p=[i=spec t=(list spec)]] :: $:, tuple
- [%bccn p=[i=spec t=(list spec)]] :: $%, head pick
- [%bcdt p=spec q=(map term spec)] :: $., read-write core
- [%bcgl p=spec q=spec] :: $<, filter: exclude
- [%bchp p=spec q=spec] :: $-, function core
- [%bckt p=spec q=spec] :: $^, cons pick
- [%bcls p=stud q=spec] :: $+, standard
- [%bcfs p=spec q=(map term spec)] :: $/, write-only core
- [%bcmc p=hoon] :: $;, manual
- [%bcpm p=spec q=hoon] :: $&, repair
- [%bcsg p=hoon q=spec] :: $~, default
- [%bctc p=spec q=(map term spec)] :: $`, read-only core
- [%bcts p=skin q=spec] :: $=, name
- [%bcpt p=spec q=spec] :: $@, atom pick
- [%bcwt p=[i=spec t=(list spec)]] :: $?, full pick
- [%bczp p=spec q=(map term spec)] :: $!, opaque core
- == ::
- +$ tent :: model builder
- $% [%| p=wing q=tent r=(list spec)] :: ~(p q r...)
- [%& p=(list wing)] :: a.b:c.d
- == ::
- +$ tiki :: test case
- $% [%& p=(unit term) q=wing] :: simple wing
- [%| p=(unit term) q=hoon] :: named wing
- == ::
- +$ skin :: texture
- $@ =term :: name/~[term %none]
- $% [%base =base] :: base match
- [%cell =skin =skin] :: pair
- [%dbug =spot =skin] :: trace
- [%leaf =aura =atom] :: atomic constant
- [%help =help =skin] :: describe
- [%name =term =skin] :: apply label
- [%over =wing =skin] :: relative to
- [%spec =spec =skin] :: cast to
- [%wash depth=@ud] :: strip faces
- == ::
- +$ tome (pair what (map term hoon)) :: core chapter
- +$ tope :: topographic type
- $@ $? %& :: cell or atom
- %| :: atom
- == ::
- (pair tope tope) :: cell
- ++ hoot :: hoon tools
- |%
- +$ beer $@(char [~ p=hoon]) :: simple embed
- +$ mane $@(@tas [@tas @tas]) :: XML name+space
- +$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
- +$ marl (list tuna) :: dynamic XML nodes
- +$ mart (list [n=mane v=(list beer)]) :: dynamic XML attrs
- +$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
- +$ mare (each manx marl) :: node or nodes
- +$ maru (each tuna marl) :: interp or nodes
- +$ tuna :: maybe interpolation
- $~ [[%$ ~] ~]
- $^ manx
- $: ?(%tape %manx %marl %call)
- p=hoon
- ==
- -- ::
- +$ hoon :: hoon AST
- $+ hoon
- $~ [%zpzp ~] ::
- $^ [p=hoon q=hoon] ::
- $% ::
- [%$ p=axis] :: simple leg
- :: ::
- [%base p=base] :: base spec
- [%bust p=base] :: bunt base
- [%dbug p=spot q=hoon] :: debug info in trace
- [%eror p=tape] :: assembly error
- [%hand p=type q=nock] :: premade result
- [%note p=note q=hoon] :: annotate
- [%fits p=hoon q=wing] :: underlying ?=
- [%knit p=(list woof)] :: assemble string
- [%leaf p=(pair term @)] :: symbol spec
- [%limb p=term] :: take limb
- [%lost p=hoon] :: not to be taken
- [%rock p=term q=*] :: fixed constant
- [%sand p=term q=*] :: unfixed constant
- [%tell p=(list hoon)] :: render as tape
- [%tune p=$@(term tune)] :: minimal face
- [%wing p=wing] :: take wing
- [%yell p=(list hoon)] :: render as tank
- [%xray p=manx:hoot] :: ;foo; templating
- :: :::::: cores
- [%brbc sample=(lest term) body=spec] :: |$
- [%brcb p=spec q=alas r=(map term tome)] :: |_
- [%brcl p=hoon q=hoon] :: |:
- [%brcn p=(unit term) q=(map term tome)] :: |%
- [%brdt p=hoon] :: |.
- [%brkt p=hoon q=(map term tome)] :: |^
- [%brhp p=hoon] :: |-
- [%brsg p=spec q=hoon] :: |~
- [%brtr p=spec q=hoon] :: |*
- [%brts p=spec q=hoon] :: |=
- [%brpt p=(unit term) q=(map term tome)] :: |@
- [%brwt p=hoon] :: |?
- :: :::::: tuples
- [%clcb p=hoon q=hoon] :: :_ [q p]
- [%clkt p=hoon q=hoon r=hoon s=hoon] :: :^ [p q r s]
- [%clhp p=hoon q=hoon] :: :- [p q]
- [%clls p=hoon q=hoon r=hoon] :: :+ [p q r]
- [%clsg p=(list hoon)] :: :~ [p ~]
- [%cltr p=(list hoon)] :: :* p as a tuple
- :: :::::: invocations
- [%cncb p=wing q=(list (pair wing hoon))] :: %_
- [%cndt p=hoon q=hoon] :: %.
- [%cnhp p=hoon q=hoon] :: %-
- [%cncl p=hoon q=(list hoon)] :: %:
- [%cntr p=wing q=hoon r=(list (pair wing hoon))] :: %*
- [%cnkt p=hoon q=hoon r=hoon s=hoon] :: %^
- [%cnls p=hoon q=hoon r=hoon] :: %+
- [%cnsg p=wing q=hoon r=(list hoon)] :: %~
- [%cnts p=wing q=(list (pair wing hoon))] :: %=
- :: :::::: nock
- [%dtkt p=spec q=hoon] :: .^ nock 11
- [%dtls p=hoon] :: .+ nock 4
- [%dttr p=hoon q=hoon] :: .* nock 2
- [%dtts p=hoon q=hoon] :: .= nock 5
- [%dtwt p=hoon] :: .? nock 3
- :: :::::: type conversion
- [%ktbr p=hoon] :: ^| contravariant
- [%ktdt p=hoon q=hoon] :: ^. self-cast
- [%ktls p=hoon q=hoon] :: ^+ expression cast
- [%kthp p=spec q=hoon] :: ^- structure cast
- [%ktpm p=hoon] :: ^& covariant
- [%ktsg p=hoon] :: ^~ constant
- [%ktts p=skin q=hoon] :: ^= label
- [%ktwt p=hoon] :: ^? bivariant
- [%kttr p=spec] :: ^* example
- [%ktcl p=spec] :: ^: filter
- :: :::::: hints
- [%sgbr p=hoon q=hoon] :: ~| sell on trace
- [%sgcb p=hoon q=hoon] :: ~_ tank on trace
- [%sgcn p=chum q=hoon r=tyre s=hoon] :: ~% general jet hint
- [%sgfs p=chum q=hoon] :: ~/ function j-hint
- [%sggl p=$@(term [p=term q=hoon]) q=hoon] :: ~< backward hint
- [%sggr p=$@(term [p=term q=hoon]) q=hoon] :: ~> forward hint
- [%sgbc p=term q=hoon] :: ~$ profiler hit
- [%sgls p=@ q=hoon] :: ~+ cache=memoize
- [%sgpm p=@ud q=hoon r=hoon] :: ~& printf=priority
- [%sgts p=hoon q=hoon] :: ~= don't duplicate
- [%sgwt p=@ud q=hoon r=hoon s=hoon] :: ~? tested printf
- [%sgzp p=hoon q=hoon] :: ~! type on trace
- :: :::::: miscellaneous
- [%mcts p=marl:hoot] :: ;= list templating
- [%mccl p=hoon q=(list hoon)] :: ;: binary to nary
- [%mcfs p=hoon] :: ;/ [%$ [%$ p ~] ~]
- [%mcgl p=spec q=hoon r=hoon s=hoon] :: ;< bind
- [%mcsg p=hoon q=(list hoon)] :: ;~ kleisli arrow
- [%mcmc p=spec q=hoon] :: ;; normalize
- :: :::::: compositions
- [%tsbr p=spec q=hoon] :: =| push bunt
- [%tscl p=(list (pair wing hoon)) q=hoon] :: =: q w= p changes
- [%tsfs p=skin q=hoon r=hoon] :: =/ typed variable
- [%tsmc p=skin q=hoon r=hoon] :: =; =/(q p r)
- [%tsdt p=wing q=hoon r=hoon] :: =. r with p as q
- [%tswt p=wing q=hoon r=hoon s=hoon] :: =? conditional =.
- [%tsgl p=hoon q=hoon] :: =< =>(q p)
- [%tshp p=hoon q=hoon] :: =- =+(q p)
- [%tsgr p=hoon q=hoon] :: => q w=subject p
- [%tskt p=skin q=wing r=hoon s=hoon] :: =^ state machine
- [%tsls p=hoon q=hoon] :: =+ q w=[p subject]
- [%tssg p=(list hoon)] :: =~ hoon stack
- [%tstr p=(pair term (unit spec)) q=hoon r=hoon] :: =* new style
- [%tscm p=hoon q=hoon] :: =, overload p in q
- :: :::::: conditionals
- [%wtbr p=(list hoon)] :: ?| loobean or
- [%wthp p=wing q=(list (pair spec hoon))] :: ?- pick case in q
- [%wtcl p=hoon q=hoon r=hoon] :: ?: if=then=else
- [%wtdt p=hoon q=hoon r=hoon] :: ?. ?:(p r q)
- [%wtkt p=wing q=hoon r=hoon] :: ?^ if p is a cell
- [%wtgl p=hoon q=hoon] :: ?< ?:(p !! q)
- [%wtgr p=hoon q=hoon] :: ?> ?:(p q !!)
- [%wtls p=wing q=hoon r=(list (pair spec hoon))] :: ?+ ?- w=default
- [%wtpm p=(list hoon)] :: ?& loobean and
- [%wtpt p=wing q=hoon r=hoon] :: ?@ if p is atom
- [%wtsg p=wing q=hoon r=hoon] :: ?~ if p is null
- [%wthx p=skin q=wing] :: ?# if q matches p
- [%wtts p=spec q=wing] :: ?= if q matches p
- [%wtzp p=hoon] :: ?! loobean not
- :: :::::: special
- [%zpcm p=hoon q=hoon] :: !,
- [%zpgr p=hoon] :: !>
- [%zpgl p=spec q=hoon] :: !<
- [%zpmc p=hoon q=hoon] :: !;
- [%zpts p=hoon] :: !=
- [%zppt p=(list wing) q=hoon r=hoon] :: !@
- [%zpwt p=$@(p=@ [p=@ q=@]) q=hoon] :: !?
- [%zpzp ~] :: !!
- == ::
- +$ tyre (list [p=term q=hoon]) ::
- +$ tyke (list (unit hoon)) ::
- :: :::::: virtual nock
- +$ nock $^ [p=nock q=nock] :: autocons
- $% [%1 p=*] :: constant
- [%2 p=nock q=nock] :: compose
- [%3 p=nock] :: cell test
- [%4 p=nock] :: increment
- [%5 p=nock q=nock] :: equality test
- [%6 p=nock q=nock r=nock] :: if, then, else
- [%7 p=nock q=nock] :: serial compose
- [%8 p=nock q=nock] :: push onto subject
- [%9 p=@ q=nock] :: select arm and fire
- [%10 p=[p=@ q=nock] q=nock] :: edit
- [%11 p=$@(@ [p=@ q=nock]) q=nock] :: hint
- [%12 p=nock q=nock] :: grab data from sky
- [%0 p=@] :: axis select
- == ::
- +$ note :: type annotation
- $% [%help p=help] :: documentation
- [%know p=stud] :: global standard
- [%made p=term q=(unit (list wing))] :: structure
- == ::
- +$ type $+ type
- $~ %noun ::
- $@ $? %noun :: any nouns
- %void :: no noun
- == ::
- $% [%atom p=term q=(unit @)] :: atom / constant
- [%cell p=type q=type] :: ordered pair
- [%core p=type q=coil] :: object
- [%face p=$@(term tune) q=type] :: namespace
- [%fork p=(set type)] :: union
- [%hint p=(pair type note) q=type] :: annotation
- [%hold p=type q=hoon] :: lazy evaluation
- == ::
- +$ tony :: ++tone done right
- $% [%0 p=tine q=*] :: success
- [%1 p=(set)] :: blocks
- [%2 p=(list [@ta *])] :: error ~_s
- == ::
- +$ tine :: partial noun
- $@ ~ :: open
- $% [%& p=tine q=tine] :: half-blocked
- [%| p=(set)] :: fully blocked
- == ::
- +$ tool $@(term tune) :: type decoration
- +$ tune :: complex
- $~ [~ ~] ::
- $: p=(map term (unit hoon)) :: aliases
- q=(list hoon) :: bridges
- == ::
- +$ typo type :: old type
- +$ vase [p=type q=*] :: type-value pair
- +$ vise [p=typo q=*] :: old vase
- +$ vial ?(%read %rite %both %free) :: co/contra/in/bi
- +$ vair ?(%gold %iron %lead %zinc) :: in/contra/bi/co
- +$ vein (list (unit axis)) :: search trace
- +$ sect (list pica) :: paragraph
- +$ whit :: prefix docs parse
- $: bat=(map cuff (pair cord (list sect))) :: batch comment
- == ::
- +$ whiz cord :: postfix doc parse
- +$ what (unit (pair cord (list sect))) :: help slogan/section
- +$ wing (list limb) :: search path
- ::
- :: +block: abstract identity of resource awaited
- ::
- +$ block
- path
- ::
- :: +result: internal interpreter result
- ::
- +$ result
- $@(~ seminoun)
- ::
- :: +thunk: fragment constructor
- ::
- +$ thunk
- $-(@ud (unit noun))
- ::
- :: +seminoun:
- ::
- +$ seminoun
- :: partial noun; blocked subtrees are ~
- ::
- $~ [[%full / ~ ~] ~]
- [mask=stencil data=noun]
- ::
- :: +stencil: noun knowledge map
- ::
- +$ stencil
- $% ::
- :: %half: noun has partial block substructure
- ::
- [%half left=stencil rite=stencil]
- ::
- :: %full: noun is either fully complete, or fully blocked
- ::
- [%full blocks=(set block)]
- ::
- :: %lazy: noun can be generated from virtual subtree
- ::
- [%lazy fragment=axis resolve=thunk]
- ==
- ::
- +$ output
- :: ~: interpreter stopped
- ::
- %- unit
- $% ::
- :: %done: output is complete
- ::
- [%done p=noun]
- ::
- :: %wait: output is waiting for resources
- ::
- [%wait p=(list block)]
- ==
- :: profiling
- +$ doss
- $: mon=moan :: sample count
- hit=(map term @ud) :: hit points
- cut=(map path hump) :: cut points
- ==
- +$ moan :: sample metric
- $: fun=@ud :: samples in C
- noc=@ud :: samples in nock
- glu=@ud :: samples in glue
- mal=@ud :: samples in alloc
- far=@ud :: samples in frag
- coy=@ud :: samples in copy
- euq=@ud :: samples in equal
- == ::
- ::
- +$ hump
- $: mon=moan :: sample count
- out=(map path @ud) :: calls out of
- inn=(map path @ud) :: calls into
- ==
- --
- ::
- ~% %pen
- +
- ==
- %ap ap
- %ut ut
- ==
- :: layer-5
- ::
- |%
- ::
- :: 5aa: new partial nock interpreter
- +| %new-partial-nock-interpreter
- ::
- ++ musk !. :: nock with block set
- |%
- ++ abet
- :: simplify raw result
- ::
- |= $: :: noy: raw result
- ::
- noy=result
- ==
- ^- output
- :: propagate stop
- ::
- ?~ noy ~
- :- ~
- :: merge all blocking sets
- ::
- =/ blocks (squash mask.noy)
- ?: =(~ blocks)
- :: no blocks, data is complete
- ::
- done/data.noy
- :: reduce block set to block list
- ::
- wait/~(tap in blocks)
- ::
- ++ araw
- :: execute nock on partial subject
- ::
- |= $: :: bus: subject, a partial noun
- :: fol: formula, a complete noun
- ::
- bus=seminoun
- fol=noun
- ==
- :: interpreter loop
- ::
- |- ^- result
- ?@ fol
- :: bad formula, stop
- ::
- ~
- ?: ?=(^ -.fol)
- :: hed: interpret head
- ::
- =+ hed=$(fol -.fol)
- :: propagate stop
- ::
- ?~ hed ~
- :: tal: interpret tail
- ::
- =+ tal=$(fol +.fol)
- :: propagate stop
- ::
- ?~ tal ~
- :: combine
- ::
- (combine hed tal)
- ?+ fol
- :: bad formula; stop
- ::
- ~
- :: 0; fragment
- ::
- [%0 b=@]
- :: if bad axis, stop
- ::
- ?: =(0 b.fol) ~
- :: reduce to fragment
- ::
- (fragment b.fol bus)
- ::
- :: 1; constant
- ::
- [%1 b=*]
- :: constant is complete
- ::
- [full/~ b.fol]
- ::
- :: 2; recursion
- ::
- [%2 b=* c=*]
- :: require complete formula
- ::
- %+ require
- :: compute formula with current subject
- ::
- $(fol c.fol)
- |= :: ryf: next formula
- ::
- ryf=noun
- :: lub: next subject
- ::
- =+ lub=^$(fol b.fol)
- :: propagate stop
- ::
- ?~ lub ~
- :: recurse
- ::
- ^$(fol ryf, bus lub)
- ::
- :: 3; probe
- ::
- [%3 b=*]
- %+ require
- $(fol b.fol)
- |= :: fig: probe input
- ::
- fig=noun
- :: yes if cell, no if atom
- ::
- [full/~ .?(fig)]
- ::
- :: 4; increment
- ::
- [%4 b=*]
- %+ require
- $(fol b.fol)
- |= :: fig: increment input
- ::
- fig=noun
- :: stop for cells, increment for atoms
- ::
- ?^(fig ~ [full/~ +(fig)])
- ::
- :: 5; compare
- ::
- [%5 b=* c=*]
- %+ require
- $(fol b.fol)
- |= :: hed: left input
- ::
- hed=noun
- %+ require
- ^$(fol c.fol)
- |= :: tal: right input
- ::
- tal=noun
- [full/~ =(hed tal)]
- ::
- :: 6; if-then-else
- ::
- [%6 b=* c=* d=*]
- :: semantic expansion
- ::
- %+ require
- $(fol b.fol)
- |= :: fig: boolean
- ::
- fig=noun
- :: apply proper booleans
- ::
- ?: =(& fig) ^$(fol c.fol)
- ?: =(| fig) ^$(fol d.fol)
- :: stop on bad test
- ::
- ~
- ::
- :: 7; composition
- ::
- [%7 b=* c=*]
- :: one: input
- ::
- =+ one=$(fol b.fol)
- :: propagate stop
- ::
- ?~ one ~
- :: complete composition
- ::
- $(fol c.fol, bus one)
- ::
- :: 8; introduction
- ::
- [%8 b=* c=*]
- :: one: input
- ::
- =+ one=$(fol b.fol)
- :: propagate stop
- ::
- ?~ one ~
- :: complete introduction
- ::
- $(fol c.fol, bus (combine one bus))
- ::
- :: 9; invocation
- ::
- [%9 b=* c=*]
- :: semantic expansion
- ::
- ?^ b.fol ~
- :: one: core
- ::
- =+ one=$(fol c.fol)
- :: propagate stop
- ::
- ?~ one ~
- :: if core is constant
- ::
- ?: ?=([[%full ~] *] one)
- :: then call virtual nock directly
- ::
- =+ (mack data.one [%9 b.fol %0 1])
- :: propagate stop
- ::
- ?~ - ~
- :: produce result
- ::
- [[%full ~] u.-]
- :: else complete call
- ::
- %+ require
- :: retrieve formula
- ::
- (fragment b.fol one)
- :: continue
- ::
- |=(noun ^$(bus one, fol +<))
- ::
- :: 10; edit
- ::
- [%10 [b=@ c=*] d=*]
- :: tar: target of edit
- ::
- =+ tar=$(fol d.fol)
- :: propagate stop
- ::
- ?~ tar ~
- :: inn: inner value
- ::
- =+ inn=$(fol c.fol)
- :: propagate stop
- ::
- ?~ inn ~
- (mutate b.fol inn tar)
- ::
- :: 11; static hint
- ::
- [%11 @ c=*]
- :: ignore hint
- ::
- $(fol c.fol)
- ::
- :: 11; dynamic hint
- ::
- [%11 [b=* c=*] d=*]
- :: noy: dynamic hint
- ::
- =+ noy=$(fol c.fol)
- :: propagate stop
- ::
- ?~ noy ~
- :: if hint is a fully computed trace
- ::
- ?: &(?=(%spot b.fol) ?=([[%full ~] *] noy))
- :: compute within trace
- ::
- ~_((show %o +.noy) $(fol d.fol))
- :: else ignore hint
- ::
- $(fol d.fol)
- ==
- ::
- ++ apex
- :: execute nock on partial subject
- ::
- |= $: :: bus: subject, a partial noun
- :: fol: formula, a complete noun
- ::
- bus=seminoun
- fol=noun
- ==
- ~+
- ^- output
- :: simplify result
- ::
- (abet (araw bus fol))
- ::
- ++ combine
- :: combine a pair of seminouns
- ::
- |= $: :: hed: head of pair
- :: tal: tail of pair
- ::
- hed=seminoun
- tal=seminoun
- ==
- ^- seminoun
- ?. ?& &(?=(%full -.mask.hed) ?=(%full -.mask.tal))
- =(=(~ blocks.mask.hed) =(~ blocks.mask.tal))
- ==
- :: default merge
- ::
- [half/[mask.hed mask.tal] [data.hed data.tal]]
- :: both sides total
- ::
- ?: =(~ blocks.mask.hed)
- :: both sides are complete
- ::
- [full/~ data.hed data.tal]
- :: both sides are blocked
- ::
- [full/(~(uni in blocks.mask.hed) blocks.mask.tal) ~]
- ::
- ++ complete
- :: complete any laziness
- ::
- |= bus=seminoun
- ^- seminoun
- ?- -.mask.bus
- %full bus
- %lazy :: fragment 1 is the whole thing
- ::
- ?: =(1 fragment.mask.bus)
- :: blocked; we can't get fragment 1 while compiling it
- ::
- [[%full [~ ~ ~]] ~]
- :: execute thunk
- ::
- =+ (resolve.mask.bus fragment.mask.bus)
- :: if product is nil
- ::
- ?~ -
- :: then blocked
- ::
- [[%full [~ ~ ~]] ~]
- :: else use value
- ::
- [[%full ~] u.-]
- %half :: recursive descent
- ::
- %+ combine
- $(bus [left.mask.bus -.data.bus])
- $(bus [rite.mask.bus +.data.bus])
- ==
- ::
- ++ fragment
- :: seek to an axis in a seminoun
- ::
- |= $: :: axe: tree address of subtree
- :: bus: partial noun
- ::
- axe=axis
- bus=seminoun
- ==
- ^- result
- :: 1 is the root
- ::
- ?: =(1 axe) bus
- :: now: top of axis (2 or 3)
- :: lat: rest of axis
- ::
- =+ [now=(cap axe) lat=(mas axe)]
- ?- -.mask.bus
- %lazy :: propagate laziness
- ::
- bus(fragment.mask (peg fragment.mask.bus axe))
- ::
- %full :: if fully blocked, produce self
- ::
- ?^ blocks.mask.bus bus
- :: descending into atom, stop
- ::
- ?@ data.bus ~
- :: descend into complete cell
- ::
- $(axe lat, bus [full/~ ?:(=(2 now) -.data.bus +.data.bus)])
- ::
- %half :: descend into partial cell
- ::
- %= $
- axe lat
- bus ?: =(2 now)
- [left.mask.bus -.data.bus]
- [rite.mask.bus +.data.bus]
- == ==
- ::
- ++ mutate
- :: change a single axis in a seminoun
- ::
- |= $: :: axe: axis within big to change
- :: lit: (little) seminoun to insert within big at axe
- :: big: seminoun to mutate
- ::
- axe=@
- lit=seminoun
- big=seminoun
- ==
- ^- result
- :: stop on zero axis
- ::
- ?~ axe ~
- :: edit root of big means discard it
- ::
- ?: =(1 axe) lit
- :: decompose axis into path of head-tail
- ::
- |- ^- result
- ?: =(2 axe)
- :: mutate head of cell
- ::
- =+ tal=(fragment 3 big)
- :: propagate stop
- ::
- ?~ tal ~
- (combine lit tal)
- ?: =(3 axe)
- :: mutate tail of cell
- ::
- =+ hed=(fragment 2 big)
- :: propagate stop
- ::
- ?~ hed ~
- (combine hed lit)
- :: deeper axis: keep one side of big and
- :: recurse into the other with smaller axe
- ::
- =+ mor=(mas axe)
- =+ hed=(fragment 2 big)
- :: propagate stop
- ::
- ?~ hed ~
- =+ tal=(fragment 3 big)
- :: propagate stop
- ::
- ?~ tal ~
- ?: =(2 (cap axe))
- :: recurse into the head
- ::
- =+ mut=$(big hed, axe mor)
- :: propagate stop
- ::
- ?~ mut ~
- (combine mut tal)
- :: recurse into the tail
- ::
- =+ mut=$(big tal, axe mor)
- :: propagate stop
- ::
- ?~ mut ~
- (combine hed mut)
- ::
- ++ require
- :: require complete intermediate step
- ::
- |= $: noy=result
- yen=$-(* result)
- ==
- ^- result
- :: propagate stop
- ::
- ?~ noy ~
- :: suppress laziness
- ::
- =/ bus=seminoun (complete noy)
- ?< ?=(%lazy -.mask.bus)
- :: if partial block, squash blocks and stop
- ::
- ?: ?=(%half -.mask.bus) [full/(squash mask.bus) ~]
- :: if full block, propagate block
- ::
- ?: ?=(^ blocks.mask.bus) [mask.bus ~]
- :: otherwise use complete noun
- ::
- (yen data.bus)
- ::
- ++ squash
- :: convert stencil to block set
- ::
- |= tyn=stencil
- ^- (set block)
- ?- -.tyn
- %lazy $(tyn -:(complete tyn ~))
- %full blocks.tyn
- %half (~(uni in $(tyn left.tyn)) $(tyn rite.tyn))
- ==
- --
- ::
- :: 5a: compiler utilities
- +| %compiler-utilities
- ::
- ++ bool :: make loobean
- ^- type
- (fork [%atom %f `%.y] [%atom %f `%.n] ~)
- ::
- ++ cell :: make %cell type
- ~/ %cell
- |= [hed=type tal=type]
- ^- type
- ?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal]))
- ::
- ++ core :: make %core type
- ~/ %core
- |= [pac=type con=coil]
- ^- type
- ?:(=(%void pac) %void [%core pac con])
- ::
- ++ hint
- |= [p=(pair type note) q=type]
- ^- type
- ?: =(%void q) %void
- ?: =(%noun q) %noun
- [%hint p q]
- ::
- ++ face :: make %face type
- ~/ %face
- |= [giz=$@(term tune) der=type]
- ^- type
- ?: =(%void der)
- %void
- [%face giz der]
- ::
- ++ fork :: make %fork type
- ~/ %fork
- |= yed=(list type)
- =| lez=(set type)
- |- ^- type
- ?~ yed
- ?~ lez %void
- ?: ?=([* ~ ~] lez) n.lez
- [%fork lez]
- %= $
- yed t.yed
- lez
- ?: =(%void i.yed) lez
- ?: ?=([%fork *] i.yed) (~(uni in lez) p.i.yed)
- (~(put in lez) i.yed)
- ==
- ::
- ++ cove :: extract [0 *] axis
- |= nug=nock
- ?- nug
- [%0 *] p.nug
- [%11 *] $(nug q.nug)
- * ~_(leaf+"cove" !!)
- ==
- ++ comb :: combine two formulas
- ~/ %comb
- |= [mal=nock buz=nock]
- ^- nock
- ?: ?&(?=([%0 *] mal) !=(0 p.mal))
- ?: ?&(?=([%0 *] buz) !=(0 p.buz))
- [%0 (peg p.mal p.buz)]
- ?: ?=([%2 [%0 *] [%0 *]] buz)
- [%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]]
- [%7 mal buz]
- ?: ?=([^ [%0 %1]] mal)
- [%8 p.mal buz]
- ?: =([%0 %1] buz)
- mal
- [%7 mal buz]
- ::
- ++ cond :: ?: compile
- ~/ %cond
- |= [pex=nock yom=nock woq=nock]
- ^- nock
- ?: =([%1 &] pex) yom
- ?: =([%1 |] pex) woq
- ?: =([%0 0] pex) pex
- [%6 pex yom woq]
- ::
- ++ cons :: make formula cell
- ~/ %cons
- |= [vur=nock sed=nock]
- ^- nock
- :: this optimization can remove crashes which are essential
- ::
- :: ?: ?=([[%0 *] [%0 *]] +<)
- :: ?: ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2)))
- :: [%0 (div p.vur 2)]
- :: [vur sed]
- ?: ?=([[%1 *] [%1 *]] +<)
- [%1 p.vur p.sed]
- [vur sed]
- ::
- ++ fitz :: odor compatibility
- ~/ %fitz
- |= [yaz=term wix=term]
- =+ ^= fiz
- |= mot=@ta ^- [p=@ q=@ta]
- =+ len=(met 3 mot)
- ?: =(0 len)
- [0 %$]
- =+ tyl=(rsh [3 (dec len)] mot)
- ?: &((gte tyl 'A') (lte tyl 'Z'))
- [(sub tyl 64) (end [3 (dec len)] mot)]
- [0 mot]
- =+ [yoz=(fiz yaz) wux=(fiz wix)]
- ?& ?| =(0 p.yoz)
- =(0 p.wux)
- &(!=(0 p.wux) (lte p.wux p.yoz))
- ==
- |- ?| =(%$ q.yoz)
- =(%$ q.wux)
- ?& =((end 3 q.yoz) (end 3 q.wux))
- $(q.yoz (rsh 3 q.yoz), q.wux (rsh 3 q.wux))
- ==
- ==
- ==
- ::
- ++ flan :: loobean &
- ~/ %flan
- |= [bos=nock nif=nock]
- ^- nock
- ?: ?| =(bos nif)
- =([%1 |] bos)
- =([%1 &] nif)
- =([%0 0] bos)
- ==
- bos
- ?: ?| =([%1 &] bos)
- =([%1 |] nif)
- =([%0 0] nif)
- ==
- nif
- [%6 bos nif [%1 |]]
- ::
- ++ flip :: loobean negation
- ~/ %flip
- |= dyr=nock
- ^- nock
- ?: =([%1 &] dyr) [%1 |]
- ?: =([%1 |] dyr) [%1 &]
- ?: =([%0 0] dyr) dyr
- [%6 dyr [%1 |] %1 &]
- ::
- ++ flor :: loobean |
- ~/ %flor
- |= [bos=nock nif=nock]
- ^- nock
- ?: ?| =(bos nif)
- =([%1 &] bos)
- =([%1 |] nif)
- =([%0 0] bos)
- ==
- bos
- ?: ?| =([%1 |] bos)
- =([%1 &] nif)
- =([%0 0] nif)
- ==
- nif
- [%6 bos [%1 &] nif]
- ::
- ++ hike
- ~/ %hike
- |= [a=axis pac=(list (pair axis nock))]
- |^ =/ rel=(map axis nock) (roll pac insert)
- =/ ord=(list axis) (sort ~(tap in ~(key by rel)) gth)
- |- ^- nock
- ?~ ord
- [%0 a]
- =/ b=axis i.ord
- =/ c=nock (~(got by rel) b)
- =/ d=nock $(ord t.ord)
- [%10 [b c] d]
- ::
- ++ contains
- |= [container=axis contained=axis]
- ^- ?
- =/ big=@ (met 0 container)
- =/ small=@ (met 0 contained)
- ?: (lte small big) |
- =/ dif=@ (sub small big)
- =(container (rsh [0 dif] contained))
- ::
- ++ parent
- |= a=axis
- `axis`(rsh 0 a)
- ::
- ++ sibling
- |= a=axis
- ^- axis
- ?~ (mod a 2)
- +(a)
- (dec a)
- ::
- ++ insert
- |= [e=[axe=axis fol=nock] n=(map axis nock)]
- ^- (map axis nock)
- ?: =/ a=axis axe.e
- |- ^- ?
- ?: =(1 a) |
- ?: (~(has by n) a)
- &
- $(a (parent a))
- :: parent already in
- n
- =. n
- :: remove children
- %+ roll ~(tap by n)
- |= [[axe=axis fol=nock] m=_n]
- ?. (contains axe.e axe) m
- (~(del by m) axe)
- =/ sib (sibling axe.e)
- =/ un (~(get by n) sib)
- ?~ un (~(put by n) axe.e fol.e)
- :: replace sibling with parent
- %= $
- n (~(del by n) sib)
- e :- (parent sib)
- ?: (gth sib axe.e)
- (cons fol.e u.un)
- (cons u.un fol.e)
- ==
- --
- ::
- ++ jock
- |= rad=?
- |= lot=coin ^- hoon
- ?- -.lot
- ~
- ?:(rad [%rock p.lot] [%sand p.lot])
- ::
- %blob
- ?: rad
- [%rock %$ p.lot]
- ?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)])
- ::
- %many
- [%cltr (turn p.lot |=(a=coin ^$(lot a)))]
- ==
- ::
- ++ look
- ~/ %look
- |= [cog=term dab=(map term hoon)]
- =+ axe=1
- |- ^- (unit [p=axis q=hoon])
- ?- dab
- ~ ~
- ::
- [* ~ ~]
- ?:(=(cog p.n.dab) [~ axe q.n.dab] ~)
- ::
- [* ~ *]
- ?: =(cog p.n.dab)
- [~ (peg axe 2) q.n.dab]
- ?: (gor cog p.n.dab)
- ~
- $(axe (peg axe 3), dab r.dab)
- ::
- [* * ~]
- ?: =(cog p.n.dab)
- [~ (peg axe 2) q.n.dab]
- ?: (gor cog p.n.dab)
- $(axe (peg axe 3), dab l.dab)
- ~
- ::
- [* * *]
- ?: =(cog p.n.dab)
- [~ (peg axe 2) q.n.dab]
- ?: (gor cog p.n.dab)
- $(axe (peg axe 6), dab l.dab)
- $(axe (peg axe 7), dab r.dab)
- ==
- ::
- ++ loot
- ~/ %loot
- |= [cog=term dom=(map term tome)]
- =+ axe=1
- |- ^- (unit [p=axis q=hoon])
- ?- dom
- ~ ~
- ::
- [* ~ ~]
- %+ bind (look cog q.q.n.dom)
- |=((pair axis hoon) [(peg axe p) q])
- ::
- [* ~ *]
- =+ yep=(look cog q.q.n.dom)
- ?^ yep
- [~ (peg (peg axe 2) p.u.yep) q.u.yep]
- $(axe (peg axe 3), dom r.dom)
- ::
- [* * ~]
- =+ yep=(look cog q.q.n.dom)
- ?^ yep
- [~ (peg (peg axe 2) p.u.yep) q.u.yep]
- $(axe (peg axe 3), dom l.dom)
- ::
- [* * *]
- =+ yep=(look cog q.q.n.dom)
- ?^ yep
- [~ (peg (peg axe 2) p.u.yep) q.u.yep]
- =+ pey=$(axe (peg axe 6), dom l.dom)
- ?^ pey pey
- $(axe (peg axe 7), dom r.dom)
- ==
- ::
- :: 5b: macro expansion
- +| %macro-expansions
- ::
- ++ ah :: tiki engine
- |_ tik=tiki
- ++ blue
- |= gen=hoon
- ^- hoon
- ?. &(?=(%| -.tik) ?=(~ p.tik)) gen
- [%tsgr [%$ 3] gen]
- ::
- ++ teal
- |= mod=spec
- ^- spec
- ?: ?=(%& -.tik) mod
- [%over [%& 3]~ mod]
- ::
- ++ tele
- |= syn=skin
- ^- skin
- ?: ?=(%& -.tik) syn
- [%over [%& 3]~ syn]
- ::
- ++ gray
- |= gen=hoon
- ^- hoon
- ?- -.tik
- %& ?~(p.tik gen [%tstr [u.p.tik ~] [%wing q.tik] gen])
- %| [%tsls ?~(p.tik q.tik [%ktts u.p.tik q.tik]) gen]
- ==
- ::
- ++ puce
- ^- wing
- ?- -.tik
- %& ?~(p.tik q.tik [u.p.tik ~])
- %| [[%& 2] ~]
- ==
- ::
- ++ wthp |= opt=(list (pair spec hoon))
- %+ gray %wthp
- [puce (turn opt |=([a=spec b=hoon] [a (blue b)]))]
- ++ wtkt |=([sic=hoon non=hoon] (gray [%wtkt puce (blue sic) (blue non)]))
- ++ wtls |= [gen=hoon opt=(list (pair spec hoon))]
- %+ gray %wtls
- [puce (blue gen) (turn opt |=([a=spec b=hoon] [a (blue b)]))]
- ++ wtpt |=([sic=hoon non=hoon] (gray [%wtpt puce (blue sic) (blue non)]))
- ++ wtsg |=([sic=hoon non=hoon] (gray [%wtsg puce (blue sic) (blue non)]))
- ++ wthx |=(syn=skin (gray [%wthx (tele syn) puce]))
- ++ wtts |=(mod=spec (gray [%wtts (teal mod) puce]))
- --
- ::
- ++ ax
- =+ :* :: .dom: axis to home
- :: .hay: wing to home
- :: .cox: hygienic context
- :: .bug: debug annotations
- :: .nut: annotations
- :: .def: default expression
- ::
- dom=`axis`1
- hay=*wing
- cox=*(map term spec)
- bug=*(list spot)
- nut=*(unit note)
- def=*(unit hoon)
- ==
- |_ mod=spec
- ::
- ++ autoname
- :: derive name from spec
- ::
- |- ^- (unit term)
- ?- -.mod
- %base ?.(?=([%atom *] p.mod) ~ ?:(=(%$ p.p.mod) `%atom `p.p.mod))
- %dbug $(mod q.mod)
- %gist $(mod q.mod)
- %leaf `p.mod
- %loop `p.mod
- %like ?~(p.mod ~ ?^(i.p.mod ?:(?=(%& -.i.p.mod) ~ q.i.p.mod) `i.p.mod))
- %make ~(name ap p.mod)
- %made $(mod q.mod)
- %over $(mod q.mod)
- %name $(mod q.mod)
- ::
- %bcbc $(mod p.mod)
- %bcbr $(mod p.mod)
- %bccb ~(name ap p.mod)
- %bccl $(mod i.p.mod)
- %bccn $(mod i.p.mod)
- %bcdt ~
- %bcgl $(mod q.mod)
- %bcgr $(mod q.mod)
- %bchp $(mod p.mod)
- %bckt $(mod q.mod)
- %bcls $(mod q.mod)
- %bcfs ~
- %bcmc ~(name ap p.mod)
- %bcpm $(mod p.mod)
- %bcsg $(mod q.mod)
- %bctc ~
- %bcts $(mod q.mod)
- %bcpt $(mod q.mod)
- %bcwt $(mod i.p.mod)
- %bczp ~
- ==
- ::
- ++ function
- :: construct a function example
- ::
- |= [fun=spec arg=spec]
- ^- hoon
- :: minimal context as subject
- ::
- :+ %tsgr
- :: context is example of both specs
- ::
- [example:clear(mod fun) example:clear(mod arg)]
- :: produce an %iron (contravariant) core
- ::
- :- %ktbr
- :: make an actual gate
- ::
- :+ %brcl
- [%$ 2]
- [%$ 15]
- ::
- ++ interface
- :: construct a core example
- ::
- |= [variance=vair payload=spec arms=(map term spec)]
- ^- hoon
- :: attach proper variance control
- ::
- =- ?- variance
- %gold -
- %lead [%ktwt -]
- %zinc [%ktpm -]
- %iron [%ktbr -]
- ==
- ^- hoon
- :+ %tsgr example:clear(mod payload)
- :+ %brcn ~
- =- [[%$ ~ -] ~ ~]
- %- ~(gas by *(map term hoon))
- %+ turn
- ~(tap by arms)
- |= [=term =spec]
- ::
- :: note that we *don't* make arm specs in an interface
- :: hygienic -- we leave them in context, to support
- :: maximum programmer flexibility
- ::
- [term example:clear(mod spec)]
- ::
- ++ home
- :: express a hoon against the original subject
- ::
- |= gen=hoon
- ^- hoon
- =/ ,wing
- ?: =(1 dom)
- hay
- (weld hay `wing`[[%& dom] ~])
- ?~ - gen
- [%tsgr [%wing -] gen]
- ::
- ++ clear
- :: clear annotations
- ^+ .
- .(bug ~, def ~, nut ~)
- ::
- ++ basal
- :: example base case
- ::
- |= bas=base
- ?- bas
- ::
- [%atom *]
- :: we may want sped
- ::
- [%sand p.bas ?:(=(%da p.bas) ~2000.1.1 0)]
- ::
- %noun
- :: raw nock produces noun type
- ::
- =+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -])
- ::
- %cell
- :: reduce to pair of nouns
- ::
- =+($(bas %noun) [- -])
- ::
- %flag
- :: comparison produces boolean type
- ::
- =+([%rock %$ 0] [%ktls [%dtts - -] -])
- ::
- %null
- [%rock %n 0]
- ::
- %void
- [%zpzp ~]
- ==
- ::
- ++ unfold
- |= [fun=hoon arg=(list spec)]
- ^- hoon
- [%cncl fun (turn arg |=(spec ktcl/+<))]
- ::
- ++ unreel
- |= [one=wing res=(list wing)]
- ^- hoon
- ?~(res [%wing one] [%tsgl [%wing one] $(one i.res, res t.res)])
- ::
- ++ descend
- :: record an axis to original subject
- ::
- |= axe=axis
- +>(dom (peg axe dom))
- ::
- ++ decorate
- :: apply documentation to expression
- ::
- |= gen=hoon
- ^- hoon
- =- ?~(nut - [%note u.nut -])
- |-
- ?~(bug gen [%dbug i.bug $(bug t.bug)])
- ::
- ++ pieces
- :: enumerate tuple wings
- ::
- |= =(list term)
- ^- (^list wing)
- (turn list |=(=term `wing`[term ~]))
- ::
- ++ spore
- :: build default sample
- ::
- ^- hoon
- :: sample is always typeless
- ::
- :+ %ktls
- [%bust %noun]
- :: consume debugging context
- ::
- %- decorate
- :: use home as subject
- ::
- %- home
- :: if default is set, use it
- ::
- ?^ def u.def
- :: else map structure to expression
- ::
- ~+
- |- ^- hoon
- ?- mod
- [%base *] ?:(=(%void p.mod) [%rock %n 0] (basal p.mod))
- [%bcbc *] :: track hygienic recursion points lexically
- ::
- %= $
- mod p.mod
- cox :: merge lexically and don't forget %$
- ::
- (~(put by ^+(cox (~(uni by cox) q.mod))) %$ p.mod)
- ==
- [%dbug *] [%dbug p.mod $(mod q.mod)]
- [%gist *] $(mod q.mod)
- [%leaf *] [%rock p.mod q.mod]
- [%loop *] ~|([%loop p.mod] $(mod (~(got by cox) p.mod)))
- [%like *] $(mod bcmc/(unreel p.mod q.mod))
- [%made *] $(mod q.mod)
- [%make *] $(mod bcmc/(unfold p.mod q.mod))
- [%name *] $(mod q.mod)
- [%over *] $(hay p.mod, mod q.mod)
- ::
- [%bcbr *] $(mod p.mod)
- [%bccb *] [%rock %n 0]
- [%bccl *] |- ^- hoon
- ?~ t.p.mod ^$(mod i.p.mod)
- :- ^$(mod i.p.mod)
- $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
- [%bccn *] :: use last entry
- ::
- |- ^- hoon
- ?~ t.p.mod ^$(mod i.p.mod)
- $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
- [%bchp *] :: see under %bccb
- ::
- [%rock %n 0]
- [%bcgl *] $(mod q.mod)
- [%bcgr *] $(mod q.mod)
- [%bckt *] $(mod q.mod)
- [%bcls *] [%note [%know p.mod] $(mod q.mod)]
- [%bcmc *] :: borrow sample
- ::
- [%tsgl [%$ 6] p.mod]
- [%bcpm *] $(mod p.mod)
- [%bcsg *] [%kthp q.mod p.mod]
- [%bcts *] [%ktts p.mod $(mod q.mod)]
- [%bcpt *] $(mod p.mod)
- [%bcwt *] :: use last entry
- ::
- |- ^- hoon
- ?~ t.p.mod ^$(mod i.p.mod)
- $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
- [%bcdt *] [%rock %n 0]
- [%bcfs *] [%rock %n 0]
- [%bctc *] [%rock %n 0]
- [%bczp *] [%rock %n 0]
- ==
- ::
- ++ example
- :: produce a correctly typed default instance
- ::
- ~+
- ^- hoon
- ?+ mod
- :: in the general case, make and analyze a spore
- ::
- :+ %tsls
- spore
- ~(relative analyze:(descend 3) 2)
- ::
- [%base *] (decorate (basal p.mod))
- [%dbug *] example(mod q.mod, bug [p.mod bug])
- [%gist *] example(mod q.mod, nut `p.mod)
- [%leaf *] (decorate [%rock p.mod q.mod])
- [%like *] example(mod bcmc/(unreel p.mod q.mod))
- [%loop *] [%limb p.mod]
- [%made *] example(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)])
- [%make *] example(mod bcmc/(unfold p.mod q.mod))
- [%name *] example(mod q.mod, nut `made/[p.mod ~])
- [%over *] example(hay p.mod, mod q.mod)
- ::
- [%bccb *] (decorate (home p.mod))
- [%bccl *] %- decorate
- |- ^- hoon
- ?~ t.p.mod
- example:clear(mod i.p.mod)
- :- example:clear(mod i.p.mod)
- example:clear(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
- [%bchp *] (decorate (function:clear p.mod q.mod))
- [%bcmc *] (decorate (home [%tsgl [%limb %$] p.mod]))
- [%bcsg *] [%ktls example(mod q.mod) (home p.mod)]
- [%bcls *] (decorate [%note [%know p.mod] example(mod q.mod)])
- [%bcts *] (decorate [%ktts p.mod example:clear(mod q.mod)])
- [%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
- [%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
- [%bczp *] (decorate (home (interface %lead p.mod q.mod)))
- [%bctc *] (decorate (home (interface %zinc p.mod q.mod)))
- ==
- ::
- ++ factory
- :: make a normalizing gate (mold)
- ::
- ^- hoon
- :: process annotations outside construct, to catch default
- ::
- ::TODO: try seeing if putting %gist in here fixes %brbc
- ?: ?=(%dbug -.mod) factory(mod q.mod, bug [p.mod bug])
- ?: ?=(%bcsg -.mod) factory(mod q.mod, def `[%kthp q.mod p.mod])
- ^- hoon
- :: if we recognize an indirection
- ::
- ?: &(=(~ def) ?=(?(%bcmc %like %loop %make) -.mod))
- :: then short-circuit it
- ::
- %- decorate
- %- home
- ?- -.mod
- %bcmc p.mod
- %like (unreel p.mod q.mod)
- %loop [%limb p.mod]
- %make (unfold p.mod q.mod)
- ==
- :: else build a gate
- ::
- :+ %brcl
- [%ktsg spore]
- :+ %tsls
- ~(relative analyze:(descend 7) 6)
- :: trigger unifying equality
- ::
- :+ %tsls [%dtts $/14 $/2]
- $/6
- ::
- ++ analyze
- :: normalize a fragment of the subject
- ::
- |_ $: :: axe: axis to fragment
- ::
- axe=axis
- ==
- ++ basic
- |= bas=base
- ^- hoon
- ?- bas
- [%atom *]
- :+ %ktls example
- ^- hoon
- :^ %zppt
- [[[%| 0 `%ruth] ~] ~]
- [%cnls [%limb %ruth] [%sand %ta p.bas] fetch]
- [%wtpt fetch-wing fetch [%zpzp ~]]
- ::
- %cell
- :+ %ktls example
- =+ fetch-wing
- :- [%wing [[%& %2] -]]
- [%wing [[%& %3] -]]
- ::
- %flag
- :^ %wtcl
- [%dtts [%rock %$ &] [%$ axe]]
- [%rock %f &]
- :+ %wtgr
- [%dtts [%rock %$ |] [%$ axe]]
- [%rock %f |]
- ::
- %noun
- fetch
- ::
- %null
- :+ %wtgr
- [%dtts [%bust %noun] [%$ axe]]
- [%rock %n ~]
- :::
- %void
- [%zpzp ~]
- ==
- ++ clear
- .(..analyze ^clear)
- ::
- ++ fetch
- :: load the fragment
- ::
- ^- hoon
- [%$ axe]
- ::
- ++ fetch-wing
- :: load, as a wing
- ::
- ^- wing
- [[%& axe] ~]
- ::
- ++ choice
- :: match full models, by trying them
- ::
- |= $: :: one: first option
- :: rep: other options
- ::
- one=spec
- rep=(list spec)
- ==
- ^- hoon
- :: if no other choices, construct head
- ::
- ?~ rep relative:clear(mod one)
- :: build test
- ::
- :^ %wtcl
- :: if we fit the type of this choice
- ::
- [%fits example:clear(mod one) fetch-wing]
- :: build with this choice
- ::
- relative:clear(mod one)
- :: continue through loop
- ::
- $(one i.rep, rep t.rep)
- ::
- ++ switch
- |= $: :: one: first format
- :: two: more formats
- ::
- one=spec
- rep=(list spec)
- ==
- |- ^- hoon
- :: if no other choices, construct head
- ::
- ?~ rep relative:clear(mod one)
- :: fin: loop completion
- ::
- =/ fin=hoon $(one i.rep, rep t.rep)
- :: interrogate this instance
- ::
- :^ %wtcl
- :: test if the head matches this wing
- ::
- :+ %fits
- [%tsgl [%$ 2] example:clear(mod one)]
- fetch-wing(axe (peg axe 2))
- :: if so, use this form
- ::
- relative:clear(mod one)
- :: continue in the loop
- ::
- fin
- ::
- ++ relative
- :: local constructor
- ::
- ~+
- ^- hoon
- ?- mod
- ::
- :: base
- ::
- [%base *]
- (decorate (basic:clear p.mod))
- ::
- :: debug
- ::
- [%dbug *]
- relative(mod q.mod, bug [p.mod bug])
- ::
- :: formal comment
- ::
- [%gist *]
- relative(mod q.mod, nut `p.mod)
- ::
- :: constant
- ::
- [%leaf *]
- %- decorate
- :+ %wtgr
- [%dtts fetch [%rock %$ q.mod]]
- [%rock p.mod q.mod]
- ::
- :: composite
- ::
- [%make *]
- relative(mod bcmc/(unfold p.mod q.mod))
- ::
- :: indirect
- ::
- [%like *]
- relative(mod bcmc/(unreel p.mod q.mod))
- ::
- :: loop
- ::
- [%loop *]
- (decorate [%cnhp [%limb p.mod] fetch])
- ::
- :: simple named structure
- ::
- [%name *]
- relative(mod q.mod, nut `made/[p.mod ~])
- ::
- :: synthetic named structure
- ::
- [%made *]
- relative(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)])
- ::
- :: subjective
- ::
- [%over *]
- relative(hay p.mod, mod q.mod)
- ::
- :: recursive, $$
- ::
- [%bcbc *]
- ::
- :: apply semantically
- ::
- :+ %brkt
- relative(mod p.mod, dom (peg 3 dom))
- =- [[%$ ~ -] ~ ~]
- %- ~(gas by *(map term hoon))
- ^- (list (pair term hoon))
- %+ turn
- ~(tap by q.mod)
- |= [=term =spec]
- [term relative(mod spec, dom (peg 3 dom))]
- ::
- :: normalize, $&
- ::
- [%bcpm *]
- :: push the raw result
- ::
- :+ %tsls relative(mod p.mod)
- :: push repair function
- ::
- :+ %tsls
- [%tsgr $/3 q.mod]
- :: push repaired product
- ::
- :+ %tsls
- [%cnhp $/2 $/6]
- :: sanity-check repaired product
- ::
- :+ %wtgr
- :: either
- ::
- :~ %wtbr
- :: the repair did not change anything
- ::
- [%dtts $/14 $/2]
- :: when we fix it again, it stays fixed
- ::
- [%dtts $/2 [%cnhp $/6 $/2]]
- ==
- $/2
- ::
- :: verify, $|
- ::
- [%bcbr *]
- ^- hoon
- :: push the raw product
- ::
- :+ %tsls relative(mod p.mod)
- ^- hoon
- :: assert
- ::
- :+ %wtgr
- :: run the verifier
- ::
- [%cnhp [%tsgr $/3 q.mod] $/2]
- :: produce verified product
- ::
- $/2
- ::
- :: special, $_
- ::
- [%bccb *]
- (decorate (home p.mod))
- ::
- :: switch, $%
- ::
- [%bccn *]
- (decorate (switch i.p.mod t.p.mod))
- ::
- :: tuple, $:
- ::
- [%bccl *]
- %- decorate
- |- ^- hoon
- ?~ t.p.mod
- relative:clear(mod i.p.mod)
- :- relative:clear(mod i.p.mod, axe (peg axe 2))
- %= relative
- i.p.mod i.t.p.mod
- t.p.mod t.t.p.mod
- axe (peg axe 3)
- ==
- ::
- :: exclude, $<
- ::
- [%bcgl *]
- :+ %tsls
- relative:clear(mod q.mod)
- :+ %wtgl
- [%wtts [%over ~[&/3] p.mod] ~[&/4]]
- $/2
- ::
- :: require, $>
- ::
- [%bcgr *]
- :+ %tsls
- relative:clear(mod q.mod)
- :+ %wtgr
- [%wtts [%over ~[&/3] p.mod] ~[&/4]]
- $/2
- ::
- :: function
- ::
- [%bchp *]
- %- decorate
- =/ fun (function:clear p.mod q.mod)
- ?^ def
- [%ktls fun u.def]
- fun
- ::
- :: bridge, $^
- ::
- [%bckt *]
- %- decorate
- :^ %wtcl
- [%dtwt fetch(axe (peg axe 2))]
- relative:clear(mod p.mod)
- relative:clear(mod q.mod)
- ::
- :: synthesis, $;
- ::
- [%bcmc *]
- (decorate [%cncl (home p.mod) fetch ~])
- ::
- :: default
- ::
- [%bcsg *]
- relative(mod q.mod, def `[%kthp q.mod p.mod])
- ::
- :: choice, $?
- ::
- [%bcwt *]
- (decorate (choice i.p.mod t.p.mod))
- ::
- :: name, $=
- ::
- [%bcts *]
- [%ktts p.mod relative(mod q.mod)]
- ::
- :: branch, $@
- ::
- [%bcpt *]
- %- decorate
- :^ %wtcl
- [%dtwt fetch]
- relative:clear(mod q.mod)
- relative:clear(mod p.mod)
- ::
- [%bcls *] [%note [%know p.mod] relative(mod q.mod)]
- [%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
- [%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
- [%bczp *] (decorate (home (interface %lead p.mod q.mod)))
- [%bctc *] (decorate (home (interface %zinc p.mod q.mod)))
- ==
- --
- --
- ::
- ++ ap :: hoon engine
- ~% %ap
- +>+
- ==
- %open open
- %rake rake
- ==
- |_ gen=hoon
- ::
- ++ grip
- |= =skin
- =| rel=wing
- |- ^- hoon
- ?- skin
- @
- [%tsgl [%tune skin] gen]
- [%base *]
- ?: ?=(%noun base.skin)
- gen
- [%kthp skin gen]
- ::
- [%cell *]
- =+ haf=~(half ap gen)
- ?^ haf
- :- $(skin skin.skin, gen p.u.haf)
- $(skin ^skin.skin, gen q.u.haf)
- :+ %tsls
- gen
- :- $(skin skin.skin, gen [%$ 4])
- $(skin ^skin.skin, gen [%$ 5])
- ::
- [%dbug *]
- [%dbug spot.skin $(skin skin.skin)]
- ::
- [%leaf *]
- [%kthp skin gen]
- ::
- [%help *]
- [%note [%help help.skin] $(skin skin.skin)]
- ::
- [%name *]
- [%tsgl [%tune term.skin] $(skin skin.skin)]
- ::
- [%over *]
- $(skin skin.skin, rel (weld wing.skin rel))
- ::
- [%spec *]
- :+ %kthp
- ?~(rel spec.skin [%over rel spec.skin])
- $(skin skin.skin)
- ::
- [%wash *]
- :+ %tsgl
- :- %wing
- |- ^- wing
- ?: =(0 depth.skin) ~
- [[%| 0 ~] $(depth.skin (dec depth.skin))]
- gen
- ==
- ::
- ++ name
- |- ^- (unit term)
- ?+ gen ~
- [%wing *] ?~ p.gen ~
- ?^ i.p.gen
- ?:(?=(%& -.i.p.gen) ~ q.i.p.gen)
- `i.p.gen
- [%limb *] `p.gen
- [%dbug *] $(gen ~(open ap gen))
- [%tsgl *] $(gen ~(open ap gen))
- [%tsgr *] $(gen q.gen)
- ==
- ::
- ++ feck
- |- ^- (unit term)
- ?- gen
- [%sand %tas @] [~ q.gen]
- [%dbug *] $(gen q.gen)
- * ~
- ==
- ::
- :: not used at present; see comment at %csng in ++open
- ::::
- ::++ hail
- :: |= axe=axis
- :: =| air=(list (pair wing hoon))
- :: |- ^+ air
- :: =+ hav=half
- :: ?~ hav [[[[%| 0 ~] [%& axe] ~] gen] air]
- :: $(gen p.u.hav, axe (peg axe 2), air $(gen q.u.hav, axe (peg axe 3)))
- ::
- ++ half
- |- ^- (unit (pair hoon hoon))
- ?+ gen ~
- [^ *] `[p.gen q.gen]
- [%dbug *] $(gen q.gen)
- [%clcb *] `[q.gen p.gen]
- [%clhp *] `[p.gen q.gen]
- [%clkt *] `[p.gen %clls q.gen r.gen s.gen]
- [%clsg *] ?~(p.gen ~ `[i.p.gen %clsg t.p.gen])
- [%cltr *] ?~ p.gen ~
- ?~(t.p.gen $(gen i.p.gen) `[i.p.gen %cltr t.p.gen])
- ==
- ::::
- :: +flay: hoon to skin
- ::
- ++ flay
- |- ^- (unit skin)
- ?+ gen
- =+(open ?:(=(- gen) ~ $(gen -)))
- ::
- [^ *]
- =+ [$(gen p.gen) $(gen q.gen)]
- ?~(-< ~ ?~(-> ~ `[%cell -<+ ->+]))
- ::
- [%base *]
- `gen
- ::
- [%rock *]
- ?@(q.gen `[%leaf p.gen q.gen] ~)
- ::
- [%cnts [@ ~] ~]
- `i.p.gen
- ::
- [%tsgr *]
- %+ biff reek(gen p.gen)
- |= =wing
- (bind ^$(gen q.gen) |=(=skin [%over wing skin]))
- ::
- [%limb @]
- `p.gen
- ::
- [%note [%help *] *]
- (bind $(gen q.gen) |=(=skin [%help p.p.gen skin]))
- ::
- [%wing *]
- ?: ?=([@ ~] p.gen)
- `i.p.gen
- =/ depth 0
- |- ^- (unit skin)
- ?~ p.gen `[%wash depth]
- ?. =([%| 0 ~] i.p.gen) ~
- $(p.gen t.p.gen)
- ::
- [%kttr *]
- `[%spec p.gen %base %noun]
- ::
- [%ktts *]
- %+ biff $(gen q.gen)
- |= =skin
- ?@ p.gen `[%name p.gen skin]
- ?. ?=([%name @ [%base %noun]] p.gen) ~
- `[%name term.p.gen skin]
- ==
- ::
- :: +open: desugarer
- ++ open
- ^- hoon
- ?- gen
- [~ *] [%cnts [[%& p.gen] ~] ~]
- ::
- [%base *] ~(factory ax `spec`gen)
- [%bust *] ~(example ax %base p.gen)
- [%ktcl *] ~(factory ax p.gen)
- [%dbug *] q.gen
- [%eror *] ~_((crip p.gen) !!)
- ::
- [%knit *] ::
- :+ %tsgr [%ktts %v %$ 1] :: => v=.
- :- %brhp :: |-
- :+ %ktls :: ^+
- :- %brhp :: |-
- :^ %wtcl :: ?:
- [%bust %flag] :: ?
- [%bust %null] :: ~
- :- [%ktts %i [%sand 'tD' *@]] :: :- i=~~
- [%ktts %t [%limb %$]] :: t=$
- |- ^- hoon ::
- ?~ p.gen ::
- [%bust %null] :: ~
- =+ res=$(p.gen t.p.gen) ::
- ^- hoon ::
- ?@ i.p.gen ::
- [[%sand 'tD' i.p.gen] res] :: [~~{i.p.gen} {res}]
- :+ %tsls ::
- :- :+ %ktts :: ^=
- %a :: a
- :+ %ktls :: ^+
- [%limb %$] :: $
- [%tsgr [%limb %v] p.i.p.gen] :: =>(v {p.i.p.gen})
- [%ktts %b res] :: b=[res]
- ^- hoon ::
- :- %brhp :: |-
- :^ %wtpt :: ?@
- [%a ~] :: a
- [%limb %b] :: b
- :- [%tsgl [%$ 2] [%limb %a]] :: :- -.a
- :+ %cnts :: %=
- [%$ ~] :: $
- [[[%a ~] [%tsgl [%$ 3] [%limb %a]]] ~] :: a +.a
- ::
- [%leaf *] ~(factory ax `spec`gen)
- [%limb *] [%cnts [p.gen ~] ~]
- [%tell *] [%cncl [%limb %noah] [%zpgr [%cltr p.gen]] ~]
- [%wing *] [%cnts p.gen ~]
- [%yell *] [%cncl [%limb %cain] [%zpgr [%cltr p.gen]] ~]
- [%note *] q.gen
- ::
- ::TODO: does %gist need to be special cased here?
- [%brbc *] =- ?~ - !!
- :+ %brtr
- [%bccl -]
- |-
- ?. ?=([%gist *] body.gen)
- [%ktcl body.gen]
- [%note p.body.gen $(body.gen q.body.gen)]
- %+ turn `(list term)`sample.gen
- |= =term
- ^- spec
- =/ tar [%base %noun]
- [%bcts term [%bcsg tar [%bchp tar tar]]]
- [%brcb *] :+ %tsls [%kttr p.gen]
- :+ %brcn ~
- %- ~(run by r.gen)
- |= =tome
- :- p.tome
- %- ~(run by q.tome)
- |= =hoon
- ?~ q.gen hoon
- [%tstr [p.i.q.gen ~] q.i.q.gen $(q.gen t.q.gen)]
- [%brcl *] [%tsls p.gen [%brdt q.gen]]
- [%brdt *] :+ %brcn ~
- =- [[%$ ~ -] ~ ~]
- (~(put by *(map term hoon)) %$ p.gen)
- [%brkt *] :+ %tsgl [%limb %$]
- :+ %brcn ~
- =+ zil=(~(get by q.gen) %$)
- ?~ zil
- %+ ~(put by q.gen) %$
- [*what [[%$ p.gen] ~ ~]]
- %+ ~(put by q.gen) %$
- [p.u.zil (~(put by q.u.zil) %$ p.gen)]
- [%brhp *] [%tsgl [%limb %$] [%brdt p.gen]]
- [%brsg *] [%ktbr [%brts p.gen q.gen]]
- [%brtr *] :+ %tsls [%kttr p.gen]
- :+ %brpt ~
- =- [[%$ ~ -] ~ ~]
- (~(put by *(map term hoon)) %$ q.gen)
- [%brts *] :+ %brcb p.gen
- =- [~ [[%$ ~ -] ~ ~]]
- (~(put by *(map term hoon)) %$ q.gen)
- [%brwt *] [%ktwt %brdt p.gen]
- ::
- [%clkt *] [p.gen q.gen r.gen s.gen]
- [%clls *] [p.gen q.gen r.gen]
- [%clcb *] [q.gen p.gen]
- [%clhp *] [p.gen q.gen]
- [%clsg *]
- |- ^- hoon
- ?~ p.gen
- [%rock %n ~]
- [i.p.gen $(p.gen t.p.gen)]
- ::
- [%cltr *]
- |- ^- hoon
- ?~ p.gen
- [%zpzp ~]
- ?~ t.p.gen
- i.p.gen
- [i.p.gen $(p.gen t.p.gen)]
- ::
- [%kttr *] [%ktsg ~(example ax p.gen)]
- [%cncb *] [%ktls [%wing p.gen] %cnts p.gen q.gen]
- [%cndt *] [%cncl q.gen [p.gen ~]]
- [%cnkt *] [%cncl p.gen q.gen r.gen s.gen ~]
- [%cnls *] [%cncl p.gen q.gen r.gen ~]
- [%cnhp *] [%cncl p.gen q.gen ~]
- :: this probably should work, but doesn't
- ::
- :: [%cncl *] [%cntr [%$ ~] p.gen [[[[%& 6] ~] [%cltr q.gen]] ~]]
- [%cncl *] [%cnsg [%$ ~] p.gen q.gen]
- [%cnsg *]
- :: this complex matching system is a leftover from the old
- :: "electroplating" era. %cnsg should be removed and replaced
- :: with the commented-out %cncl above. but something is broken.
- ::
- :^ %cntr p.gen q.gen
- =+ axe=6
- |- ^- (list [wing hoon])
- ?~ r.gen ~
- ?~ t.r.gen [[[[%| 0 ~] [%& axe] ~] i.r.gen] ~]
- :- [[[%| 0 ~] [%& (peg axe 2)] ~] i.r.gen]
- $(axe (peg axe 3), r.gen t.r.gen)
- ::
- [%cntr *]
- ?: =(~ r.gen)
- [%tsgr q.gen [%wing p.gen]]
- :+ %tsls
- q.gen
- :+ %cnts
- (weld p.gen `wing`[[%& 2] ~])
- (turn r.gen |=([p=wing q=hoon] [p [%tsgr [%$ 3] q]]))
- ::
- [%ktdt *] [%ktls [%cncl p.gen q.gen ~] q.gen]
- [%kthp *] [%ktls ~(example ax p.gen) q.gen]
- [%ktts *] (grip(gen q.gen) p.gen)
- ::
- [%sgbr *]
- :+ %sggr
- :- %mean
- =+ fek=~(feck ap p.gen)
- ?^ fek [%rock %tas u.fek]
- [%brdt [%cncl [%limb %cain] [%zpgr [%tsgr [%$ 3] p.gen]] ~]]
- q.gen
- ::
- [%sgcb *] [%sggr [%mean [%brdt p.gen]] q.gen]
- [%sgcn *]
- :+ %sggl
- :- %fast
- :- %clls
- :+ [%rock %$ p.gen]
- [%zpts q.gen]
- :- %clsg
- =+ nob=`(list hoon)`~
- |- ^- (list hoon)
- ?~ r.gen
- nob
- [[[%rock %$ p.i.r.gen] [%zpts q.i.r.gen]] $(r.gen t.r.gen)]
- s.gen
- ::
- [%sgfs *] [%sgcn p.gen [%$ 7] ~ q.gen]
- [%sggl *] [%tsgl [%sggr p.gen [%$ 1]] q.gen]
- [%sgbc *] [%sggr [%live [%rock %$ p.gen]] q.gen]
- [%sgls *] [%sggr [%memo %rock %$ p.gen] q.gen]
- [%sgpm *]
- :+ %sggr
- [%slog [%sand %$ p.gen] [%cncl [%limb %cain] [%zpgr q.gen] ~]]
- r.gen
- ::
- [%sgts *] [%sggr [%germ p.gen] q.gen]
- [%sgwt *]
- :+ %tsls [%wtdt q.gen [%bust %null] [[%bust %null] r.gen]]
- :^ %wtsg [%& 2]~
- [%tsgr [%$ 3] s.gen]
- [%sgpm p.gen [%$ 5] [%tsgr [%$ 3] s.gen]]
- ::
- [%mcts *]
- |-
- ?~ p.gen [%bust %null]
- ?- -.i.p.gen
- ^ [[%xray i.p.gen] $(p.gen t.p.gen)]
- %manx [p.i.p.gen $(p.gen t.p.gen)]
- %tape [[%mcfs p.i.p.gen] $(p.gen t.p.gen)]
- %call [%cncl p.i.p.gen [$(p.gen t.p.gen)]~]
- %marl =- [%cndt [p.i.p.gen $(p.gen t.p.gen)] -]
- ^- hoon
- :+ %tsbr [%base %cell]
- :+ %brpt ~
- ^- (map term tome)
- =- [[%$ ~ -] ~ ~]
- ^- (map term hoon)
- :_ [~ ~]
- =+ sug=[[%& 12] ~]
- :- %$
- :^ %wtsg sug
- [%cnts sug [[[[%& 1] ~] [%$ 13]] ~]]
- [%cnts sug [[[[%& 3] ~] [%cnts [%$ ~] [[sug [%$ 25]] ~]]] ~]]
- ==
- ::
- [%mccl *]
- ?- q.gen
- ~ [%zpzp ~]
- [* ~] i.q.gen
- ^
- :+ %tsls
- p.gen
- =+ yex=`(list hoon)`q.gen
- |- ^- hoon
- ?- yex
- [* ~] [%tsgr [%$ 3] i.yex]
- [* ^] [%cncl [%$ 2] [%tsgr [%$ 3] i.yex] $(yex t.yex) ~]
- ~ !!
- ==
- ==
- ::
- [%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
- [%mcgl *] [%cnls [%cnhp q ktcl+p] r [%brts p [%tsgr $+3 s]]]:gen
- ::
- [%mcsg *] :: ;~
- |- ^- hoon
- ?- q.gen
- ~ ~_(leaf+"open-mcsg" !!)
- ^
- :+ %tsgr [%ktts %v %$ 1] :: => v=.
- |- ^- hoon ::
- ?: ?=(~ t.q.gen) ::
- [%tsgr [%limb %v] i.q.gen] :: =>(v {i.q.gen})
- :+ %tsls [%ktts %a $(q.gen t.q.gen)] :: =+ ^= a
- :+ %tsls :: {$(q.gen t.q.gen)}
- [%ktts %b [%tsgr [%limb %v] i.q.gen]] :: =+ ^= b
- :+ %tsls :: =>(v {i.q.gen})
- :+ %ktts %c :: =+ c=,.+6.b
- :+ %tsgl ::
- [%wing [%| 0 ~] [%& 6] ~] ::
- [%limb %b] ::
- :- %brdt :: |.
- :^ %cnls :: %+
- [%tsgr [%limb %v] p.gen] :: =>(v {p.gen})
- [%cncl [%limb %b] [%limb %c] ~] :: (b c)
- :+ %cnts [%a ~] :: a(,.+6 c)
- [[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] ::
- == ::
- ::
- [%mcmc *] :: ;;
- [%cnhp ~(factory ax p.gen) q.gen]
- ::
- [%tsbr *]
- [%tsls ~(example ax p.gen) q.gen]
- ::
- [%tstr *]
- :+ %tsgl
- r.gen
- [%tune [[p.p.gen ~ ?~(q.p.gen q.gen [%kthp u.q.p.gen q.gen])] ~ ~] ~]
- ::
- [%tscl *]
- [%tsgr [%cncb [[%& 1] ~] p.gen] q.gen]
- ::
- [%tsfs *]
- [%tsls [%ktts p.gen q.gen] r.gen]
- ::
- [%tsmc *] [%tsfs p.gen r.gen q.gen]
- [%tsdt *]
- [%tsgr [%cncb [[%& 1] ~] [[p.gen q.gen] ~]] r.gen]
- [%tswt *] :: =?
- [%tsdt p.gen [%wtcl q.gen r.gen [%wing p.gen]] s.gen]
- ::
- [%tskt *] :: =^
- =+ wuy=(weld q.gen `wing`[%v ~]) ::
- :+ %tsgr [%ktts %v %$ 1] :: => v=.
- :+ %tsls [%ktts %a %tsgr [%limb %v] r.gen] :: =+ a==>(v \r.gen)
- :^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]]
- :+ %tsgr :- :+ %ktts [%over [%v ~] p.gen]
- [%tsgl [%$ 2] [%limb %a]]
- [%limb %v]
- s.gen
- ::
- [%tsgl *] [%tsgr q.gen p.gen]
- [%tsls *] [%tsgr [p.gen [%$ 1]] q.gen]
- [%tshp *] [%tsls q.gen p.gen]
- [%tssg *]
- |- ^- hoon
- ?~ p.gen [%$ 1]
- ?~ t.p.gen i.p.gen
- [%tsgr i.p.gen $(p.gen t.p.gen)]
- ::
- [%wtbr *]
- |-
- ?~(p.gen [%rock %f 1] [%wtcl i.p.gen [%rock %f 0] $(p.gen t.p.gen)])
- ::
- [%wtdt *] [%wtcl p.gen r.gen q.gen]
- [%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen]
- [%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]]
- [%wtkt *] [%wtcl [%wtts [%base %atom %$] p.gen] r.gen q.gen]
- ::
- [%wthp *]
- |-
- ?~ q.gen
- [%lost [%wing p.gen]]
- :^ %wtcl
- [%wtts p.i.q.gen p.gen]
- q.i.q.gen
- $(q.gen t.q.gen)
- ::
- [%wtls *]
- [%wthp p.gen (weld r.gen `_r.gen`[[[%base %noun] q.gen] ~])]
- ::
- [%wtpm *]
- |-
- ?~(p.gen [%rock %f 0] [%wtcl i.p.gen $(p.gen t.p.gen) [%rock %f 1]])
- ::
- [%xray *]
- |^ :- [(open-mane n.g.p.gen) %clsg (turn a.g.p.gen open-mart)]
- [%mcts c.p.gen]
- ::
- ++ open-mane
- |= a=mane:hoot
- ?@(a [%rock %tas a] [[%rock %tas -.a] [%rock %tas +.a]])
- ::
- ++ open-mart
- |= [n=mane:hoot v=(list beer:hoot)]
- [(open-mane n) %knit v]
- --
- ::
- [%wtpt *] [%wtcl [%wtts [%base %atom %$] p.gen] q.gen r.gen]
- [%wtsg *] [%wtcl [%wtts [%base %null] p.gen] q.gen r.gen]
- [%wtts *] [%fits ~(example ax p.gen) q.gen]
- [%wtzp *] [%wtcl p.gen [%rock %f 1] [%rock %f 0]]
- [%zpgr *]
- [%cncl [%limb %onan] [%zpmc [%kttr [%bcmc %limb %abel]] p.gen] ~]
- ::
- [%zpwt *]
- ?: ?: ?=(@ p.gen)
- (lte hoon-version p.gen)
- &((lte hoon-version p.p.gen) (gte hoon-version q.p.gen))
- q.gen
- ~_(leaf+"hoon-version" !!)
- ::
- * gen
- ==
- ::
- ++ rake ~>(%mean.'rake-hoon' (need reek))
- ++ reek
- ^- (unit wing)
- ?+ gen ~
- [~ *] `[[%& p.gen] ~]
- [%limb *] `[p.gen ~]
- [%wing *] `p.gen
- [%cnts * ~] `p.gen
- [%dbug *] reek(gen q.gen)
- ==
- ++ rusk
- ^- term
- =+ wig=rake
- ?. ?=([@ ~] wig)
- ~>(%mean.'rusk-hoon' !!)
- i.wig
- --
- ::
- :: 5c: compiler backend and prettyprinter
- +| %compiler-backend-and-prettyprinter
- ::
- ++ ut
- ~% %ut
- +>+
- ==
- %ar ar
- %fan fan
- %rib rib
- %vet vet
- %blow blow
- %burp burp
- %busk busk
- %buss buss
- %crop crop
- %duck duck
- %dune dune
- %dunk dunk
- %epla epla
- %emin emin
- %emul emul
- %feel feel
- %felt felt
- %fine fine
- %fire fire
- %fish fish
- %fond fond
- %fund fund
- %funk funk
- %fuse fuse
- %gain gain
- %lose lose
- %mile mile
- %mine mine
- %mint mint
- %moot moot
- %mull mull
- %nest nest
- %peel peel
- %play play
- %peek peek
- %repo repo
- %rest rest
- %sink sink
- %tack tack
- %toss toss
- %wrap wrap
- ==
- =+ :* fan=*(set [type hoon])
- rib=*(set [type type hoon])
- vet=`?`&
- ==
- =+ sut=`type`%noun
- |%
- ++ clip
- |= ref=type
- ?> ?|(!vet (nest(sut ref) & sut))
- ref
- ::
- :: +ar: texture engine
- ::
- ++ ar !:
- ~% %ar
- +>
- ==
- %fish fish
- %gain gain
- %lose lose
- ==
- |_ [ref=type =skin]
- ::
- :: +fish: make a $nock that tests a .ref at .axis for .skin
- ::
- ++ fish
- |= =axis
- ^- nock
- ?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
- ?- -.skin
- ::
- %base
- ?- base.skin
- %cell $(skin [%cell [%base %noun] [%base %noun]])
- %flag ?: (~(nest ut bool) | ref)
- [%1 &]
- %+ flan
- $(skin [%base %atom %$])
- %+ flor
- [%5 [%0 axis] [%1 &]]
- [%5 [%0 axis] [%1 |]]
- %noun [%1 &]
- %null $(skin [%leaf %n ~])
- %void [%1 |]
- [%atom *] ?: (~(nest ut [%atom %$ ~]) | ref)
- [%1 &]
- ?: (~(nest ut [%cell %noun %noun]) | ref)
- [%1 |]
- (flip [%3 %0 axis])
- ==
- ::
- %cell
- ?: (~(nest ut [%atom %$ ~]) | ref) [%1 |]
- %+ flan
- ?: (~(nest ut [%cell %noun %noun]) | ref)
- [%1 &]
- [%3 %0 axis]
- %+ flan
- $(ref (peek(sut ref) %free 2), axis (peg axis 2), skin skin.skin)
- $(ref (peek(sut ref) %free 3), axis (peg axis 3), skin ^skin.skin)
- ::
- %leaf
- ?: (~(nest ut [%atom %$ `atom.skin]) | ref)
- [%1 &]
- [%5 [%1 atom.skin] [%0 axis]]
- ::
- %dbug $(skin skin.skin)
- %help $(skin skin.skin)
- %name $(skin skin.skin)
- %over ::NOTE might need to guard with +feel, crashing is too strict
- =+ ~| %oops-guess-you-needed-feel-after-all
- fid=(fend %read wing.skin)
- $(sut p.fid, axis (peg axis q.fid), skin skin.skin)
- %spec =/ hit (~(play ut sut) ~(example ax spec.skin))
- ?> (~(nest ut hit) & ref)
- $(skin skin.skin)
- %wash [%1 &]
- ==
- ::
- :: +gain: make a $type by restricting .ref to .skin
- ::
- ++ gain
- |- ^- type
- ?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
- ?- -.skin
- ::
- %base
- ?- base.skin
- %cell $(skin [%cell [%base %noun] [%base %noun]])
- %flag (fork $(skin [%leaf %f &]) $(skin [%leaf %f |]) ~)
- %null $(skin [%leaf %n ~])
- %void %void
- %noun ?:((~(nest ut %void) | ref) %void ref)
- [%atom *]
- =| gil=(set type)
- |- ^- type
- ?- ref
- %void %void
- %noun [%atom p.base.skin ~]
- [%atom *] ?. (fitz p.base.skin p.ref)
- ~>(%mean.'atom-mismatch' !!)
- :+ %atom
- (max p.base.skin p.ref)
- q.ref
- [%cell *] %void
- [%core *] %void
- [%face *] $(ref q.ref)
- [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
- [%hint *] (hint p.ref $(ref q.ref))
- [%hold *] ?: (~(has in gil) ref) %void
- $(gil (~(put in gil) ref), ref repo(sut ref))
- ==
- ==
- ::
- %cell
- =| gil=(set type)
- |- ^- type
- ?- ref
- %void %void
- %noun =+ ^$(skin skin.skin)
- ?: =(%void -) %void
- (cell - ^$(skin ^skin.skin))
- [%atom *] %void
- [%cell *] =+ ^$(skin skin.skin, ref p.ref)
- ?: =(%void -) %void
- (cell - ^$(skin ^skin.skin, ref q.ref))
- [%core *] =+ ^$(skin skin.skin, ref p.ref)
- ?: =(%void -) %void
- ?. =(%noun ^skin.skin)
- (cell - ^$(skin ^skin.skin, ref %noun))
- [%core - q.ref]
- [%face *] $(ref q.ref)
- [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
- [%hint *] (hint p.ref $(ref q.ref))
- [%hold *] ?: (~(has in gil) ref) %void
- $(gil (~(put in gil) ref), ref repo(sut ref))
- ==
- ::
- %leaf
- =| gil=(set type)
- |- ^- type
- ?- ref
- %void %void
- %noun [%atom aura.skin `atom.skin]
- [%atom *] ?: &(?=(^ q.ref) !=(atom.skin u.q.ref))
- %void
- ?. (fitz aura.skin p.ref)
- ~>(%mean.'atom-mismatch' !!)
- :+ %atom
- (max aura.skin p.ref)
- `atom.skin
- [%cell *] %void
- [%core *] %void
- [%face *] $(ref q.ref)
- [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
- [%hint *] (hint p.ref $(ref q.ref))
- [%hold *] ?: (~(has in gil) ref) %void
- $(gil (~(put in gil) ref), ref repo(sut ref))
- ==
- ::
- %dbug $(skin skin.skin)
- %help (hint [sut %help help.skin] $(skin skin.skin))
- %name (face term.skin $(skin skin.skin))
- %over $(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
- %spec =/ hit (~(play ut sut) ~(example ax spec.skin))
- ?> (~(nest ut hit) & $(skin skin.skin))
- (~(fuse ut ref) hit)
- %wash =- $(ref (~(play ut ref) -))
- :- %wing
- |- ^- wing
- ?: =(0 depth.skin) ~
- [[%| 0 ~] $(depth.skin (dec depth.skin))]
- ==
- ::
- :: +lose: make a $type by restricting .ref to exclude .skin
- ::
- ++ lose
- |- ^- type
- ?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
- ?- -.skin
- ::
- %base
- ?- base.skin
- %cell $(skin [%cell [%base %noun] [%base %noun]])
- %flag $(ref $(skin [%leaf %f &]), skin [%leaf %f |])
- %null $(skin [%leaf %n ~])
- %void ref
- %noun %void
- [%atom *]
- =| gil=(set type)
- |- ^- type
- ?- ref
- %void %void
- %noun [%cell %noun %noun]
- [%atom *] %void
- [%cell *] ref
- [%core *] ref
- [%face *] (face p.ref $(ref q.ref))
- [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
- [%hint *] (hint p.ref $(ref q.ref))
- [%hold *] ?: (~(has in gil) ref) %void
- $(gil (~(put in gil) ref), ref repo(sut ref))
- ==
- ==
- ::
- %cell
- =| gil=(set type)
- |- ^- type
- ?- ref
- %void %void
- %noun ?. =([%cell [%base %noun] [%base %noun]] skin)
- ref
- [%atom %$ ~]
- [%atom *] ref
- [%cell *] =/ lef ^$(skin skin.skin, ref p.ref)
- =/ rig ^$(skin ^skin.skin, ref q.ref)
- (fork (cell lef rig) (cell lef q.ref) (cell p.ref rig) ~)
- [%core *] =+ ^$(skin skin.skin, ref p.ref)
- ?: =(%void -) %void
- ?. =(%noun ^skin.skin)
- (cell - ^$(skin ^skin.skin, ref %noun))
- [%core - q.ref]
- [%face *] $(ref q.ref)
- [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
- [%hint *] (hint p.ref $(ref q.ref))
- [%hold *] ?: (~(has in gil) ref) %void
- $(gil (~(put in gil) ref), ref repo(sut ref))
- ==
- ::
- %leaf
- =| gil=(set type)
- |- ^- type
- ?- ref
- %void %void
- %noun %noun
- [%atom *] ?: =(q.ref `atom.skin)
- %void
- ref
- [%cell *] ref
- [%core *] ref
- [%face *] (face p.ref $(ref q.ref))
- [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
- [%hint *] (hint p.ref $(ref q.ref))
- [%hold *] ?: (~(has in gil) ref) %void
- $(gil (~(put in gil) ref), ref repo(sut ref))
- ==
- ::
- %dbug $(skin skin.skin)
- %help $(skin skin.skin)
- %name $(skin skin.skin)
- %over ::TODO if we guard in +fish (+feel), we have to guard again here
- $(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
- %spec =/ hit (~(play ut sut) ~(example ax spec.skin))
- ?> (~(nest ut hit) & $(skin skin.skin))
- (~(crop ut ref) hit)
- %wash ref
- ==
- --
- ::
- ++ blow
- |= [gol=type gen=hoon]
- ^- [type nock]
- =+ pro=(mint gol gen)
- =+ jon=(apex:musk bran q.pro)
- ?: |(?=(~ jon) ?=(%wait -.u.jon))
- [p.pro q.pro]
- [p.pro %1 p.u.jon]
- ::
- ++ bran
- ~+
- =+ gil=*(set type)
- |- ~+ ^- seminoun:musk
- ?- sut
- %noun [full/[~ ~ ~] ~]
- %void [full/[~ ~ ~] ~]
- [%atom *] ?~(q.sut [full/[~ ~ ~] ~] [full/~ u.q.sut])
- [%cell *] (combine:musk $(sut p.sut) $(sut q.sut))
- [%core *] %+ combine:musk
- p.r.q.sut
- $(sut p.sut)
- [%face *] $(sut repo)
- [%fork *] [full/[~ ~ ~] ~]
- [%hint *] $(sut repo)
- [%hold *] ?: (~(has in gil) sut)
- [full/[~ ~ ~] ~]
- $(sut repo, gil (~(put in gil) sut))
- ==
- ::
- ++ burp
- :: expel undigested seminouns
- ::
- ^- type
- ~+
- =- ?.(=(sut -) - sut)
- ?+ sut sut
- [%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
- [%core *] :+ %core
- burp(sut p.sut)
- :* p.q.sut
- burp(sut q.q.sut)
- :_ q.r.q.sut
- ?: ?=([[%full ~] *] p.r.q.sut)
- p.r.q.sut
- [[%full ~ ~ ~] ~]
- ==
- [%face *] [%face p.sut burp(sut q.sut)]
- [%fork *] [%fork (~(run in p.sut) |=(type burp(sut +<)))]
- [%hint *] (hint [burp(sut p.p.sut) q.p.sut] burp(sut q.sut))
- [%hold *] [%hold burp(sut p.sut) q.sut]
- ==
- ::
- ++ busk
- ~/ %busk
- |= gen=hoon
- ^- type
- [%face [~ [gen ~]] sut]
- ::
- ++ buss
- ~/ %buss
- |= [cog=term gen=hoon]
- ^- type
- [%face [[[cog ~ gen] ~ ~] ~] sut]
- ::
- ++ crop
- ~/ %crop
- |= ref=type
- =+ bix=*(set [type type])
- =< dext
- |%
- ++ dext
- ^- type
- ~_ leaf+"crop"
- :: ~_ (dunk 'dext: sut')
- :: ~_ (dunk(sut ref) 'dext: ref')
- ?: |(=(sut ref) =(%noun ref))
- %void
- ?: =(%void ref)
- sut
- ?- sut
- [%atom *]
- ?+ ref sint
- [%atom *] ?^ q.sut
- ?^(q.ref ?:(=(q.ref q.sut) %void sut) %void)
- ?^(q.ref sut %void)
- [%cell *] sut
- ==
- ::
- [%cell *]
- ?+ ref sint
- [%atom *] sut
- [%cell *] ?. (nest(sut p.ref) | p.sut) sut
- (cell p.sut dext(sut q.sut, ref q.ref))
- ==
- ::
- [%core *] ?:(?=(?([%atom *] [%cell *]) ref) sut sint)
- [%face *] (face p.sut dext(sut q.sut))
- [%fork *] (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
- [%hint *] (hint p.sut dext(sut q.sut))
- [%hold *] ?< (~(has in bix) [sut ref])
- dext(sut repo, bix (~(put in bix) [sut ref]))
- %noun dext(sut repo)
- %void %void
- ==
- ::
- ++ sint
- ^- type
- ?+ ref !!
- [%core *] sut
- [%face *] dext(ref repo(sut ref))
- [%fork *] =+ yed=~(tap in p.ref)
- |- ^- type
- ?~ yed sut
- $(yed t.yed, sut dext(ref i.yed))
- [%hint *] dext(ref repo(sut ref))
- [%hold *] dext(ref repo(sut ref))
- ==
- --
- ::
- ++ cool
- |= [pol=? hyp=wing ref=type]
- ^- type
- =+ fid=(find %both hyp)
- ?- -.fid
- %| sut
- %& =< q
- %+ take p.p.fid
- |=(a=type ?:(pol (fuse(sut a) ref) (crop(sut a) ref)))
- ==
- ::
- ++ duck ^-(tank ~(duck us sut))
- ++ dune |.(duck)
- ++ dunk
- |= paz=term ^- tank
- :+ %palm
- [['.' ~] ['-' ~] ~ ~]
- [[%leaf (mesc (trip paz))] duck ~]
- ::
- ++ elbo
- |= [lop=palo rig=(list (pair wing hoon))]
- ^- type
- ?: ?=(%& -.q.lop)
- |- ^- type
- ?~ rig
- p.q.lop
- =+ zil=(play q.i.rig)
- =+ dar=(tack(sut p.q.lop) p.i.rig zil)
- %= $
- rig t.rig
- p.q.lop q.dar
- ==
- =+ hag=~(tap in q.q.lop)
- %- fire
- |- ^+ hag
- ?~ rig
- hag
- =+ zil=(play q.i.rig)
- =+ dix=(toss p.i.rig zil hag)
- %= $
- rig t.rig
- hag q.dix
- ==
- ::
- ++ ergo
- |= [lop=palo rig=(list (pair wing hoon))]
- ^- (pair type nock)
- =+ axe=(tend p.lop)
- =| hej=(list (pair axis nock))
- ?: ?=(%& -.q.lop)
- =- [p.- (hike axe q.-)]
- |- ^- (pair type (list (pair axis nock)))
- ?~ rig
- [p.q.lop hej]
- =+ zil=(mint %noun q.i.rig)
- =+ dar=(tack(sut p.q.lop) p.i.rig p.zil)
- %= $
- rig t.rig
- p.q.lop q.dar
- hej [[p.dar q.zil] hej]
- ==
- =+ hag=~(tap in q.q.lop)
- =- [(fire p.-) [%9 p.q.lop (hike axe q.-)]]
- |- ^- (pair (list (pair type foot)) (list (pair axis nock)))
- ?~ rig
- [hag hej]
- =+ zil=(mint %noun q.i.rig)
- =+ dix=(toss p.i.rig p.zil hag)
- %= $
- rig t.rig
- hag q.dix
- hej [[p.dix q.zil] hej]
- ==
- ::
- ++ endo
- |= [lop=(pair palo palo) dox=type rig=(list (pair wing hoon))]
- ^- (pair type type)
- ?: ?=(%& -.q.p.lop)
- ?> ?=(%& -.q.q.lop)
- |- ^- (pair type type)
- ?~ rig
- [p.q.p.lop p.q.q.lop]
- =+ zil=(mull %noun dox q.i.rig)
- =+ ^= dar
- :- p=(tack(sut p.q.p.lop) p.i.rig p.zil)
- q=(tack(sut p.q.q.lop) p.i.rig q.zil)
- ?> =(p.p.dar p.q.dar)
- %= $
- rig t.rig
- p.q.p.lop q.p.dar
- p.q.q.lop q.q.dar
- ==
- ?> ?=(%| -.q.q.lop)
- ?> =(p.q.p.lop p.q.q.lop)
- =+ hag=[p=~(tap in q.q.p.lop) q=~(tap in q.q.q.lop)]
- =- [(fire p.-) (fire(vet |) q.-)]
- |- ^- (pair (list (pair type foot)) (list (pair type foot)))
- ?~ rig
- hag
- =+ zil=(mull %noun dox q.i.rig)
- =+ ^= dix
- :- p=(toss p.i.rig p.zil p.hag)
- q=(toss p.i.rig q.zil q.hag)
- ?> =(p.p.dix p.q.dix)
- %= $
- rig t.rig
- hag [q.p.dix q.q.dix]
- ==
- ::
- ++ et
- |_ [hyp=wing rig=(list (pair wing hoon))]
- ::
- ++ play
- ^- type
- =+ lug=(find %read hyp)
- ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.p.lug))
- (elbo p.lug rig)
- ::
- ++ mint
- |= gol=type
- =- ?>(?|(!vet (nest(sut gol) & p.-)) -)
- ^- (pair type nock)
- =+ lug=(find %read hyp)
- ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.lug))
- (ergo p.lug rig)
- ::
- ++ mull
- |= [gol=type dox=type]
- =- ?>(?|(!vet (nest(sut gol) & p.-)) -)
- ^- (pair type type)
- =+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)]
- ?: ?=(%| -.p.lug)
- ?> &(?=(%| -.q.lug) ?=(~ rig))
- [p.p.p.lug p.p.q.lug]
- ?> ?=(%& -.q.lug)
- (endo [p.p.lug p.q.lug] dox rig)
- --
- ::
- ++ epla
- ~/ %epla
- |= [hyp=wing rig=(list (pair wing hoon))]
- ^- type
- ~(play et hyp rig)
- ::
- ++ emin
- ~/ %emin
- |= [gol=type hyp=wing rig=(list (pair wing hoon))]
- ^- (pair type nock)
- (~(mint et hyp rig) gol)
- ::
- ++ emul
- ~/ %emul
- |= [gol=type dox=type hyp=wing rig=(list (pair wing hoon))]
- ^- (pair type type)
- (~(mull et hyp rig) gol dox)
- ::
- ++ felt !!
- :: ::
- ++ feel :: detect existence
- |= rot=(list wing)
- ^- ?
- =. rot (flop rot)
- |- ^- ?
- ?~ rot &
- =/ yep (fond %free i.rot)
- ?~ yep |
- ?- -.yep
- %& %= $
- rot t.rot
- sut p:(fine %& p.yep)
- ==
- %| ?- -.p.yep
- %& |
- %| %= $
- rot t.rot
- sut p:(fine %| p.p.yep)
- ==
- == ==
- ::
- ++ fond
- ~/ %fond
- |= [way=vial hyp=wing]
- => |%
- ++ pony :: raw match
- $@ ~ :: void
- %+ each :: natural/abnormal
- palo :: arm or leg
- %+ each :: abnormal
- @ud :: unmatched
- (pair type nock) :: synthetic
- --
- ^- pony
- ?~ hyp
- [%& ~ %& sut]
- =+ mor=$(hyp t.hyp)
- ?- -.mor
- %|
- ?- -.p.mor
- %& mor
- %|
- =+ fex=(mint(sut p.p.p.mor) %noun [%wing i.hyp ~])
- [%| %| p.fex (comb q.p.p.mor q.fex)]
- ==
- ::
- %&
- =. sut
- =* lap q.p.mor
- ?- -.lap
- %& p.lap
- %| (fork (turn ~(tap in q.lap) head))
- ==
- => :_ +
- :* axe=`axis`1
- lon=p.p.mor
- heg=?^(i.hyp i.hyp [%| p=0 q=(some i.hyp)])
- ==
- ?: ?=(%& -.heg)
- [%& [`p.heg lon] %& (peek way p.heg)]
- =| gil=(set type)
- =< $
- |% ++ here ?: =(0 p.heg)
- [%& [~ `axe lon] %& sut]
- [%| %& (dec p.heg)]
- ++ lose [%| %& p.heg]
- ++ stop ?~(q.heg here lose)
- ++ twin |= [hax=pony yor=pony]
- ^- pony
- ~_ leaf+"find-fork"
- ?: =(hax yor) hax
- ?~ hax yor
- ?~ yor hax
- ?: ?=(%| -.hax)
- ?> ?& ?=(%| -.yor)
- ?=(%| -.p.hax)
- ?=(%| -.p.yor)
- =(q.p.p.hax q.p.p.yor)
- ==
- :+ %|
- %|
- [(fork p.p.p.hax p.p.p.yor ~) q.p.p.hax]
- ?> ?=(%& -.yor)
- ?> =(p.p.hax p.p.yor)
- ?: &(?=(%& -.q.p.hax) ?=(%& -.q.p.yor))
- :+ %& p.p.hax
- [%& (fork p.q.p.hax p.q.p.yor ~)]
- ?> &(?=(%| -.q.p.hax) ?=(%| -.q.p.yor))
- ?> =(p.q.p.hax p.q.p.yor)
- =+ wal=(~(uni in q.q.p.hax) q.q.p.yor)
- :+ %& p.p.hax
- [%| p.q.p.hax wal]
- ++ $
- ^- pony
- ?- sut
- %void ~
- %noun stop
- [%atom *] stop
- [%cell *]
- ?~ q.heg here
- =+ taf=$(axe (peg axe 2), sut p.sut)
- ?~ taf ~
- ?: |(?=(%& -.taf) ?=(%| -.p.taf))
- taf
- $(axe (peg axe 3), p.heg p.p.taf, sut q.sut)
- ::
- [%core *]
- ?~ q.heg here
- =^ zem p.heg
- =+ zem=(loot u.q.heg q.r.q.sut)
- ?~ zem [~ p.heg]
- ?:(=(0 p.heg) [zem 0] [~ (dec p.heg)])
- ?^ zem
- :+ %&
- [`axe lon]
- =/ zut ^- foot
- ?- q.p.q.sut
- %wet [%wet q.u.zem]
- %dry [%dry q.u.zem]
- ==
- [%| (peg 2 p.u.zem) [[sut zut] ~ ~]]
- =+ pec=(peel way r.p.q.sut)
- ?. sam.pec lose
- ?: con.pec $(sut p.sut, axe (peg axe 3))
- $(sut (peek(sut p.sut) way 2), axe (peg axe 6))
- ::
- [%hint *]
- $(sut repo)
- ::
- [%face *]
- ?: ?=(~ q.heg) here(sut q.sut)
- =* zot p.sut
- ?@ zot
- ?:(=(u.q.heg zot) here(sut q.sut) lose)
- =< main
- |%
- ++ main
- ^- pony
- =+ tyr=(~(get by p.zot) u.q.heg)
- ?~ tyr
- next
- ?~ u.tyr
- $(sut q.sut, lon [~ lon], p.heg +(p.heg))
- ?. =(0 p.heg)
- next(p.heg (dec p.heg))
- =+ tor=(fund way u.u.tyr)
- ?- -.tor
- %& [%& (weld p.p.tor `vein`[~ `axe lon]) q.p.tor]
- %| [%| %| p.p.tor (comb [%0 axe] q.p.tor)]
- ==
- ++ next
- |- ^- pony
- ?~ q.zot
- ^$(sut q.sut, lon [~ lon])
- =+ tiv=(mint(sut q.sut) %noun i.q.zot)
- =+ fid=^$(sut p.tiv, lon ~, axe 1, gil ~)
- ?~ fid ~
- ?: ?=([%| %& *] fid)
- $(q.zot t.q.zot, p.heg p.p.fid)
- =/ vat=(pair type nock)
- ?- -.fid
- %& (fine %& p.fid)
- %| (fine %| p.p.fid)
- ==
- [%| %| p.vat (comb (comb [%0 axe] q.tiv) q.vat)]
- --
- ::
- [%fork *]
- =+ wiz=(turn ~(tap in p.sut) |=(a=type ^$(sut a)))
- ?~ wiz ~
- |- ^- pony
- ?~ t.wiz i.wiz
- (twin i.wiz $(wiz t.wiz))
- ::
- [%hold *]
- ?: (~(has in gil) sut)
- ~
- $(gil (~(put in gil) sut), sut repo)
- ==
- --
- ==
- ::
- ++ find
- ~/ %find
- |= [way=vial hyp=wing]
- ^- port
- ~_ (show [%c %find] %l hyp)
- =- ?@ - !!
- ?- -<
- %& [%& p.-]
- %| ?- -.p.-
- %| [%| p.p.-]
- %& !!
- == ==
- (fond way hyp)
- ::
- ++ fend
- |= [way=vial hyp=wing]
- ^- (pair type axis)
- =+ fid=(find way hyp)
- ~> %mean.'fend-fragment'
- ?> &(?=(%& -.fid) ?=(%& -.q.p.fid))
- [p.q.p.fid (tend p.p.fid)]
- ::
- ++ fund
- ~/ %fund
- |= [way=vial gen=hoon]
- ^- port
- =+ hup=~(reek ap gen)
- ?~ hup
- [%| (mint %noun gen)]
- (find way u.hup)
- ::
- ++ fine
- ~/ %fine
- |= tor=port
- ^- (pair type nock)
- ?- -.tor
- %| p.tor
- %& =+ axe=(tend p.p.tor)
- ?- -.q.p.tor
- %& [`type`p.q.p.tor %0 axe]
- %| [(fire ~(tap in q.q.p.tor)) [%9 p.q.p.tor %0 axe]]
- == ==
- ::
- ++ fire
- |= hag=(list [p=type q=foot])
- ^- type
- ?: ?=([[* [%wet ~ %1]] ~] hag)
- p.i.hag
- %- fork
- %+ turn
- hag.$
- |= [p=type q=foot]
- ?. ?=([%core *] p)
- ~_ (dunk %fire-type)
- ~_ leaf+"expected-fork-to-be-core"
- ~_ (dunk(sut p) %fork-type)
- ~>(%mean.'fire-core' !!)
- :- %hold
- =+ dox=[%core q.q.p q.p(r.p %gold)]
- ?: ?=(%dry -.q)
- :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry)
- ?> ?|(!vet (nest(sut q.q.p) & p.p))
- [dox p.q]
- ?> ?=(%wet -.q)
- :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-wet)
- =. p.p (redo(sut p.p) q.q.p)
- ?> ?| !vet
- (~(has in rib) [sut dox p.q])
- !=(** (mull(sut p, rib (~(put in rib) sut dox p.q)) %noun dox p.q))
- ==
- [p p.q]
- ::
- ++ fish
- ~/ %fish
- |= axe=axis
- =+ vot=*(set type)
- |- ^- nock
- ?- sut
- %void [%1 1]
- %noun [%1 0]
- [%atom *] ?~ q.sut
- (flip [%3 %0 axe])
- [%5 [%1 u.q.sut] [%0 axe]]
- [%cell *]
- %+ flan
- [%3 %0 axe]
- (flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3)))
- ::
- [%core *] ~>(%mean.'fish-core' !!)
- [%face *] $(sut q.sut)
- [%fork *] =+ yed=~(tap in p.sut)
- |- ^- nock
- ?~(yed [%1 1] (flor ^$(sut i.yed) $(yed t.yed)))
- [%hint *] $(sut q.sut)
- [%hold *]
- ?: (~(has in vot) sut)
- ~>(%mean.'fish-loop' !!)
- => %=(. vot (~(put in vot) sut))
- $(sut repo)
- ==
- ::
- ++ fuse
- ~/ %fuse
- |= ref=type
- =+ bix=*(set [type type])
- |- ^- type
- ?: ?|(=(sut ref) =(%noun ref))
- sut
- ?- sut
- [%atom *]
- ?- ref
- [%atom *] =+ foc=?:((fitz p.ref p.sut) p.sut p.ref)
- ?^ q.sut
- ?^ q.ref
- ?: =(q.sut q.ref)
- [%atom foc q.sut]
- %void
- [%atom foc q.sut]
- [%atom foc q.ref]
- [%cell *] %void
- * $(sut ref, ref sut)
- ==
- [%cell *]
- ?- ref
- [%cell *] (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref))
- * $(sut ref, ref sut)
- ==
- ::
- [%core *] $(sut repo)
- [%face *] (face p.sut $(sut q.sut))
- [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
- [%hint *] (hint p.sut $(sut q.sut))
- [%hold *]
- ?: (~(has in bix) [sut ref])
- ~>(%mean.'fuse-loop' !!)
- $(sut repo, bix (~(put in bix) [sut ref]))
- ::
- %noun ref
- %void %void
- ==
- ::
- ++ gain
- ~/ %gain
- |= gen=hoon ^- type
- (chip & gen)
- ::
- ++ hemp
- :: generate formula from foot
- ::
- |= [hud=poly gol=type gen=hoon]
- ^- nock
- ~+
- =+ %hemp-141
- ?- hud
- %dry q:(mint gol gen)
- %wet q:(mint(vet |) gol gen)
- ==
- ::
- ++ laze
- :: produce lazy core generator for static execution
- ::
- |= [nym=(unit term) hud=poly dom=(map term tome)]
- ~+
- ^- seminoun
- =+ %hemp-141
- :: tal: map from battery axis to foot
- ::
- =; tal=(map @ud hoon)
- :: produce lazy battery
- ::
- :_ ~
- :+ %lazy 1
- |= axe=@ud
- ^- (unit noun)
- %+ bind (~(get by tal) axe)
- |= gen=hoon
- %. [hud %noun gen]
- hemp(sut (core sut [nym hud %gold] sut [[%lazy 1 ..^$] ~] dom))
- ::
- %- ~(gas by *(map @ud hoon))
- =| yeb=(list (pair @ud hoon))
- =+ axe=1
- |^ ?- dom
- ~ yeb
- [* ~ ~] (chapter q.q.n.dom)
- [* * ~] %= $
- dom l.dom
- axe (peg axe 3)
- yeb (chapter(axe (peg axe 2)) q.q.n.dom)
- ==
- [* ~ *] %= $
- dom r.dom
- axe (peg axe 3)
- yeb (chapter(axe (peg axe 2)) q.q.n.dom)
- ==
- [* * *] %= $
- dom r.dom
- axe (peg axe 7)
- yeb %= $
- dom l.dom
- axe (peg axe 6)
- yeb (chapter(axe (peg axe 2)) q.q.n.dom)
- == == ==
- ++ chapter
- |= dab=(map term hoon)
- ^+ yeb
- ?- dab
- ~ yeb
- [* ~ ~] [[axe q.n.dab] yeb]
- [* * ~] %= $
- dab l.dab
- axe (peg axe 3)
- yeb [[(peg axe 2) q.n.dab] yeb]
- ==
- [* ~ *] %= $
- dab r.dab
- axe (peg axe 3)
- yeb [[(peg axe 2) q.n.dab] yeb]
- ==
- [* * *] %= $
- dab r.dab
- axe (peg axe 7)
- yeb %= $
- dab l.dab
- axe (peg axe 6)
- yeb [[(peg axe 2) q.n.dab] yeb]
- == == ==
- --
- ::
- ++ lose
- ~/ %lose
- |= gen=hoon ^- type
- (chip | gen)
- ::
- ++ chip
- ~/ %chip
- |= [how=? gen=hoon] ^- type
- ?: ?=([%wtts *] gen)
- (cool how q.gen (play ~(example ax p.gen)))
- ?: ?=([%wthx *] gen)
- =+ fid=(find %both q.gen)
- ?- -.fid
- %| sut
- %& =< q
- %+ take p.p.fid
- |=(a=type ?:(how ~(gain ar a p.gen) ~(lose ar a p.gen)))
- ==
- ?: ?&(how ?=([%wtpm *] gen))
- |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
- ?: ?&(!how ?=([%wtbr *] gen))
- |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
- =+ neg=~(open ap gen)
- ?:(=(neg gen) sut $(gen neg))
- ::
- ++ bake
- |= [dox=type hud=poly dab=(map term hoon)]
- ^- *
- ?: ?=(~ dab)
- ~
- =+ ^= dov
- :: this seems wrong but it's actually right
- ::
- ?- hud
- %dry (mull %noun dox q.n.dab)
- %wet ~
- ==
- ?- dab
- [* ~ ~] dov
- [* ~ *] [dov $(dab r.dab)]
- [* * ~] [dov $(dab l.dab)]
- [* * *] [dov $(dab l.dab) $(dab r.dab)]
- ==
- ::
- ++ balk
- |= [dox=type hud=poly dom=(map term tome)]
- ^- *
- ?: ?=(~ dom)
- ~
- =+ dov=(bake dox hud q.q.n.dom)
- ?- dom
- [* ~ ~] dov
- [* ~ *] [dov $(dom r.dom)]
- [* * ~] [dov $(dom l.dom)]
- [* * *] [dov $(dom l.dom) $(dom r.dom)]
- ==
- ::
- ++ mile
- :: mull all chapters and feet in a core
- ::
- |= [dox=type mel=vair nym=(unit term) hud=poly dom=(map term tome)]
- ^- (pair type type)
- =+ yet=(core sut [nym hud %gold] sut (laze nym hud dom) dom)
- =+ hum=(core dox [nym hud %gold] dox (laze nym hud dom) dom)
- =+ (balk(sut yet) hum hud dom)
- [yet hum]
- ::
- ++ mine
- :: mint all chapters and feet in a core
- ::
- |= [gol=type mel=vair nym=(unit term) hud=poly dom=(map term tome)]
- ^- (pair type nock)
- |^
- =/ log (chapters-check (core-check gol))
- =/ dog (get-tomes log)
- =- :_ [%1 dez]
- (core sut [nym hud mel] sut [[%full ~] dez] dom)
- ^= dez
- =. sut (core sut [nym hud %gold] sut (laze nym hud dom) dom)
- |- ^- ?(~ ^)
- ?: ?=(~ dom)
- ~
- =/ dov=?(~ ^)
- =/ dab=(map term hoon) q.q.n.dom
- =/ dag (arms-check dab (get-arms dog p.n.dom))
- |- ^- ?(~ ^)
- ?: ?=(~ dab)
- ~
- =/ gog (get-arm-type log dag p.n.dab)
- =+ vad=(hemp hud gog q.n.dab)
- ?- dab
- [* ~ ~] vad
- [* ~ *] [vad $(dab r.dab)]
- [* * ~] [vad $(dab l.dab)]
- [* * *] [vad $(dab l.dab) $(dab r.dab)]
- ==
- ?- dom
- [* ~ ~] dov
- [* ~ *] [dov $(dom r.dom)]
- [* * ~] [dov $(dom l.dom)]
- [* * *] [dov $(dom l.dom) $(dom r.dom)]
- ==
- ::
- :: all the below arms are used for gol checking and should have no
- :: effect other than giving more specific errors
- ::
- :: +gol-type: all the possible types we could be expecting.
- ::
- +$ gol-type
- $~ %noun
- $@ %noun
- $% [%cell p=type q=type]
- [%core p=type q=coil]
- [%fork p=(set gol-type)]
- ==
- :: +core-check: check that we're looking for a core
- ::
- ++ core-check
- |= log=type
- |- ^- gol-type
- ?+ log $(log repo(sut log))
- %noun (nice log &)
- %void (nice %noun |)
- [%atom *] (nice %noun |)
- [%cell *] (nice log (nest(sut p.log) & %noun))
- [%core *] (nice log(r.p.q %gold) &)
- [%fork *]
- =/ tys ~(tap in p.log)
- :- %fork
- |- ^- (set gol-type)
- ?~ tys
- ~
- =/ a ^$(log i.tys)
- =/ b $(tys t.tys)
- (~(put in b) a)
- ==
- :: +chapters-check: check we have the expected number of chapters
- ::
- ++ chapters-check
- |= log=gol-type
- |- ^- gol-type
- ?- log
- %noun (nice log &)
- [%cell *] (nice log &)
- [%core *] ~_ leaf+"core-number-of-chapters"
- (nice log =(~(wyt by dom) ~(wyt by q.r.q.log)))
- [%fork *]
- =/ tys ~(tap in p.log)
- |- ^- gol-type
- ?~ tys
- log
- =/ a ^$(log i.tys)
- =/ b $(tys t.tys)
- log
- ==
- :: +get-tomes: get map of tomes if exists
- ::
- ++ get-tomes
- |= log=gol-type
- ^- (unit (map term tome))
- ?- log
- %noun ~
- [%cell *] ~
- [%fork *] ~ :: maybe could be more aggressive
- [%core *] `q.r.q.log
- ==
- :: +get-arms: get arms in tome
- ::
- ++ get-arms
- |= [dog=(unit (map term tome)) nam=term]
- ^- (unit (map term hoon))
- %+ bind dog
- |= a=(map term tome)
- ~_ leaf+"unexpcted-chapter.{(trip nam)}"
- q:(~(got by a) nam)
- :: +arms-check: check we have the expected number of arms
- ::
- ++ arms-check
- |= [dab=(map term hoon) dag=(unit (map term hoon))]
- ?~ dag
- dag
- =/ a
- =/ exp ~(wyt by u.dag)
- =/ hav ~(wyt by dab)
- ~_ =/ expt (scow %ud exp)
- =/ havt (scow %ud hav)
- leaf+"core-number-of-arms.exp={expt}.hav={havt}"
- ~_ =/ missing ~(tap in (~(dif in ~(key by u.dag)) ~(key by dab)))
- leaf+"missing.{<missing>}"
- ~_ =/ extra ~(tap in (~(dif in ~(key by dab)) ~(key by u.dag)))
- leaf+"extra.{<extra>}"
- ~_ =/ have ~(tap in ~(key by dab))
- leaf+"have.{<have>}"
- (nice dag =(exp hav))
- a
- :: +get-arm-type: get expected type of this arm
- ::
- ++ get-arm-type
- |= [log=gol-type dag=(unit (map term hoon)) nam=term]
- ^- type
- %- fall :_ %noun
- %+ bind dag
- |= a=(map term hoon)
- =/ gen=hoon
- ~_ leaf+"unexpected-arm.{(trip nam)}"
- (~(got by a) nam)
- (play(sut log) gen)
- ::
- ++ nice
- |* [typ=* gud=?]
- ?: gud
- typ
- ~_ leaf+"core-nice"
- !!
- --
- ::
- ++ mint
- ~/ %mint
- |= [gol=type gen=hoon]
- ^- [p=type q=nock]
- ::~& %pure-mint
- |^ ^- [p=type q=nock]
- ?: ?&(=(%void sut) !?=([%dbug *] gen))
- ?. |(!vet ?=([%lost *] gen) ?=([%zpzp *] gen))
- ~>(%mean.'mint-vain' !!)
- [%void %0 0]
- ?- gen
- ::
- [^ *]
- =+ hed=$(gen p.gen, gol %noun)
- =+ tal=$(gen q.gen, gol %noun)
- [(nice (cell p.hed p.tal)) (cons q.hed q.tal)]
- ::
- [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen)
- [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen)
- ::
- [%cnts *] (~(mint et p.gen q.gen) gol)
- ::
- [%dtkt *]
- =+ nef=$(gen [%kttr p.gen])
- [p.nef [%12 [%1 hoon-version p.nef] q:$(gen q.gen, gol %noun)]]
- ::
- [%dtls *] [(nice [%atom %$ ~]) [%4 q:$(gen p.gen, gol [%atom %$ ~])]]
- [%sand *] [(nice (play gen)) [%1 q.gen]]
- [%rock *] [(nice (play gen)) [%1 q.gen]]
- ::
- [%dttr *]
- [(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
- ::
- [%dtts *]
- [(nice bool) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
- ::
- [%dtwt *] [(nice bool) [%3 q:$(gen p.gen, gol %noun)]]
- [%hand *] [p.gen q.gen]
- [%ktbr *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %iron)) q.vat])
- ::
- [%ktls *]
- =+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)])
- ::
- [%ktpm *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %zinc)) q.vat])
- [%ktsg *] (blow gol p.gen)
- [%tune *] [(face p.gen sut) [%0 %1]]
- [%ktwt *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %lead)) q.vat])
- ::
- [%note *]
- =+ hum=$(gen q.gen)
- [(hint [sut p.gen] p.hum) q.hum]
- ::
- [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen))
- [%sggr *]
- =+ hum=$(gen q.gen)
- :: ?: &(huz !?=(%|(@ [?(%sgcn %sgls) ^]) p.gen))
- :: hum
- :- p.hum
- :+ %11
- ?- p.gen
- @ p.gen
- ^ [p.p.gen q:$(gen q.p.gen, gol %noun)]
- ==
- q.hum
- ::
- [%tsgr *]
- =+ fid=$(gen p.gen, gol %noun)
- =+ dov=$(sut p.fid, gen q.gen)
- [p.dov (comb q.fid q.dov)]
- ::
- [%tscm *]
- $(gen q.gen, sut (busk p.gen))
- ::
- [%wtcl *]
- =+ nor=$(gen p.gen, gol bool)
- =+ [fex=(gain p.gen) wux=(lose p.gen)]
- ::
- :: if either branch is impossible, eliminate it
- :: (placing the conditional in a dynamic hint to preserve crashes)
- ::
- =+ ^= [ned duy]
- ?- -
- [%void %void] |+[%0 0]
- [%void *] &+[%1 |]
- [* %void] &+[%1 &]
- * |+q.nor
- ==
- =+ hiq=$(sut fex, gen q.gen)
- =+ ran=$(sut wux, gen r.gen)
- =+ fol=(cond duy q.hiq q.ran)
- [(fork p.hiq p.ran ~) ?.(ned fol [%11 [%toss q.nor] fol])]
- ::
- [%wthx *]
- :- (nice bool)
- =+ fid=(fend %read [[%& 1] q.gen])
- (~(fish ar `type`p.fid `skin`p.gen) q.fid)
- ::
- [%fits *]
- :- (nice bool)
- =+ ref=(play p.gen)
- =+ fid=(find %read q.gen)
- ~| [%test q.gen]
- |- ^- nock
- ?- -.fid
- %& ?- -.q.p.fid
- %& (fish(sut ref) (tend p.p.fid))
- %| $(fid [%| (fine fid)])
- ==
- %| [%7 q.p.fid (fish(sut ref) 1)]
- ==
- ::
- [%dbug *]
- ~_ (show %o p.gen)
- =+ hum=$(gen q.gen)
- [p.hum [%11 [%spot %1 p.gen] q.hum]]
- ::
- [%zpcm *] [(nice (play p.gen)) [%1 q.gen]] :: XX validate!
- [%lost *]
- ?: vet
- ~_ (dunk(sut (play p.gen)) 'lost')
- ~>(%mean.'mint-lost' !!)
- [%void [%0 0]]
- ::
- [%zpmc *]
- =+ vos=$(gol %noun, gen q.gen)
- =+ ref=p:$(gol %noun, gen p.gen)
- [(nice (cell ref p.vos)) (cons [%1 burp(sut p.vos)] q.vos)]
- ::
- [%zpgl *]
- =/ typ (nice (play [%kttr p.gen]))
- =/ val
- =< q
- %_ $
- gol %noun
- gen
- :^ %wtcl
- :+ %cncl [%limb %levi]
- :~ [%tsgr [%zpgr [%kttr p.gen]] [%$ 2]]
- [%tsgr q.gen [%$ 2]]
- ==
- [%tsgr q.gen [%$ 3]]
- [%zpzp ~]
- ==
- [typ val]
- ::
- [%zpts *] [(nice %noun) [%1 q:$(vet |, gen p.gen)]]
- [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
- ::
- [%zpzp ~] [%void [%0 0]]
- *
- =+ doz=~(open ap gen)
- ?: =(doz gen)
- ~_ (show [%c 'hoon'] [%q gen])
- ~>(%mean.'mint-open' !!)
- $(gen doz)
- ==
- ::
- ++ nice
- |= typ=type
- ~_ leaf+"mint-nice"
- ?> ?|(!vet (nest(sut gol) & typ))
- typ
- ::
- ++ grow
- |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)]
- ^- [p=type q=nock]
- =+ dan=^$(gen ruf, gol %noun)
- =+ pul=(mine gol mel nym hud dom)
- [(nice p.pul) (cons q.pul q.dan)]
- --
- ::
- ++ moot
- =+ gil=*(set type)
- |- ^- ?
- ?- sut
- [%atom *] |
- [%cell *] |($(sut p.sut) $(sut q.sut))
- [%core *] $(sut p.sut)
- [%face *] $(sut q.sut)
- [%fork *] (levy ~(tap in p.sut) |=(type ^$(sut +<)))
- [%hint *] $(sut q.sut)
- [%hold *] |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo))
- %noun |
- %void &
- ==
- ::
- ++ mull
- ~/ %mull
- |= [gol=type dox=type gen=hoon]
- |^ ^- [p=type q=type]
- ?: =(%void sut)
- ~>(%mean.'mull-none' !!)
- ?- gen
- ::
- [^ *]
- =+ hed=$(gen p.gen, gol %noun)
- =+ tal=$(gen q.gen, gol %noun)
- [(nice (cell p.hed p.tal)) (cell q.hed q.tal)]
- ::
- [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen)
- [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen)
- [%cnts *] (~(mull et p.gen q.gen) gol dox)
- [%dtkt *] =+($(gen q.gen, gol %noun) $(gen [%kttr p.gen]))
- [%dtls *] =+($(gen p.gen, gol [%atom %$ ~]) (beth [%atom %$ ~]))
- [%sand *] (beth (play gen))
- [%rock *] (beth (play gen))
- ::
- [%dttr *]
- =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth %noun))
- ::
- [%dtts *]
- =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth bool))
- ::
- [%dtwt *] =+($(gen p.gen, gol %noun) (beth bool)) :: XX =|
- [%hand *] [p.gen p.gen]
- [%ktbr *]
- =+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) (wrap(sut q.vat) %iron)])
- ::
- [%ktls *]
- =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)]
- =+($(gen q.gen, gol p.hif) hif)
- ::
- [%ktpm *]
- =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)])
- ::
- [%tune *]
- [(face p.gen sut) (face p.gen dox)]
- ::
- [%ktwt *]
- =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) (wrap(sut q.vat) %lead)])
- ::
- [%note *]
- =+ vat=$(gen q.gen)
- [(hint [sut p.gen] p.vat) (hint [dox p.gen] q.vat)]
- ::
- [%ktsg *] $(gen p.gen)
- [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen))
- [%sggr *] $(gen q.gen)
- [%tsgr *]
- =+ lem=$(gen p.gen, gol %noun)
- $(gen q.gen, sut p.lem, dox q.lem)
- ::
- [%tscm *]
- =/ boc (busk p.gen)
- =/ nuf (busk(sut dox) p.gen)
- $(gen q.gen, sut boc, dox nuf)
- ::
- [%wtcl *]
- =+ nor=$(gen p.gen, gol bool)
- =+ ^= hiq ^- [p=type q=type]
- =+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)]
- ?: =(%void p.fex)
- :- %void
- ?: =(%void q.fex)
- %void
- ~>(%mean.'if-z' (play(sut q.fex) q.gen))
- ?: =(%void q.fex)
- ~>(%mean.'mull-bonk-b' !!)
- $(sut p.fex, dox q.fex, gen q.gen)
- =+ ^= ran ^- [p=type q=type]
- =+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)]
- ?: =(%void p.wux)
- :- %void
- ?: =(%void q.wux)
- %void
- ~>(%mean.'if-a' (play(sut q.wux) r.gen))
- ?: =(%void q.wux)
- ~>(%mean.'mull-bonk-c' !!)
- $(sut p.wux, dox q.wux, gen r.gen)
- [(nice (fork p.hiq p.ran ~)) (fork q.hiq q.ran ~)]
- ::
- [%fits *]
- =+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)]
- =+ ^= syx :- p=(cove q:(mint %noun [%wing q.gen]))
- q=(cove q:(mint(sut dox) %noun [%wing q.gen]))
- =+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)]
- ?. &(=(p.syx q.syx) =(p.pov q.pov))
- ~>(%mean.'mull-bonk-a' !!)
- (beth bool)
- ::
- [%wthx *]
- ~> %mean.'mull-bonk-x'
- =+ :- new=[type=p axis=q]:(fend %read [[%& 1] q.gen])
- old=[type=p axis=q]:(fend(sut dox) %read [[%& 1] q.gen])
- ?> =(axis.old axis.new)
- ?> (nest(sut type.old) & type.new)
- (beth bool)
- ::
- [%dbug *] ~_((show %o p.gen) $(gen q.gen))
- [%zpcm *] [(nice (play p.gen)) (play(sut dox) p.gen)]
- [%lost *]
- ?: vet
- :: ~_ (dunk(sut (play p.gen)) 'also')
- ~>(%mean.'mull-skip' !!)
- (beth %void)
- ::
- [%zpts *] (beth %noun)
- ::
- [%zpmc *]
- =+ vos=$(gol %noun, gen q.gen) :: XX validate!
- [(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)]
- ::
- [%zpgl *]
- :: XX is this right?
- (beth (play [%kttr p.gen]))
- ::
- [%zppt *]
- =+ [(feel p.gen) (feel(sut dox) p.gen)]
- ?. =(-< ->)
- ~>(%mean.'mull-bonk-f' !!)
- ?: -<
- $(gen q.gen)
- $(gen r.gen)
- ::
- [%zpzp *] (beth %void)
- *
- =+ doz=~(open ap gen)
- ?: =(doz gen)
- ~_ (show [%c 'hoon'] [%q gen])
- ~>(%mean.'mull-open' !!)
- $(gen doz)
- ==
- ::
- ++ beth
- |= typ=type
- [(nice typ) typ]
- ::
- ++ nice
- |= typ=type
- :: ~_ (dunk(sut gol) 'need')
- :: ~_ (dunk(sut typ) 'have')
- ~_ leaf+"mull-nice"
- ?> ?|(!vet (nest(sut gol) & typ))
- typ
- ::
- ++ grow
- |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)]
- :: make al
- ~_ leaf+"mull-grow"
- ^- [p=type q=type]
- =+ dan=^$(gen ruf, gol %noun)
- =+ yaz=(mile(sut p.dan) q.dan mel nym hud dom)
- [(nice p.yaz) q.yaz]
- --
- ++ meet |=(ref=type &((nest | ref) (nest(sut ref) | sut)))
- :: ::
- ++ miss :: nonintersection
- |= $: :: ref: symmetric type
- ::
- ref=type
- ==
- :: intersection of sut and ref is empty
- ::
- ^- ?
- =| gil=(set (set type))
- =< dext
- |%
- ++ dext
- ^- ?
- ::
- ?: =(ref sut)
- (nest(sut %void) | sut)
- ?- sut
- %void &
- %noun (nest(sut %void) | ref)
- [%atom *] sint
- [%cell *] sint
- [%core *] sint(sut [%cell %noun %noun])
- [%fork *] %+ levy ~(tap in p.sut)
- |=(type dext(sut +<))
- [%face *] dext(sut q.sut)
- [%hint *] dext(sut q.sut)
- [%hold *] =+ (~(gas in *(set type)) `(list type)`[sut ref ~])
- ?: (~(has in gil) -)
- &
- %= dext
- sut repo
- gil (~(put in gil) -)
- == ==
- ++ sint
- ?+ ref dext(sut ref, ref sut)
- [%atom *] ?. ?=([%atom *] sut) &
- ?& ?=(^ q.ref)
- ?=(^ q.sut)
- !=(q.ref q.sut)
- ==
- [%cell *] ?. ?=([%cell *] sut) &
- ?| dext(sut p.sut, ref p.ref)
- dext(sut q.sut, ref q.ref)
- == ==
- --
- ++ mite |=(ref=type |((nest | ref) (nest(sut ref) & sut)))
- ++ nest
- ~/ %nest
- |= [tel=? ref=type]
- =| $: seg=(set type) :: degenerate sut
- reg=(set type) :: degenerate ref
- gil=(set [p=type q=type]) :: assume nest
- ==
- =< dext
- ~% %nest-in ..$ ~
- |%
- ++ deem
- |= [mel=vair ram=vair]
- ^- ?
- ?. |(=(mel ram) =(%lead mel) =(%gold ram)) |
- ?- mel
- %lead &
- %gold meet
- %iron dext(sut (peek(sut ref) %rite 2), ref (peek %rite 2))
- %zinc dext(sut (peek %read 2), ref (peek(sut ref) %read 2))
- ==
- ::
- ++ deep
- |= $: dom=(map term tome)
- vim=(map term tome)
- ==
- ^- ?
- ?: ?=(~ dom) =(vim ~)
- ?: ?=(~ vim) |
- ?& =(p.n.dom p.n.vim)
- $(dom l.dom, vim l.vim)
- $(dom r.dom, vim r.vim)
- ::
- =+ [dab hem]=[q.q.n.dom q.q.n.vim]
- |- ^- ?
- ?: ?=(~ dab) =(hem ~)
- ?: ?=(~ hem) |
- ?& =(p.n.dab p.n.hem)
- $(dab l.dab, hem l.hem)
- $(dab r.dab, hem r.hem)
- %= dext
- sut (play q.n.dab)
- ref (play(sut ref) q.n.hem)
- == == ==
- ::
- ++ dext
- =< $
- ~% %nest-dext + ~
- |.
- ^- ?
- =- ?: - &
- ?. tel |
- ~_ (dunk %need)
- ~_ (dunk(sut ref) %have)
- ~> %mean.'nest-fail'
- !!
- ?: =(sut ref) &
- ?- sut
- %void sint
- %noun &
- [%atom *] ?. ?=([%atom *] ref) sint
- ?& (fitz p.sut p.ref)
- |(?=(~ q.sut) =(q.sut q.ref))
- ==
- [%cell *] ?. ?=([%cell *] ref) sint
- ?& dext(sut p.sut, ref p.ref, seg ~, reg ~)
- dext(sut q.sut, ref q.ref, seg ~, reg ~)
- ==
- [%core *] ?. ?=([%core *] ref) sint
- ?: =(q.sut q.ref) dext(sut p.sut, ref p.ref)
- ?& =(q.p.q.sut q.p.q.ref) :: same wet/dry
- meet(sut q.q.sut, ref p.sut)
- dext(sut q.q.ref, ref p.ref)
- (deem(sut q.q.sut, ref q.q.ref) r.p.q.sut r.p.q.ref)
- ?: =(%wet q.p.q.sut) =(q.r.q.sut q.r.q.ref)
- ?| (~(has in gil) [sut ref])
- %. [q.r.q.sut q.r.q.ref]
- %= deep
- gil (~(put in gil) [sut ref])
- sut sut(p q.q.sut, r.p.q %gold)
- ref ref(p q.q.ref, r.p.q %gold)
- == ==
- ==
- [%face *] dext(sut q.sut)
- [%fork *] ?. ?=(?([%atom *] %noun [%cell *] [%core *]) ref) sint
- (lien ~(tap in p.sut) |=(type dext(tel |, sut +<)))
- [%hint *] dext(sut q.sut)
- [%hold *] ?: (~(has in seg) sut) |
- ?: (~(has in gil) [sut ref]) &
- %= dext
- sut repo
- seg (~(put in seg) sut)
- gil (~(put in gil) [sut ref])
- == ==
- ::
- ++ meet &(dext dext(sut ref, ref sut))
- ++ sint
- ^- ?
- ?- ref
- %noun |
- %void &
- [%atom *] |
- [%cell *] |
- [%core *] dext(ref repo(sut ref))
- [%face *] dext(ref q.ref)
- [%fork *] (levy ~(tap in p.ref) |=(type dext(ref +<)))
- [%hint *] dext(ref q.ref)
- [%hold *] ?: (~(has in reg) ref) &
- ?: (~(has in gil) [sut ref]) &
- %= dext
- ref repo(sut ref)
- reg (~(put in reg) ref)
- gil (~(put in gil) [sut ref])
- == ==
- --
- ::
- ++ peek
- ~/ %peek
- |= [way=?(%read %rite %both %free) axe=axis]
- ^- type
- ?: =(1 axe)
- sut
- =+ [now=(cap axe) lat=(mas axe)]
- =+ gil=*(set type)
- |- ^- type
- ?- sut
- [%atom *] %void
- [%cell *] ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat))
- [%core *]
- ?. =(3 now) %noun
- =+ pec=(peel way r.p.q.sut)
- =/ tow
- ?: =(1 lat) 1
- (cap lat)
- %= ^$
- axe lat
- sut
- ?: ?| =([& &] pec)
- &(sam.pec =(tow 2))
- &(con.pec =(tow 3))
- ==
- p.sut
- ~_ leaf+"payload-block"
- ?. =(way %read) !!
- %+ cell
- ?.(sam.pec %noun ^$(sut p.sut, axe 2))
- ?.(con.pec %noun ^$(sut p.sut, axe 3))
- ==
- ::
- [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
- [%hold *]
- ?: (~(has in gil) sut)
- %void
- $(gil (~(put in gil) sut), sut repo)
- ::
- %void %void
- %noun %noun
- * $(sut repo)
- ==
- ::
- ++ peel
- |= [way=vial met=?(%gold %iron %lead %zinc)]
- ^- [sam=? con=?]
- ?: ?=(%gold met) [& &]
- ?- way
- %both [| |]
- %free [& &]
- %read [?=(%zinc met) |]
- %rite [?=(%iron met) |]
- ==
- ::
- ++ play
- ~/ %play
- => .(vet |)
- |= gen=hoon
- ^- type
- ?- gen
- [^ *] (cell $(gen p.gen) $(gen q.gen))
- [%brcn *] (core sut [p.gen %dry %gold] sut *seminoun q.gen)
- [%brpt *] (core sut [p.gen %wet %gold] sut *seminoun q.gen)
- [%cnts *] ~(play et p.gen q.gen)
- [%dtkt *] $(gen [%kttr p.gen])
- [%dtls *] [%atom %$ ~]
- [%rock *] |- ^- type
- ?@ q.gen [%atom p.gen `q.gen]
- [%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
- [%sand *] ?@ q.gen
- ?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen `q.gen])
- ?: =(%f p.gen) ?>((lte q.gen 1) bool)
- [%atom p.gen ~]
- $(-.gen %rock)
- [%tune *] (face p.gen sut)
- [%dttr *] %noun
- [%dtts *] bool
- [%dtwt *] bool
- [%hand *] p.gen
- [%ktbr *] (wrap(sut $(gen p.gen)) %iron)
- [%ktls *] $(gen p.gen)
- [%ktpm *] (wrap(sut $(gen p.gen)) %zinc)
- [%ktsg *] $(gen p.gen)
- [%ktwt *] (wrap(sut $(gen p.gen)) %lead)
- [%note *] (hint [sut p.gen] $(gen q.gen))
- [%sgzp *] ~_(duck(sut ^$(gen p.gen)) $(gen q.gen))
- [%sggr *] $(gen q.gen)
- [%tsgr *] $(gen q.gen, sut $(gen p.gen))
- [%tscm *] $(gen q.gen, sut (busk p.gen))
- [%wtcl *] =+ [fex=(gain p.gen) wux=(lose p.gen)]
- %- fork :~
- ?:(=(%void fex) %void $(sut fex, gen q.gen))
- ?:(=(%void wux) %void $(sut wux, gen r.gen))
- ==
- [%fits *] bool
- [%wthx *] bool
- [%dbug *] ~_((show %o p.gen) $(gen q.gen))
- [%zpcm *] $(gen p.gen)
- [%lost *] %void
- [%zpmc *] (cell $(gen p.gen) $(gen q.gen))
- [%zpgl *] (play [%kttr p.gen])
- [%zpts *] %noun
- [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
- [%zpzp *] %void
- * =+ doz=~(open ap gen)
- ?: =(doz gen)
- ~_ (show [%c 'hoon'] [%q gen])
- ~> %mean.'play-open'
- !!
- $(gen doz)
- ==
- :: ::
- ++ redo :: refurbish faces
- ~/ %redo
- |= $: :: ref: raw payload
- ::
- ref=type
- ==
- :: :type: subject refurbished to reference namespace
- ::
- ^- type
- :: hos: subject tool stack
- :: wec: reference tool stack set
- :: gil: repetition set
- ::
- =| hos=(list tool)
- =/ wec=(set (list tool)) [~ ~ ~]
- =| gil=(set (pair type type))
- =< :: errors imply subject/reference mismatch
- ::
- ~| %redo-match
- :: reduce by subject
- ::
- dext
- |%
- :: ::
- ++ dear :: resolve tool stack
- :: :(unit (list tool)): unified tool stack
- ::
- ^- (unit (list tool))
- :: empty implies void
- ::
- ?~ wec `~
- :: any reference faces must be clear
- ::
- ?. ?=([* ~ ~] wec)
- ~& [%dear-many wec]
- ~
- :- ~
- :: har: single reference tool stack
- ::
- =/ har n.wec
- :: len: lengths of [sut ref] face stacks
- ::
- =/ len [p q]=[(lent hos) (lent har)]
- :: lip: length of sut-ref face stack overlap
- ::
- :: AB
- :: BC
- ::
- :: +lip is (lent B), where +hay is forward AB
- :: and +liv is forward BC (stack BA and CB).
- ::
- :: overlap is a weird corner case. +lip is
- :: almost always 0. brute force is fine.
- ::
- =/ lip
- =| lup=(unit @ud)
- =| lip=@ud
- |- ^- @ud
- ?: |((gth lip p.len) (gth lip q.len))
- (fall lup 0)
- :: lep: overlap candidate: suffix of subject face stack
- ::
- =/ lep (slag (sub p.len lip) hos)
- :: lap: overlap candidate: prefix of reference face stack
- ::
- =/ lap (scag lip har)
- :: save any match and continue
- ::
- $(lip +(lip), lup ?.(=(lep lap) lup `lip))
- :: ~& [har+har hos+hos len+len lip+lip]
- :: produce combined face stack (forward ABC, stack CBA)
- ::
- (weld hos (slag lip har))
- :: ::
- ++ dext :: subject traverse
- :: :type: refurbished subject
- ::
- ^- type
- :: check for trivial cases
- ::
- ?: ?| =(sut ref)
- ?=(?(%noun %void [?(%atom %core) *]) ref)
- ==
- done
- :: ~_ (dunk 'redo: dext: sut')
- :: ~_ (dunk(sut ref) 'redo: dext: ref')
- ?- sut
- ?(%noun %void [?(%atom %core) *])
- :: reduce reference and reassemble leaf
- ::
- done:(sint &)
- ::
- [%cell *]
- :: reduce reference to match subject
- ::
- => (sint &)
- ?> ?=([%cell *] sut)
- :: leaf with possible recursive descent
- ::
- %= done
- sut
- :: clear face stacks for descent
- ::
- =: hos ~
- wec [~ ~ ~]
- ==
- :: descend into cell
- ::
- :+ %cell
- dext(sut p.sut, ref (peek(sut ref) %free 2))
- dext(sut q.sut, ref (peek(sut ref) %free 3))
- ==
- ::
- [%face *]
- :: push face on subject stack, and descend
- ::
- dext(hos [p.sut hos], sut q.sut)
- ::
- [%hint *]
- :: work through hint
- ::
- (hint p.sut dext(sut q.sut))
- ::
- [%fork *]
- :: reconstruct each case in fork
- ::
- (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
- ::
- [%hold *]
- :: reduce to hard
- ::
- => (sint |)
- ?> ?=([%hold *] sut)
- ?: (~(has in fan) [p.sut q.sut])
- :: repo loop; redo depends on its own product
- ::
- done:(sint &)
- ?: (~(has in gil) [sut ref])
- :: type recursion, stop renaming
- ::
- done:(sint |)
- :: restore unchanged holds
- ::
- =+ repo
- =- ?:(=(- +<) sut -)
- dext(sut -, gil (~(put in gil) sut ref))
- ==
- :: ::
- ++ done :: complete assembly
- ^- type
- :: :type: subject refurbished
- ::
- :: lov: combined face stack
- ::
- =/ lov
- =/ lov dear
- ?~ lov
- :: ~_ (dunk 'redo: dear: sut')
- :: ~_ (dunk(sut ref) 'redo: dear: ref')
- ~& [%wec wec]
- !!
- (need lov)
- :: recompose faces
- ::
- |- ^- type
- ?~ lov sut
- $(lov t.lov, sut (face i.lov sut))
- ::
- ++ sint :: reduce by reference
- |= $: :: hod: expand holds
- ::
- hod=?
- ==
- :: ::.: reference with face/fork/hold reduced
- ::
- ^+ .
- :: =- ~> %slog.[0 (dunk 'sint: sut')]
- :: ~> %slog.[0 (dunk(sut ref) 'sint: ref')]
- :: ~> %slog.[0 (dunk(sut =>(- ref)) 'sint: pro')]
- :: -
- ?+ ref .
- [%hint *] $(ref q.ref)
- [%face *]
- :: extend all stacks in set
- ::
- %= $
- ref q.ref
- wec (~(run in wec) |=((list tool) [p.ref +<]))
- ==
- ::
- [%fork *]
- :: reconstruct all relevant cases
- ::
- =- :: ~> %slog.[0 (dunk 'fork: sut')]
- :: ~> %slog.[0 (dunk(sut ref) 'fork: ref')]
- :: ~> %slog.[0 (dunk(sut (fork ->)) 'fork: pro')]
- +(wec -<, ref (fork ->))
- =/ moy ~(tap in p.ref)
- |- ^- (pair (set (list tool)) (list type))
- ?~ moy [~ ~]
- :: head recurse
- ::
- =/ mor $(moy t.moy)
- :: prune reference cases outside subject
- ::
- ?: (miss i.moy) mor
- :: unify all cases
- ::
- =/ dis ^$(ref i.moy)
- [(~(uni in p.mor) wec.dis) [ref.dis q.mor]]
- ::
- [%hold *]
- ?. hod .
- $(ref repo(sut ref))
- ==
- --
- ::
- ++ repo
- ^- type
- ?- sut
- [%core *] [%cell %noun p.sut]
- [%face *] q.sut
- [%hint *] q.sut
- [%hold *] (rest [[p.sut q.sut] ~])
- %noun (fork [%atom %$ ~] [%cell %noun %noun] ~)
- * ~>(%mean.'repo-fltt' !!)
- ==
- ::
- ++ rest
- ~/ %rest
- |= leg=(list [p=type q=hoon])
- ^- type
- ?: (lien leg |=([p=type q=hoon] (~(has in fan) [p q])))
- ~>(%mean.'rest-loop' !!)
- => .(fan (~(gas in fan) leg))
- %- fork
- %~ tap in
- %- ~(gas in *(set type))
- (turn leg |=([p=type q=hoon] (play(sut p) q)))
- ::
- ++ sink
- ~/ %sink
- |^ ^- cord
- ?- sut
- %void 'void'
- %noun 'noun'
- [%atom *] (rap 3 'atom ' p.sut ' ' ?~(q.sut '~' u.q.sut) ~)
- [%cell *] (rap 3 'cell ' (mup p.sut) ' ' (mup q.sut) ~)
- [%face *] (rap 3 'face ' ?@(p.sut p.sut (mup p.sut)) ' ' (mup q.sut) ~)
- [%fork *] (rap 3 'fork ' (mup p.sut) ~)
- [%hint *] (rap 3 'hint ' (mup p.sut) ' ' (mup q.sut) ~)
- [%hold *] (rap 3 'hold ' (mup p.sut) ' ' (mup q.sut) ~)
- ::
- [%core *]
- %+ rap 3
- :~ 'core '
- (mup p.sut)
- ' '
- ?~(p.p.q.sut '~' u.p.p.q.sut)
- ' '
- q.p.q.sut
- ' '
- r.p.q.sut
- ' '
- (mup q.q.sut)
- ' '
- (mup p.r.q.sut)
- ==
- ==
- ::
- ++ mup |=(* (scot %p (mug +<)))
- --
- ::
- ++ take
- |= [vit=vein duz=$-(type type)]
- ^- (pair axis type)
- :- (tend vit)
- =. vit (flop vit)
- |- ^- type
- ?~ vit (duz sut)
- ?~ i.vit
- |- ^- type
- ?+ sut ^$(vit t.vit)
- [%face *] (face p.sut ^$(vit t.vit, sut q.sut))
- [%hint *] (hint p.sut ^$(sut q.sut))
- [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
- [%hold *] $(sut repo)
- ==
- =+ vil=*(set type)
- |- ^- type
- ?: =(1 u.i.vit)
- ^$(vit t.vit)
- =+ [now lat]=(cap u.i.vit)^(mas u.i.vit)
- ?- sut
- %noun $(sut [%cell %noun %noun])
- %void %void
- [%atom *] %void
- [%cell *] ?: =(2 now)
- (cell $(sut p.sut, u.i.vit lat) q.sut)
- (cell p.sut $(sut q.sut, u.i.vit lat))
- [%core *] ?: =(2 now)
- $(sut repo)
- (core $(sut p.sut, u.i.vit lat) q.sut)
- [%face *] (face p.sut $(sut q.sut))
- [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
- [%hint *] (hint p.sut $(sut q.sut))
- [%hold *] ?: (~(has in vil) sut)
- %void
- $(sut repo, vil (~(put in vil) sut))
- ==
- ::
- ++ tack
- |= [hyp=wing mur=type]
- ~_ (show [%c %tack] %l hyp)
- =+ fid=(find %rite hyp)
- ?> ?=(%& -.fid)
- (take p.p.fid |=(type mur))
- ::
- ++ tend
- |= vit=vein
- ^- axis
- ?~(vit 1 (peg $(vit t.vit) ?~(i.vit 1 u.i.vit)))
- ::
- ++ toss
- ~/ %toss
- |= [hyp=wing mur=type men=(list [p=type q=foot])]
- ^- [p=axis q=(list [p=type q=foot])]
- =- [(need p.wib) q.wib]
- ^= wib
- |- ^- [p=(unit axis) q=(list [p=type q=foot])]
- ?~ men
- [*(unit axis) ~]
- =+ geq=(tack(sut p.i.men) hyp mur)
- =+ mox=$(men t.men)
- [(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]]
- ::
- ++ wrap
- ~/ %wrap
- |= yoz=?(%lead %iron %zinc)
- ~_ leaf+"wrap"
- ^- type
- ?+ sut sut
- [%cell *] (cell $(sut p.sut) $(sut q.sut))
- [%core *] ?>(|(=(%gold r.p.q.sut) =(%lead yoz)) sut(r.p.q yoz))
- [%face *] (face p.sut $(sut q.sut))
- [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
- [%hint *] (hint p.sut $(sut q.sut))
- [%hold *] $(sut repo)
- ==
- --
- ++ us :: prettyprinter
- => |%
- +$ cape [p=(map @ud wine) q=wine] ::
- +$ wine ::
- $@ $? %noun ::
- %path ::
- %type ::
- %void ::
- %wall ::
- %wool ::
- %yarn ::
- == ::
- $% [%mato p=term] ::
- [%core p=(list @ta) q=wine] ::
- [%face p=term q=wine] ::
- [%list p=term q=wine] ::
- [%pear p=term q=@] ::
- [%bcwt p=(list wine)] ::
- [%plot p=(list wine)] ::
- [%stop p=@ud] ::
- [%tree p=term q=wine] ::
- [%unit p=term q=wine] ::
- [%name p=stud q=wine] ::
- == ::
- --
- |_ sut=type
- ++ dash
- |= [mil=tape lim=char lam=tape]
- ^- tape
- =/ esc (~(gas in *(set @tD)) lam)
- :- lim
- |- ^- tape
- ?~ mil [lim ~]
- ?: ?| =(lim i.mil)
- =('\\' i.mil)
- (~(has in esc) i.mil)
- ==
- ['\\' i.mil $(mil t.mil)]
- ?: (lte ' ' i.mil)
- [i.mil $(mil t.mil)]
- ['\\' ~(x ne (rsh 2 i.mil)) ~(x ne (end 2 i.mil)) $(mil t.mil)]
- ::
- ++ deal |=(lum=* (dish dole lum))
- ++ dial
- |= ham=cape
- =+ gid=*(set @ud)
- =< `tank`-:$
- |%
- ++ many
- |= haz=(list wine)
- ^- [(list tank) (set @ud)]
- ?~ haz [~ gid]
- =^ mor gid $(haz t.haz)
- =^ dis gid ^$(q.ham i.haz)
- [[dis mor] gid]
- ::
- ++ $
- ^- [tank (set @ud)]
- ?- q.ham
- %noun :_(gid [%leaf '*' ~])
- %path :_(gid [%leaf '/' ~])
- %type :_(gid [%leaf '#' 't' ~])
- %void :_(gid [%leaf '#' '!' ~])
- %wool :_(gid [%leaf '*' '"' '"' ~])
- %wall :_(gid [%leaf '*' '\'' '\'' ~])
- %yarn :_(gid [%leaf '"' '"' ~])
- [%mato *] :_(gid [%leaf '@' (trip p.q.ham)])
- [%core *]
- =^ cox gid $(q.ham q.q.ham)
- :_ gid
- :+ %rose
- [[' ' ~] ['<' ~] ['>' ~]]
- |- ^- (list tank)
- ?~ p.q.ham [cox ~]
- [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
- ::
- [%face *]
- =^ cox gid $(q.ham q.q.ham)
- :_(gid [%palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
- ::
- [%list *]
- =^ cox gid $(q.ham q.q.ham)
- :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
- ::
- [%bcwt *]
- =^ coz gid (many p.q.ham)
- :_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
- ::
- [%plot *]
- =^ coz gid (many p.q.ham)
- :_(gid [%rose [[' ' ~] ['[' ~] [']' ~]] coz])
- ::
- [%pear *]
- :_(gid [%leaf '%' ~(rend co [%$ p.q.ham q.q.ham])])
- ::
- [%stop *]
- =+ num=~(rend co [%$ %ud p.q.ham])
- ?: (~(has in gid) p.q.ham)
- :_(gid [%leaf '#' num])
- =^ cox gid
- %= $
- gid (~(put in gid) p.q.ham)
- q.ham (~(got by p.ham) p.q.ham)
- ==
- :_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
- ::
- [%tree *]
- =^ cox gid $(q.ham q.q.ham)
- :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
- ::
- [%unit *]
- =^ cox gid $(q.ham q.q.ham)
- :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
- ::
- [%name *]
- :_ gid
- ?@ p.q.ham (cat 3 '#' mark.p.q.ham)
- (rap 3 '#' auth.p.q.ham '+' (spat type.p.q.ham) ~)
- ==
- --
- ::
- ++ dish !:
- |= [ham=cape lum=*] ^- tank
- ~| [%dish-h ?@(q.ham q.ham -.q.ham)]
- ~| [%lump lum]
- ~| [%ham ham]
- %- need
- =| gil=(set [@ud *])
- |- ^- (unit tank)
- ?- q.ham
- %noun
- %= $
- q.ham
- ?: ?=(@ lum)
- [%mato %$]
- :- %plot
- |- ^- (list wine)
- [%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
- ==
- ::
- %path
- :- ~
- :+ %rose
- [['/' ~] ['/' ~] ~]
- |- ^- (list tank)
- ?~ lum ~
- ?@ lum !!
- ?> ?=(@ -.lum)
- [[%leaf (rip 3 -.lum)] $(lum +.lum)]
- ::
- %type
- =+ tyr=|.((dial dole))
- =+ vol=tyr(sut lum)
- =+ cis=;;(tank .*(vol [%9 2 %0 1]))
- :^ ~ %palm
- [~ ~ ~ ~]
- [[%leaf '#' 't' '/' ~] cis ~]
- ::
- %wall
- :- ~
- :+ %rose
- [[' ' ~] ['<' '|' ~] ['|' '>' ~]]
- |- ^- (list tank)
- ?~ lum ~
- ?@ lum !!
- [[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
- ::
- %wool
- :- ~
- :+ %rose
- [[' ' ~] ['<' '<' ~] ['>' '>' ~]]
- |- ^- (list tank)
- ?~ lum ~
- ?@ lum !!
- [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
- ::
- %yarn
- [~ %leaf (dash (tape lum) '"' "\{")]
- ::
- %void
- ~
- ::
- [%mato *]
- ?. ?=(@ lum)
- ~
- :+ ~
- %leaf
- ?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
- ~(rend co [%$ p.q.ham lum])
- %$ ~(rend co [%$ %ud lum])
- %t (dash (rip 3 lum) '\'' ~)
- %tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
- ==
- ::
- [%core *]
- :: XX needs rethinking for core metal
- :: ?. ?=(^ lum) ~
- :: => .(lum `*`lum)
- :: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
- :: ^= tok
- :: |- ^- (unit (list tank))
- :: ?~ p.q.ham
- :: =+ den=^$(q.ham q.q.ham)
- :: ?~(den ~ [~ u.den ~])
- :: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
- :: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
- [~ (dial ham)]
- ::
- [%face *]
- =+ wal=$(q.ham q.q.ham)
- ?~ wal
- ~
- [~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
- ::
- [%list *]
- ?: =(~ lum)
- [~ %leaf '~' ~]
- =- ?~ tok
- ~
- [~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
- ^= tok
- |- ^- (unit (list tank))
- ?: ?=(@ lum)
- ?.(=(~ lum) ~ [~ ~])
- =+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
- ?. &(?=(^ for) ?=(^ aft))
- ~
- [~ u.for u.aft]
- ::
- [%bcwt *]
- |- ^- (unit tank)
- ?~ p.q.ham
- ~
- =+ wal=^$(q.ham i.p.q.ham)
- ?~ wal
- $(p.q.ham t.p.q.ham)
- wal
- ::
- [%plot *]
- =- ?~ tok
- ~
- [~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
- ^= tok
- |- ^- (unit (list tank))
- ?~ p.q.ham
- ~
- ?: ?=([* ~] p.q.ham)
- =+ wal=^$(q.ham i.p.q.ham)
- ?~(wal ~ [~ [u.wal ~]])
- ?@ lum
- ~
- =+ gim=^$(q.ham i.p.q.ham, lum -.lum)
- ?~ gim
- ~
- =+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
- ?~ myd
- ~
- [~ u.gim u.myd]
- ::
- [%pear *]
- ?. =(lum q.q.ham)
- ~
- =. p.q.ham
- (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
- =+ fox=$(q.ham [%mato p.q.ham])
- ?> ?=([~ %leaf ^] fox)
- ?: ?=(?(%n %tas) p.q.ham)
- fox
- [~ %leaf '%' p.u.fox]
- ::
- [%stop *]
- ?: (~(has in gil) [p.q.ham lum]) ~
- =+ kep=(~(get by p.ham) p.q.ham)
- ?~ kep
- ~|([%stop-loss p.q.ham] !!)
- $(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
- ::
- [%tree *]
- =- ?~ tok
- ~
- [~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
- ^= tok
- =+ tuk=*(list tank)
- |- ^- (unit (list tank))
- ?: =(~ lum)
- [~ tuk]
- ?. ?=([n=* l=* r=*] lum)
- ~
- =+ rol=$(lum r.lum)
- ?~ rol
- ~
- =+ tim=^$(q.ham q.q.ham, lum n.lum)
- ?~ tim
- ~
- $(lum l.lum, tuk [u.tim u.rol])
- ::
- [%unit *]
- ?@ lum
- ?.(=(~ lum) ~ [~ %leaf '~' ~])
- ?. =(~ -.lum)
- ~
- =+ wal=$(q.ham q.q.ham, lum +.lum)
- ?~ wal
- ~
- [~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
- ::
- [%name *]
- $(q.ham q.q.ham)
- ==
- ::
- ++ doge
- |= ham=cape
- =- ?+ woz woz
- [%list * [%mato %'ta']] %path
- [%list * [%mato %'t']] %wall
- [%list * [%mato %'tD']] %yarn
- [%list * %yarn] %wool
- ==
- ^= woz
- ^- wine
- ?. ?=([%stop *] q.ham)
- ?: ?& ?= [%bcwt [%pear %n %0] [%plot [%pear %n %0] [%face *] ~] ~]
- q.ham
- =(1 (met 3 p.i.t.p.i.t.p.q.ham))
- ==
- [%unit =<([p q] i.t.p.i.t.p.q.ham)]
- q.ham
- =+ may=(~(get by p.ham) p.q.ham)
- ?~ may
- q.ham
- =+ nul=[%pear %n 0]
- ?. ?& ?=([%bcwt *] u.may)
- ?=([* * ~] p.u.may)
- |(=(nul i.p.u.may) =(nul i.t.p.u.may))
- ==
- q.ham
- =+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
- ?: ?& ?=([%plot [%face *] [%face * %stop *] ~] din)
- =(p.q.ham p.q.i.t.p.din)
- =(1 (met 3 p.i.p.din))
- =(1 (met 3 p.i.t.p.din))
- ==
- :+ %list
- (cat 3 p.i.p.din p.i.t.p.din)
- q.i.p.din
- ?: ?& ?= $: %plot
- [%face *]
- [%face * %stop *]
- [[%face * %stop *] ~]
- ==
- din
- =(p.q.ham p.q.i.t.p.din)
- =(p.q.ham p.q.i.t.t.p.din)
- =(1 (met 3 p.i.p.din))
- =(1 (met 3 p.i.t.p.din))
- =(1 (met 3 p.i.t.t.p.din))
- ==
- :+ %tree
- %^ cat
- 3
- p.i.p.din
- (cat 3 p.i.t.p.din p.i.t.t.p.din)
- q.i.p.din
- q.ham
- ::
- ++ dole
- ^- cape
- =+ gil=*(set type)
- =+ dex=[p=*(map type @) q=*(map @ wine)]
- =< [q.p q]
- |- ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
- =- [p.tez (doge q.p.tez q.tez)]
- ^= tez
- ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
- ?: (~(meet ut sut) -:!>(*type))
- [dex %type]
- ?- sut
- %noun [dex sut]
- %void [dex sut]
- [%atom *] [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
- [%cell *]
- =+ hin=$(sut p.sut)
- =+ yon=$(dex p.hin, sut q.sut)
- :- p.yon
- :- %plot
- ?:(?=([%plot *] q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
- ::
- [%core *]
- =+ yad=$(sut p.sut)
- :- p.yad
- =+ ^= doy ^- [p=(list @ta) q=wine]
- ?: ?=([%core *] q.yad)
- [p.q.yad q.q.yad]
- [~ q.yad]
- :- %core
- :_ q.doy
- :_ p.doy
- %^ cat 3
- %~ rent co
- :+ %$ %ud
- %- ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
- |=([[@ a=@u] b=@u] (add a b))
- %^ cat 3
- ?-(r.p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&')
- =+ gum=(mug q.r.q.sut)
- %+ can 3
- :~ [1 (add 'a' (mod gum 26))]
- [1 (add 'a' (mod (div gum 26) 26))]
- [1 (add 'a' (mod (div gum 676) 26))]
- ==
- ::
- [%hint *]
- =+ yad=$(sut q.sut)
- ?. ?=(%know -.q.p.sut) yad
- [p.yad [%name p.q.p.sut q.yad]]
- ::
- [%face *]
- =+ yad=$(sut q.sut)
- ?^(p.sut yad [p.yad [%face p.sut q.yad]])
- ::
- [%fork *]
- =+ yed=(sort ~(tap in p.sut) aor)
- =- [p [%bcwt q]]
- |- ^- [p=[p=(map type @) q=(map @ wine)] q=(list wine)]
- ?~ yed
- [dex ~]
- =+ mor=$(yed t.yed)
- =+ dis=^$(dex p.mor, sut i.yed)
- [p.dis q.dis q.mor]
- ::
- [%hold *]
- =+ hey=(~(get by p.dex) sut)
- ?^ hey
- [dex [%stop u.hey]]
- ?: (~(has in gil) sut)
- =+ dyr=+(~(wyt by p.dex))
- [[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
- =+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
- =+ rey=(~(get by p.p.rom) sut)
- ?~ rey
- rom
- [[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
- ==
- ::
- ++ duck (dial dole)
- --
- ++ cain sell :: $-(vase tank)
- ++ noah text :: $-(vase tape)
- ++ onan seer :: $-(vise vase)
- ++ levi :: $-([type type] ?)
- |= [a=type b=type]
- (~(nest ut a) & b)
- ::
- ++ text :: tape pretty-print
- |= vax=vase ^- tape
- ~(ram re (sell vax))
- ::
- ++ seem |=(toy=typo `type`toy) :: promote typo
- ++ seer |=(vix=vise `vase`vix) :: promote vise
- ::
- :: +sell: pretty-print a vase to a tank using +deal.
- ::
- ++ sell
- ~/ %sell
- |= vax=vase
- ^- tank
- ~| %sell
- (~(deal us p.vax) q.vax)
- ::
- :: +skol: $-(type tank) using duck.
- ::
- ++ skol
- |= typ=type
- ^- tank
- ~(duck ut typ)
- ::
- ++ slam :: slam a gate
- |= [gat=vase sam=vase] ^- vase
- =+ :- ^= typ ^- type
- [%cell p.gat p.sam]
- ^= gen ^- hoon
- [%cnsg [%$ ~] [%$ 2] [%$ 3] ~]
- =+ gun=(~(mint ut typ) %noun gen)
- [p.gun (slum q.gat q.sam)]
- ::
- :: +slab: states whether you can access an arm in a type.
- ::
- :: .way: the access type ($vial): read, write, or read-and-write.
- :: The fourth case of $vial, %free, is not permitted because it would
- :: allow you to discover "private" information about a type,
- :: information which you could not make use of in (law-abiding) hoon anyway.
- ::
- ++ slab :: test if contains
- |= [way=?(%read %rite %both) cog=@tas typ=type]
- ?= [%& *]
- (~(fond ut typ) way ~[cog])
- ::
- ++ slap
- |= [vax=vase gen=hoon] ^- vase :: untyped vase .*
- =+ gun=(~(mint ut p.vax) %noun gen)
- [p.gun .*(q.vax q.gun)]
- ::
- ++ slog :: deify printf
- =| pri=@ :: priority level
- |= a=tang ^+ same :: .= ~&(%a 1)
- ?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1)
- :: ::
- ++ mean :: crash with trace
- |= a=tang
- ^+ !!
- ?~ a !!
- ~_(i.a $(a t.a))
- ::
- ++ road
- |* =(trap *)
- ^+ $:trap
- =/ res (mule trap)
- ?- -.res
- %& p.res
- %| (mean p.res)
- ==
- ::
- ++ slew :: get axis in vase
- |= [axe=@ vax=vase]
- =/ typ |. (~(peek ut p.vax) %free axe)
- |- ^- (unit vase)
- ?: =(1 axe) `[$:typ q.vax]
- ?@ q.vax ~
- $(axe (mas axe), q.vax ?-((cap axe) %2 -.q.vax, %3 +.q.vax))
- ::
- ++ slim :: identical to seer?
- |= old=vise ^- vase
- old
- ::
- ++ slit :: type of slam
- |= [gat=type sam=type]
- ?> (~(nest ut (~(peek ut gat) %free 6)) & sam)
- (~(play ut [%cell gat sam]) [%cnsg [%$ ~] [%$ 2] [%$ 3] ~])
- ::
- ++ slob :: superficial arm
- |= [cog=@tas typ=type]
- ^- ?
- ?+ typ |
- [%hold *] $(typ ~(repo ut typ))
- [%hint *] $(typ ~(repo ut typ))
- [%core *]
- |- ^- ?
- ?~ q.r.q.typ |
- ?| (~(has by q.q.n.q.r.q.typ) cog)
- $(q.r.q.typ l.q.r.q.typ)
- $(q.r.q.typ r.q.r.q.typ)
- ==
- ==
- ::
- ++ sloe :: get arms in core
- |= typ=type
- ^- (list term)
- ?+ typ ~
- [%hold *] $(typ ~(repo ut typ))
- [%hint *] $(typ ~(repo ut typ))
- [%core *]
- %- zing
- %+ turn ~(tap by q.r.q.typ)
- |= [* b=tome]
- %+ turn ~(tap by q.b)
- |= [a=term *]
- a
- ==
- ::
- ++ slop :: cons two vases
- |= [hed=vase tal=vase]
- ^- vase
- [[%cell p.hed p.tal] [q.hed q.tal]]
- ::
- ++ slot :: got axis in vase
- |= [axe=@ vax=vase] ^- vase
- [(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])]
- ::
- ++ slym :: slam w+o sample-type
- |= [gat=vase sam=*] ^- vase
- (slap gat(+<.q sam) [%limb %$])
- ::
- ++ sped :: reconstruct type
- |= vax=vase
- ^- vase
- :_ q.vax
- ?@ q.vax (~(fuse ut p.vax) [%atom %$ ~])
- ?@ -.q.vax
- ^= typ
- %- ~(play ut p.vax)
- [%wtgr [%wtts [%leaf %tas -.q.vax] [%& 2]~] [%$ 1]]
- (~(fuse ut p.vax) [%cell %noun %noun])
- :: +swat: deferred +slap
- ::
- ++ swat
- |= [tap=(trap vase) gen=hoon]
- ^- (trap vase)
- =/ gun (~(mint ut p:$:tap) %noun gen)
- |. ~+
- [p.gun .*(q:$:tap q.gun)]
- ::
- :: 5d: parser
- +| %parser
- ::
- :: +vang: set +vast params
- ::
- :: bug: debug mode
- :: doc: doccord parsing
- :: wer: where we are
- ::
- ++ vang
- |= [f=$@(? [bug=? doc=?]) wer=path]
- %*(. vast bug ?@(f f bug.f), doc ?@(f & doc.f), wer wer)
- ::
- ++ vast :: main parsing core
- =+ [bug=`?`| wer=*path doc=`?`&]
- |%
- ++ gash %+ cook :: parse path
- |= a=(list tyke) ^- tyke
- ?~(a ~ (weld i.a $(a t.a)))
- (more fas limp)
- ++ gasp ;~ pose :: parse =path= etc.
- %+ cook
- |=([a=tyke b=tyke c=tyke] :(weld a b c))
- ;~ plug
- (cook |=(a=(list) (turn a |=(b=* ~))) (star tis))
- (cook |=(a=hoon [[~ a] ~]) hasp)
- (cook |=(a=(list) (turn a |=(b=* ~))) (star tis))
- ==
- (cook |=(a=(list) (turn a |=(b=* ~))) (plus tis))
- ==
- ++ glam ~+((glue ace))
- ++ hasp ;~ pose :: path element
- (ifix [sel ser] wide)
- (stag %cncl (ifix [pal par] (most ace wide)))
- (stag %sand (stag %tas (cold %$ buc)))
- (stag %sand (stag %t qut))
- %+ cook
- |=(a=coin [%sand ?:(?=([~ %tas *] a) %tas %ta) ~(rent co a)])
- nuck:so
- ==
- ++ limp %+ cook
- |= [a=(list) b=tyke]
- ?~ a b
- $(a t.a, b [`[%sand %tas %$] b])
- ;~(plug (star fas) gasp)
- ++ mota %+ cook
- |=([a=tape b=tape] (rap 3 (weld a b)))
- ;~(plug (star low) (star hig))
- ++ docs
- |%
- :: +apex: prefix comment. may contain batch comments.
- ::
- :: when a prefix doccord is parsed, it is possible that there is no +gap
- :: afterward to be consumed, so we add an additional newline and
- :: decrement the line number in the `hair` of the parser
- ::
- :: the reason for this is that the whitespace parsing under +vast seems
- :: to factor more cleanly this way, at least compared to the variations
- :: tried without the extra newline. this doesn't mean there isn't a
- :: better factorization without it, though.
- ++ apex
- ?. doc (easy *whit)
- %+ knee *whit |. ~+
- ;~ plug
- |= tub=nail
- =/ vex
- %. tub
- %- star
- %+ cook |*([[a=* b=*] c=*] [a b c])
- ;~(pfix (punt leap) into ;~(pose larg smol))
- ?~ q.vex vex
- :- p=p.vex
- %- some
- ?~ p.u.q.vex
- [p=~ q=q.u.q.vex]
- :- p=(malt p.u.q.vex)
- q=`nail`[[(dec p.p.q.u.q.vex) q.p.q.u.q.vex] ['\0a' q.q.u.q.vex]]
- ==
- ::
- :: +apse: postfix comment.
- ::
- :: a one line comment at the end of a line (typically starting at column
- :: 57) that attaches to the expression starting at the beginning of the
- :: current line. does not use a $link.
- ++ apse
- ?. doc (easy *whiz)
- %+ knee *whiz |. ~+
- ;~ pose
- ;~(less ;~(plug into step en-link col ace) ;~(pfix into step line))
- ::
- (easy *whiz)
- ==
- ::
- ++ leap :: whitespace w/o docs
- %+ cold ~
- ;~ plug
- ;~ pose
- (just '\0a')
- ;~(plug gah ;~(pose gah skip))
- skip
- ==
- (star ;~(pose skip gah))
- ==
- ::
- :: +smol: 2 aces then summary, 4 aces then paragraphs.
- ++ smol
- ;~ pfix
- step
- ;~ plug
- ;~ plug
- (plus en-link)
- ;~ pose
- (ifix [;~(plug col ace) (just '\0a')] (cook crip (plus prn)))
- (ifix [(star ace) (just '\0a')] (easy *cord))
- ==
- ==
- (rant ;~(pfix step step text))
- ==
- ==
- ::
- :: +larg: 4 aces then summary, 2 aces then paragraphs.
- ++ larg
- ;~ pfix
- step step
- ;~ plug
- ;~ sfix
- ;~ plug
- ;~ pose
- ;~(sfix (plus en-link) col ace)
- ;~(less ace (easy *cuff))
- ==
- ;~(less ace (cook crip (plus prn)))
- ==
- (just '\0a')
- ==
- (rant ;~(pfix step teyt))
- ==
- ==
- ::
- ++ rant
- |* sec=rule
- %- star
- ;~ pfix
- (ifix [into (just '\0a')] (star ace))
- (plus (ifix [into (just '\0a')] sec))
- ==
- ::
- ++ skip :: non-doccord comment
- ;~ plug
- col col
- ;~(less ;~(pose larg smol) ;~(plug (star prn) (just '\0a')))
- ==
- ::
- ++ null (cold ~ (star ace))
- ++ text (pick line code)
- ++ teyt (pick line ;~(pfix step code))
- ++ line ;~(less ace (cook crip (star prn)))
- ++ code ;~(pfix step ;~(less ace (cook crip (star prn))))
- ++ step ;~(plug ace ace)
- ::
- ++ into
- ;~(plug (star ace) col col)
- ::
- ++ en-link
- |= a=nail %. a
- %+ knee *link |. ~+
- %- stew
- ^. stet ^. limo
- :~ :- '|' ;~(pfix bar (stag %chat sym))
- :- '.' ;~(pfix dot (stag %frag sym))
- :- '+' ;~(pfix lus (stag %funk sym))
- :- '$' ;~(pfix buc (stag %plan sym))
- :- '%' ;~(pfix cen (stag %cone bisk:so))
- ==
- --
- ::
- ++ clad :: hoon doccords
- |* fel=rule
- %+ cook
- |= [a=whit b=hoon c=whiz]
- =? b !=(c *whiz)
- [%note help/`[c]~ b]
- =+ docs=~(tap by bat.a)
- |-
- ?~ docs b
- $(docs t.docs, b [%note help/i.docs b])
- (seam fel)
- ++ coat :: spec doccords
- |* fel=rule
- %+ cook
- |= [a=whit b=spec c=whiz]
- =? b !=(c *whiz)
- [%gist help/`[c]~ b]
- =+ docs=~(tap by bat.a)
- |-
- ?~ docs b
- $(docs t.docs, b [%gist help/i.docs b])
- (seam fel)
- ++ scye :: with prefix doccords
- |* fel=rule
- ;~(pose ;~(plug apex:docs ;~(pfix gap fel)) ;~(plug (easy *whit) fel))
- ++ seam :: with doccords
- |* fel=rule
- (scye ;~(plug fel apse:docs))
- ::
- ++ plex :: reparse static path
- |= gen=hoon ^- (unit path)
- ?: ?=([%dbug *] gen) :: unwrap %dbug
- $(gen q.gen)
- ?. ?=([%clsg *] gen) ~ :: require :~ hoon
- %+ reel p.gen :: build using elements
- |= [a=hoon b=_`(unit path)`[~ u=/]] :: starting from just /
- ?~ b ~
- ?. ?=([%sand ?(%ta %tas) @] a) ~ :: /foo constants
- `[q.a u.b]
- ::
- ++ phax
- |= ruw=(list (list woof))
- =+ [yun=*(list hoon) cah=*(list @)]
- =+ wod=|=([a=tape b=(list hoon)] ^+(b ?~(a b [[%mcfs %knit (flop a)] b])))
- |- ^+ yun
- ?~ ruw
- (flop (wod cah yun))
- ?~ i.ruw $(ruw t.ruw)
- ?@ i.i.ruw
- $(i.ruw t.i.ruw, cah [i.i.ruw cah])
- $(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)])
- ::
- ++ posh
- |= [pre=(unit tyke) pof=(unit [p=@ud q=tyke])]
- ^- (unit (list hoon))
- =- ?^(- - ~&(%posh-fail -))
- =+ wom=(poof wer)
- %+ biff
- ?~ pre `u=wom
- %+ bind (poon wom u.pre)
- |= moz=(list hoon)
- ?~(pof moz (weld moz (slag (lent u.pre) wom)))
- |= yez=(list hoon)
- ?~ pof `yez
- =+ zey=(flop yez)
- =+ [moz=(scag p.u.pof zey) gul=(slag p.u.pof zey)]
- =+ zom=(poon (flop moz) q.u.pof)
- ?~(zom ~ `(weld (flop gul) u.zom))
- ::
- ++ poof :: path -> (list hoon)
- |=(pax=path ^-((list hoon) (turn pax |=(a=@ta [%sand %ta a]))))
- ::
- :: tyke is =foo== as ~[~ `foo ~ ~]
- :: interpolate '=' path components
- ++ poon :: try to replace '='s
- |= [pag=(list hoon) goo=tyke] :: default to pag
- ^- (unit (list hoon)) :: for null goo's
- ?~ goo `~ :: keep empty goo
- %+ both :: otherwise head comes
- ?^(i.goo i.goo ?~(pag ~ `u=i.pag)) :: from goo or pag
- $(goo t.goo, pag ?~(pag ~ t.pag)) :: recurse on tails
- ::
- ++ poor
- %+ sear posh
- ;~ plug
- (stag ~ gash)
- ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~))
- ==
- ::
- ++ porc
- ;~ plug
- (cook |=(a=(list) (lent a)) (star cen))
- ;~(pfix fas gash)
- ==
- ::
- ++ rump
- %+ sear
- |= [a=wing b=(unit hoon)] ^- (unit hoon)
- ?~(b [~ %wing a] ?.(?=([@ ~] a) ~ [~ [%rock %tas i.a] u.b]))
- ;~(plug rope ;~(pose (stag ~ wede) (easy ~)))
- ::
- ++ rood
- ;~ pfix fas
- (stag %clsg poor)
- ==
- ::
- ++ reed
- ;~ pfix fas
- (stag %clsg (more fas stem))
- ==
- ::
- ++ stem
- %+ knee *hoon |. ~+
- %+ cook
- |= iota=$%([%hoon =hoon] iota)
- ?@ iota [%rock %tas iota]
- ?: ?=(%hoon -.iota) hoon.iota
- [%clhp [%rock %tas -.iota] [%sand iota]]
- |^ %- stew
- ^. stet ^. limo
- :~ :- 'a'^'z' ;~ pose
- (spit (stag %cncl (ifix [pal par] (most ace wide))))
- (spit (ifix [sel ser] wide))
- (slot sym)
- ==
- :- '$' (cold %$ buc)
- :- '0'^'9' (slot bisk:so)
- :- '-' (slot tash:so)
- :- '.' ;~(pfix dot zust:so)
- :- '~' (slot ;~(pfix sig ;~(pose crub:so (easy [%n ~]))))
- :- '\'' (stag %t qut)
- :- '[' (slip (ifix [sel ser] wide))
- :- '(' (slip (stag %cncl (ifix [pal par] (most ace wide))))
- ==
- ::
- ++ slip |*(r=rule (stag %hoon r))
- ++ slot |*(r=rule (sear (soft iota) r))
- ++ spit
- |* r=rule
- %+ stag %hoon
- %+ cook
- |*([a=term b=*] `hoon`[%clhp [%rock %tas a] b])
- ;~((glue lus) sym r)
- --
- ::
- ++ rupl
- %+ cook
- |= [a=? b=(list hoon) c=?]
- ?: a
- ?: c
- [%clsg [%clsg b] ~]
- [%clsg b]
- ?: c
- [%clsg [%cltr b] ~]
- [%cltr b]
- ;~ plug
- ;~ pose
- (cold | (just '['))
- (cold & (jest '~['))
- ==
- ::
- ;~ pose
- (ifix [ace gap] (most gap tall))
- (most ace wide)
- ==
- ::
- ;~ pose
- (cold & (jest ']~'))
- (cold | (just ']'))
- ==
- ==
- ::
- ::
- ++ sail :: xml template
- |= in-tall-form=? =| lin=?
- |%
- ::
- ++ apex :: product hoon
- %+ cook
- |= tum=(each manx:hoot marl:hoot) ^- hoon
- ?- -.tum
- %& [%xray p.tum]
- %| [%mcts p.tum]
- ==
- top-level
- ::
- ++ top-level :: entry-point
- ;~(pfix mic ?:(in-tall-form tall-top wide-top))
- ::
- ++ inline-embed :: brace interpolation
- %+ cook |=(a=tuna:hoot a)
- ;~ pose
- ;~(pfix mic bracketed-elem(in-tall-form |))
- ;~(plug tuna-mode sump)
- (stag %tape sump)
- ==
- ::
- ++ script-or-style :: script or style
- %+ cook |=(a=marx:hoot a)
- ;~ plug
- ;~(pose (jest %script) (jest %style))
- wide-attrs
- ==
- ::
- ++ tuna-mode :: xml node(s) kind
- ;~ pose
- (cold %tape hep)
- (cold %manx lus)
- (cold %marl tar)
- (cold %call cen)
- ==
- ::
- ++ wide-top :: wide outer top
- %+ knee *(each manx:hoot marl:hoot) |. ~+
- ;~ pose
- (stag %| wide-quote)
- (stag %| wide-paren-elems)
- (stag %& ;~(plug tag-head wide-tail))
- ==
- ::
- ++ wide-inner-top :: wide inner top
- %+ knee *(each tuna:hoot marl:hoot) |. ~+
- ;~ pose
- wide-top
- (stag %& ;~(plug tuna-mode wide))
- ==
- ::
- ++ wide-attrs :: wide attributes
- %+ cook |=(a=(unit mart:hoot) (fall a ~))
- %- punt
- %+ ifix [pal par]
- %+ more (jest ', ')
- ;~((glue ace) a-mane hopefully-quote)
- ::
- ++ wide-tail :: wide elements
- %+ cook |=(a=marl:hoot a)
- ;~(pose ;~(pfix col wrapped-elems) (cold ~ mic) (easy ~))
- ::
- ++ wide-elems :: wide elements
- %+ cook |=(a=marl:hoot a)
- %+ cook join-tops
- (star ;~(pfix ace wide-inner-top))
- ::
- ++ wide-paren-elems :: wide flow
- %+ cook |=(a=marl:hoot a)
- %+ cook join-tops
- (ifix [pal par] (more ace wide-inner-top))
- ::
- ::+|
- ::
- ++ drop-top
- |= a=(each tuna:hoot marl:hoot) ^- marl:hoot
- ?- -.a
- %& [p.a]~
- %| p.a
- ==
- ::
- ++ join-tops
- |= a=(list (each tuna:hoot marl:hoot)) ^- marl:hoot
- (zing (turn a drop-top))
- ::
- ::+|
- ::
- ++ wide-quote :: wide quote
- %+ cook |=(a=marl:hoot a)
- ;~ pose
- ;~ less (jest '"""')
- (ifix [doq doq] (cook collapse-chars quote-innards))
- ==
- ::
- %- inde
- %+ ifix [(jest '"""\0a') (jest '\0a"""')]
- (cook collapse-chars quote-innards(lin |))
- ==
- ::
- ++ quote-innards :: wide+tall flow
- %+ cook |=(a=(list $@(@ tuna:hoot)) a)
- %- star
- ;~ pose
- ;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab))
- inline-embed
- ;~(less bas kel ?:(in-tall-form fail doq) prn)
- ?:(lin fail ;~(less (jest '\0a"""') (just '\0a')))
- ==
- ::
- ++ bracketed-elem :: bracketed element
- %+ ifix [kel ker]
- ;~(plug tag-head wide-elems)
- ::
- ++ wrapped-elems :: wrapped tuna
- %+ cook |=(a=marl:hoot a)
- ;~ pose
- wide-paren-elems
- (cook |=(@t `marl`[;/((trip +<))]~) qut)
- (cook drop-top wide-top)
- ==
- ::
- ++ a-mane :: mane as hoon
- %+ cook
- |= [a=@tas b=(unit @tas)]
- ?~(b a [a u.b])
- ;~ plug
- mixed-case-symbol
- ;~ pose
- %+ stag ~
- ;~(pfix cab mixed-case-symbol)
- (easy ~)
- ==
- ==
- ::
- ++ en-class
- |= a=(list [%class p=term])
- ^- (unit [%class tape])
- ?~ a ~
- %- some
- :- %class
- |-
- %+ welp (trip p.i.a)
- ?~ t.a ~
- [' ' $(a t.a)]
- ::
- ++ tag-head :: tag head
- %+ cook
- |= [a=mane:hoot b=mart:hoot c=mart:hoot]
- ^- marx:hoot
- [a (weld b c)]
- ;~ plug
- a-mane
- ::
- %+ cook
- |= a=(list (unit [term (list beer:hoot)]))
- ^- (list [term (list beer:hoot)])
- :: discard nulls
- (murn a same)
- ;~ plug
- (punt ;~(plug (cold %id hax) (cook trip sym)))
- (cook en-class (star ;~(plug (cold %class dot) sym)))
- (punt ;~(plug ;~(pose (cold %href fas) (cold %src pat)) soil))
- (easy ~)
- ==
- ::
- wide-attrs
- ==
- ::
- ++ tall-top :: tall top
- %+ knee *(each manx:hoot marl:hoot) |. ~+
- ;~ pose
- (stag %| ;~(pfix (plus ace) (cook collapse-chars quote-innards)))
- (stag %& ;~(plug script-or-style script-style-tail))
- (stag %& tall-elem)
- (stag %| wide-quote)
- (stag %| ;~(pfix tis tall-tail))
- (stag %& ;~(pfix gar gap (stag [%div ~] cram)))
- (stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~)))
- (easy %| [;/("\0a")]~)
- ==
- ::
- ++ tall-attrs :: tall attributes
- %- star
- ;~ pfix ;~(plug gap tis)
- ;~((glue gap) a-mane hopefully-quote)
- ==
- ::
- ++ tall-elem :: tall preface
- %+ cook
- |= [a=[p=mane:hoot q=mart:hoot] b=mart:hoot c=marl:hoot]
- ^- manx:hoot
- [[p.a (weld q.a b)] c]
- ;~(plug tag-head tall-attrs tall-tail)
- ::
- ::REVIEW is there a better way to do this?
- ++ hopefully-quote :: prefer "quote" form
- %+ cook |=(a=(list beer:hoot) a)
- %+ cook |=(a=hoon ?:(?=(%knit -.a) p.a [~ a]~))
- wide
- ::
- ++ script-style-tail :: unescaped tall tail
- %+ cook |=(a=marl:hoot a)
- %+ ifix [gap ;~(plug gap duz)]
- %+ most gap
- ;~ pfix mic
- %+ cook |=(a=tape ;/(a))
- ;~ pose
- ;~(pfix ace (star prn))
- (easy "\0a")
- ==
- ==
- ::
- ++ tall-tail :: tall tail
- ?> in-tall-form
- %+ cook |=(a=marl:hoot a)
- ;~ pose
- (cold ~ mic)
- ;~(pfix col wrapped-elems(in-tall-form |))
- ;~(pfix col ace (cook collapse-chars(in-tall-form |) quote-innards))
- (ifix [gap ;~(plug gap duz)] tall-kids)
- ==
- ::
- ++ tall-kids :: child elements
- %+ cook join-tops
- :: look for sail first, or markdown if not
- (most gap ;~(pose top-level (stag %| cram)))
- ::
- ++ collapse-chars :: group consec chars
- |= reb=(list $@(@ tuna:hoot))
- ^- marl:hoot
- =| [sim=(list @) tuz=marl:hoot]
- |- ^- marl:hoot
- ?~ reb
- =. sim
- ?. in-tall-form sim
- [10 |-(?~(sim sim ?:(=(32 i.sim) $(sim t.sim) sim)))]
- ?~(sim tuz [;/((flop sim)) tuz])
- ?@ i.reb
- $(reb t.reb, sim [i.reb sim])
- ?~ sim [i.reb $(reb t.reb, sim ~)]
- [;/((flop sim)) i.reb $(reb t.reb, sim ~)]
- --
- ++ cram :: parse unmark
- => |%
- ++ item (pair mite marl:hoot) :: xml node generator
- ++ colm @ud :: column
- ++ tarp marl:hoot :: node or generator
- ++ mite :: context
- $? %down :: outer embed
- %lunt :: unordered list
- %lime :: list item
- %lord :: ordered list
- %poem :: verse
- %bloc :: blockquote
- %head :: heading
- == ::
- ++ trig :: line style
- $: col=@ud :: start column
- sty=trig-style :: style
- == ::
- ++ trig-style :: type of parsed line
- $% $: %end :: terminator
- $? %done :: end of input
- %stet :: == end of markdown
- %dent :: outdent
- == == ::
- $: %one :: leaf node
- $? %rule :: --- horz rule
- %fens :: ``` code fence
- %expr :: ;sail expression
- == == ::
- [%new p=trig-new] :: open container
- [%old %text] :: anything else
- == ::
- ++ trig-new :: start a
- $? %lite :: + line item
- %lint :: - line item
- %head :: # heading
- %bloc :: > block-quote
- %poem :: [ ]{8} poem
- == ::
- ++ graf :: paragraph element
- $% [%bold p=(list graf)] :: *bold*
- [%talc p=(list graf)] :: _italics_
- [%quod p=(list graf)] :: "double quote"
- [%code p=tape] :: code literal
- [%text p=tape] :: text symbol
- [%link p=(list graf) q=tape] :: URL
- [%mage p=tape q=tape] :: image
- [%expr p=tuna:hoot] :: interpolated hoon
- ==
- --
- =< (non-empty:parse |=(nail `(like tarp)`~($ main +<)))
- |%
- ++ main
- ::
- :: state of the parsing loop.
- ::
- :: we maintain a construction stack for elements and a line
- :: stack for lines in the current block. a blank line
- :: causes the current block to be parsed and thrown in the
- :: current element. when the indent column retreats, the
- :: element stack rolls up.
- ::
- :: .verbose: debug printing enabled
- :: .err: error position
- :: .ind: outer and inner indent level
- :: .hac: stack of items under construction
- :: .cur: current item under construction
- :: .par: current "paragraph" being read in
- :: .[loc txt]: parsing state
- ::
- =/ verbose &
- =| err=(unit hair)
- =| ind=[out=@ud inr=@ud]
- =| hac=(list item)
- =/ cur=item [%down ~]
- =| par=(unit (pair hair wall))
- |_ [loc=hair txt=tape]
- ::
- ++ $ :: resolve
- ^- (like tarp)
- => line
- ::
- :: if error position is set, produce error
- ?. =(~ err)
- ~& err+err
- [+.err ~]
- ::
- :: all data was consumed
- =- [loc `[- [loc txt]]]
- => close-par
- |- ^- tarp
- ::
- :: fold all the way to top
- ?~ hac cur-to-tarp
- $(..^$ close-item)
- ::
- ::+|
- ::
- ++ cur-indent
- ?- p.cur
- %down 2
- %head 0
- %lunt 0
- %lime 2
- %lord 0
- %poem 8
- %bloc 2
- ==
- ::
- ++ back :: column retreat
- |= luc=@ud
- ^+ +>
- ?: (gte luc inr.ind) +>
- ::
- :: nex: next backward step that terminates this context
- =/ nex=@ud cur-indent :: REVIEW code and poem blocks are
- :: handled elsewhere
- ?: (gth nex (sub inr.ind luc))
- ::
- :: indenting pattern violation
- ~? verbose indent-pattern-violation+[p.cur nex inr.ind luc]
- ..^$(inr.ind luc, err `[p.loc luc])
- =. ..^$ close-item
- $(inr.ind (sub inr.ind nex))
- ::
- ++ cur-to-tarp :: item to tarp
- ^- tarp
- ?: ?=(?(%down %head %expr) p.cur)
- (flop q.cur)
- =- [[- ~] (flop q.cur)]~
- ?- p.cur
- %lunt %ul
- %lord %ol
- %lime %li
- %poem %div ::REVIEW actual container element?
- %bloc %blockquote
- ==
- ::
- ++ close-item ^+ . :: complete and pop
- ?~ hac .
- %= .
- hac t.hac
- cur [p.i.hac (weld cur-to-tarp q.i.hac)]
- ==
- ::
- ++ read-line :: capture raw line
- =| lin=tape
- |- ^+ [[lin *(unit _err)] +<.^$] :: parsed tape and halt/error
- ::
- :: no unterminated lines
- ?~ txt
- ~? verbose %unterminated-line
- [[~ ``loc] +<.^$]
- ?. =(`@`10 i.txt)
- ?: (gth inr.ind q.loc)
- ?. =(' ' i.txt)
- ~? verbose expected-indent+[inr.ind loc txt]
- [[~ ``loc] +<.^$]
- $(txt t.txt, q.loc +(q.loc))
- ::
- :: save byte and repeat
- $(txt t.txt, q.loc +(q.loc), lin [i.txt lin])
- =. lin
- ::
- :: trim trailing spaces
- |- ^- tape
- ?: ?=([%' ' *] lin)
- $(lin t.lin)
- (flop lin)
- ::
- =/ eat-newline=nail [[+(p.loc) 1] t.txt]
- =/ saw look(+<.$ eat-newline)
- ::
- ?: ?=([~ @ %end ?(%stet %dent)] saw) :: stop on == or dedent
- [[lin `~] +<.^$]
- [[lin ~] eat-newline]
- ::
- ++ look :: inspect line
- ^- (unit trig)
- %+ bind (wonk (look:parse loc txt))
- |= a=trig ^+ a
- ::
- :: treat a non-terminator as a terminator
- :: if it's outdented
- ?: =(%end -.sty.a) a
- ?: (lth col.a out.ind)
- a(sty [%end %dent])
- a
- ::
- ++ close-par :: make block
- ^+ .
- ::
- :: empty block, no action
- ?~ par .
- ::
- :: if block is verse
- ?: ?=(%poem p.cur)
- ::
- :: add break between stanzas
- =. q.cur ?~(q.cur q.cur [[[%br ~] ~] q.cur])
- =- close-item(par ~, q.cur (weld - q.cur), inr.ind (sub inr.ind 8))
- %+ turn q.u.par
- |= tape ^- manx
- ::
- :: each line is a paragraph
- :- [%p ~]
- :_ ~
- ;/("{+<}\0a")
- ::
- :: yex: block recomposed, with newlines
- =/ yex=tape
- %- zing
- %+ turn (flop q.u.par)
- |= a=tape
- (runt [(dec inr.ind) ' '] "{a}\0a")
- ::
- :: vex: parse of paragraph
- =/ vex=(like tarp)
- ::
- :: either a one-line header or a paragraph
- %. [p.u.par yex]
- ?: ?=(%head p.cur)
- (full head:parse)
- (full para:parse)
- ::
- :: if error, propagate correctly
- ?~ q.vex
- ~? verbose [%close-par p.cur yex]
- ..$(err `p.vex)
- ::
- :: finish tag if it's a header
- =< ?:(?=(%head p.cur) close-item ..$)
- ::
- :: save good result, clear buffer
- ..$(par ~, q.cur (weld p.u.q.vex q.cur))
- ::
- ++ line ^+ . :: body line loop
- ::
- :: abort after first error
- ?: !=(~ err) .
- ::
- :: saw: profile of this line
- =/ saw look
- ~? [debug=|] [%look ind=ind saw=saw txt=txt]
- ::
- :: if line is blank
- ?~ saw
- ::
- :: break section
- =^ a=[tape fin=(unit _err)] +<.$ read-line
- ?^ fin.a
- ..$(err u.fin.a)
- =>(close-par line)
- ::
- :: line is not blank
- => .(saw u.saw)
- ::
- :: if end of input, complete
- ?: ?=(%end -.sty.saw)
- ..$(q.loc col.saw)
- ::
- =. ind ?~(out.ind [col.saw col.saw] ind) :: init indents
- ::
- ?: ?| ?=(~ par) :: if after a paragraph or
- ?& ?=(?(%down %lime %bloc) p.cur) :: unspaced new container
- |(!=(%old -.sty.saw) (gth col.saw inr.ind))
- == ==
- => .(..$ close-par)
- ::
- :: if column has retreated, adjust stack
- =. ..$ (back col.saw)
- ::
- =^ col-ok sty.saw
- ?+ (sub col.saw inr.ind) [| sty.saw] :: columns advanced
- %0 [& sty.saw]
- %8 [& %new %poem]
- ==
- ?. col-ok
- ~? verbose [%columns-advanced col.saw inr.ind]
- ..$(err `[p.loc col.saw])
- ::
- =. inr.ind col.saw
- ::
- :: unless adding a matching item, close lists
- =. ..$
- ?: ?| &(?=(%lunt p.cur) !?=(%lint +.sty.saw))
- &(?=(%lord p.cur) !?=(%lite +.sty.saw))
- ==
- close-item
- ..$
- ::
- =< line(par `[loc ~]) ^+ ..$ :: continue with para
- ?- -.sty.saw
- %one (read-one +.sty.saw) :: parse leaves
- %new (open-item p.sty.saw) :: open containers
- %old ..$ :: just text
- ==
- ::
- ::
- ::- - - foo
- :: detect bad block structure
- ?. :: first line of container is legal
- ?~ q.u.par &
- ?- p.cur
- ::
- :: can't(/directly) contain text
- ?(%lord %lunt) ~|(bad-leaf-container+p.cur !!)
- ::
- :: only one line in a header
- %head |
- ::
- :: indented literals need to end with a blank line
- %poem (gte col.saw inr.ind)
- ::
- :: text tarps must continue aligned
- ?(%down %lunt %lime %lord %bloc) =(col.saw inr.ind)
- ==
- ~? verbose bad-block-structure+[p.cur inr.ind col.saw]
- ..$(err `[p.loc col.saw])
- ::
- :: accept line and maybe continue
- =^ a=[lin=tape fin=(unit _err)] +<.$ read-line
- =. par par(q.u [lin.a q.u.par])
- ?^ fin.a ..$(err u.fin.a)
- line
- ++ parse-block :: execute parser
- |= fel=$-(nail (like tarp)) ^+ +>
- =/ vex=(like tarp) (fel loc txt)
- ?~ q.vex
- ~? verbose [%parse-block txt]
- +>.$(err `p.vex)
- =+ [res loc txt]=u.q.vex
- %_ +>.$
- loc loc
- txt txt
- q.cur (weld (flop `tarp`res) q.cur) :: prepend to the stack
- ==
- ::
- ++ read-one :: read %one item
- |= sty=?(%expr %rule %fens) ^+ +>
- ?- sty
- %expr (parse-block expr:parse)
- %rule (parse-block hrul:parse)
- %fens (parse-block (fens:parse inr.ind))
- ==
- ::
- ++ open-item :: enter list/quote
- |= saw=trig-new
- =< +>.$:apex
- |%
- ++ apex ^+ . :: open container
- ?- saw
- %poem (push %poem) :: verse literal
- %head (push %head) :: heading
- %bloc (entr %bloc) :: blockquote line
- %lint (lent %lunt) :: unordered list
- %lite (lent %lord) :: ordered list
- ==
- ::
- ++ push :: push context
- |=(mite +>(hac [cur hac], cur [+< ~]))
- ::
- ++ entr :: enter container
- |= typ=mite
- ^+ +>
- ::
- :: indent by 2
- =. inr.ind (add 2 inr.ind)
- ::
- :: "parse" marker
- =. txt (slag (sub inr.ind q.loc) txt)
- =. q.loc inr.ind
- ::
- (push typ)
- ::
- ++ lent :: list entry
- |= ord=?(%lord %lunt)
- ^+ +>
- => ?:(=(ord p.cur) +>.$ (push ord)) :: push list if new
- (entr %lime)
- --
- --
- ::
- ++ parse :: individual parsers
- |%
- ++ look :: classify line
- %+ cook |=(a=(unit trig) a)
- ;~ pfix (star ace)
- %+ here :: report indent
- |=([a=pint b=?(~ trig-style)] ?~(b ~ `[q.p.a b]))
- ;~ pose
- (cold ~ (just `@`10)) :: blank line
- ::
- (full (easy [%end %done])) :: end of input
- (cold [%end %stet] duz) :: == end of markdown
- ::
- (cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler
- (cold [%one %fens] ;~(plug tic tic tic)) :: ``` code fence
- (cold [%one %expr] mic) :: ;sail expression
- ::
- (cold [%new %head] ;~(plug (star hax) ace)) :: # heading
- (cold [%new %lint] ;~(plug hep ace)) :: - line item
- (cold [%new %lite] ;~(plug lus ace)) :: + line item
- (cold [%new %bloc] ;~(plug gar ace)) :: > block-quote
- ::
- (easy [%old %text]) :: anything else
- ==
- ==
- ::
- ::
- ++ calf :: cash but for tic tic
- |* tem=rule
- %- star
- ;~ pose
- ;~(pfix bas tem)
- ;~(less tem prn)
- ==
- ++ cash :: escaped fence
- |* tem=rule
- %- echo
- %- star
- ;~ pose
- whit
- ;~(plug bas tem)
- ;~(less tem prn)
- ==
- ::
- ++ cool :: reparse
- |* $: :: fex: primary parser
- :: sab: secondary parser
- ::
- fex=rule
- sab=rule
- ==
- |= [loc=hair txt=tape]
- ^+ *sab
- ::
- :: vex: fenced span
- =/ vex=(like tape) (fex loc txt)
- ?~ q.vex vex
- ::
- :: hav: reparse full fenced text
- =/ hav ((full sab) [loc p.u.q.vex])
- ::
- :: reparsed error position is always at start
- ?~ q.hav [loc ~]
- ::
- :: the complete type with the main product
- :- p.vex
- `[p.u.q.hav q.u.q.vex]
- ::
- ::REVIEW surely there is a less hacky "first or after space" solution
- ++ easy-sol :: parse start of line
- |* a=*
- |= b=nail
- ?: =(1 q.p.b) ((easy a) b)
- (fail b)
- ::
- ++ echo :: hoon literal
- |* sab=rule
- |= [loc=hair txt=tape]
- ^- (like tape)
- ::
- :: vex: result of parsing wide hoon
- =/ vex (sab loc txt)
- ::
- :: use result of expression parser
- ?~ q.vex vex
- =- [p.vex `[- q.u.q.vex]]
- ::
- :: but replace payload with bytes consumed
- |- ^- tape
- ?: =(q.q.u.q.vex txt) ~
- ?~ txt ~
- [i.txt $(txt +.txt)]
- ::
- ++ non-empty
- |* a=rule
- |= tub=nail ^+ (a)
- =/ vex (a tub)
- ~! vex
- ?~ q.vex vex
- ?. =(tub q.u.q.vex) vex
- (fail tub)
- ::
- ::
- ++ word :: tarp parser
- %+ knee *(list graf) |. ~+
- %+ cook
- |= a=$%(graf [%list (list graf)])
- ^- (list graf)
- ?:(?=(%list -.a) +.a [a ~])
- ;~ pose
- ::
- :: ordinary word
- ::
- %+ stag %text
- ;~(plug ;~(pose low hig) (star ;~(pose nud low hig hep)))
- ::
- :: naked \escape
- ::
- (stag %text ;~(pfix bas (cook trip ;~(less ace prn))))
- ::
- :: trailing \ to add <br>
- ::
- (stag %expr (cold [[%br ~] ~] ;~(plug bas (just '\0a'))))
- ::
- :: *bold literal*
- ::
- (stag %bold (ifix [tar tar] (cool (cash tar) werk)))
- ::
- :: _italic literal_
- ::
- (stag %talc (ifix [cab cab] (cool (cash cab) werk)))
- ::
- :: "quoted text"
- ::
- (stag %quod (ifix [doq doq] (cool (cash doq) werk)))
- ::
- :: `classic markdown quote`
- ::
- (stag %code (ifix [tic tic] (calf tic)))
- ::
- :: ++arm, +$arm, +*arm, ++arm:core, ...
- ::
- %+ stag %code
- ;~ plug
- lus ;~(pose lus buc tar)
- low (star ;~(pose nud low hep col))
- ==
- ::
- :: [arbitrary *content*](url)
- ::
- %+ stag %link
- ;~ (glue (punt whit))
- (ifix [sel ser] (cool (cash ser) werk))
- (ifix [pal par] (cash par))
- ==
- ::
- :: 
- ::
- %+ stag %mage
- ;~ pfix zap
- ;~ (glue (punt whit))
- (ifix [sel ser] (cash ser))
- (ifix [pal par] (cash par))
- ==
- ==
- ::
- :: #hoon
- ::
- %+ stag %list
- ;~ plug
- (stag %text ;~(pose (cold " " whit) (easy-sol ~)))
- (stag %code ;~(pfix hax (echo wide)))
- ;~(simu whit (easy ~))
- ==
- ::
- :: direct hoon constant
- ::
- %+ stag %list
- ;~ plug
- (stag %text ;~(pose (cold " " whit) (easy-sol ~)))
- ::
- %+ stag %code
- %- echo
- ;~ pose
- ::REVIEW just copy in 0x... parsers directly?
- ;~(simu ;~(plug (just '0') alp) bisk:so)
- ::
- tash:so
- ;~(pfix dot perd:so)
- ;~(pfix sig ;~(pose twid:so (easy [%$ %n 0])))
- ;~(pfix cen ;~(pose sym buc pam bar qut nuck:so))
- ==
- ::
- ;~(simu whit (easy ~))
- ==
- ::
- :: whitespace
- ::
- (stag %text (cold " " whit))
- ::
- :: {interpolated} sail
- ::
- (stag %expr inline-embed:(sail |))
- ::
- :: just a byte
- ::
- (stag %text (cook trip ;~(less ace prn)))
- ==
- ::
- ++ werk (cook zing (star word)) :: indefinite tarp
- ::
- ++ down :: parse inline tarp
- %+ knee *tarp |. ~+
- =- (cook - werk)
- ::
- :: collect raw tarp into xml tags
- |= gaf=(list graf)
- ^- tarp
- =< main
- |%
- ++ main
- ^- tarp
- ?~ gaf ~
- ?. ?=(%text -.i.gaf)
- (weld (item i.gaf) $(gaf t.gaf))
- ::
- :: fip: accumulate text blocks
- =/ fip=(list tape) [p.i.gaf]~
- |- ^- tarp
- ?~ t.gaf [;/((zing (flop fip))) ~]
- ?. ?=(%text -.i.t.gaf)
- [;/((zing (flop fip))) ^$(gaf t.gaf)]
- $(gaf t.gaf, fip :_(fip p.i.t.gaf))
- ::
- ++ item
- |= nex=graf
- ^- tarp ::CHECK can be tuna:hoot?
- ?- -.nex
- %text !! :: handled separately
- %expr [p.nex]~
- %bold [[%b ~] ^$(gaf p.nex)]~
- %talc [[%i ~] ^$(gaf p.nex)]~
- %code [[%code ~] ;/(p.nex) ~]~
- %quod ::
- :: smart quotes
- %= ^$
- gaf
- :- [%text (tufa ~-~201c. ~)]
- %+ weld p.nex
- `(list graf)`[%text (tufa ~-~201d. ~)]~
- ==
- %link [[%a [%href q.nex] ~] ^$(gaf p.nex)]~
- %mage [[%img [%src q.nex] ?~(p.nex ~ [%alt p.nex]~)] ~]~
- ==
- --
- ::
- ++ hrul :: empty besides fence
- %+ cold [[%hr ~] ~]~
- ;~(plug (star ace) hep hep hep (star hep) (just '\0a'))
- ::
- ++ tics
- ;~(plug tic tic tic (just '\0a'))
- ::
- ++ fens
- |= col=@u ~+
- =/ ind (stun [(dec col) (dec col)] ace)
- =/ ind-tics ;~(plug ind tics)
- %+ cook |=(txt=tape `tarp`[[%pre ~] ;/(txt) ~]~)
- ::
- :: leading outdent is ok since container may
- :: have already been parsed and consumed
- %+ ifix [;~(plug (star ace) tics) ind-tics]
- %^ stir "" |=([a=tape b=tape] "{a}\0a{b}")
- ;~ pose
- %+ ifix [ind (just '\0a')]
- ;~(less tics (star prn))
- ::
- (cold "" ;~(plug (star ace) (just '\0a')))
- ==
- ::
- ++ para :: paragraph
- %+ cook
- |=(a=tarp ?~(a ~ [[%p ~] a]~))
- ;~(pfix (punt whit) down)
- ::
- ++ expr :: expression
- => (sail &) :: tall-form
- %+ ifix [(star ace) ;~(simu gap (easy))] :: look-ahead for gap
- (cook drop-top top-level) :: list of tags
- ::
- ::
- ++ whit :: whitespace
- (cold ' ' (plus ;~(pose (just ' ') (just '\0a'))))
- ::
- ++ head :: parse heading
- %+ cook
- |= [haxes=tape kids=tarp] ^- tarp
- =/ tag (crip 'h' <(lent haxes)>) :: e.g. ### -> %h3
- =/ id (contents-to-id kids)
- [[tag [%id id]~] kids]~
- ::
- ;~(pfix (star ace) ;~((glue whit) (stun [1 6] hax) down))
- ::
- ++ contents-to-id :: # text into elem id
- |= a=(list tuna:hoot) ^- tape
- =; raw=tape
- %+ turn raw
- |= @tD
- ^- @tD
- ?: ?| &((gte +< 'a') (lte +< 'z'))
- &((gte +< '0') (lte +< '9'))
- ==
- +<
- ?: &((gte +< 'A') (lte +< 'Z'))
- (add 32 +<)
- '-'
- ::
- :: collect all text in header tarp
- |- ^- tape
- ?~ a ~
- %+ weld
- ^- tape
- ?- i.a
- [[%$ [%$ *] ~] ~] :: text node contents
- (murn v.i.a.g.i.a |=(a=beer:hoot ?^(a ~ (some a))))
- [^ *] $(a c.i.a) :: concatenate children
- [@ *] ~ :: ignore interpolation
- ==
- $(a t.a)
- --
- --
- ::
- ++ scad
- %+ knee *spec |. ~+
- %- stew
- ^. stet ^. limo
- :~
- :- '_'
- ;~(pfix cab (stag %bccb wide))
- :- ','
- ;~(pfix com (stag %bcmc wide))
- :- '$'
- (stag %like (most col rope))
- :- '%'
- ;~ pose
- ;~ pfix cen
- ;~ pose
- (stag %leaf (stag %tas (cold %$ buc)))
- (stag %leaf (stag %f (cold & pam)))
- (stag %leaf (stag %f (cold | bar)))
- (stag %leaf (stag %t qut))
- (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so))
- ==
- ==
- ==
- :- '('
- %+ cook |=(spec +<)
- %+ stag %make
- %+ ifix [pal par]
- ;~ plug
- wide
- ;~(pose ;~(pfix ace (most ace wyde)) (easy ~))
- ==
- :- '['
- (stag %bccl (ifix [sel ser] (most ace wyde)))
- :- '*'
- (cold [%base %noun] tar)
- :- '/'
- ;~(pfix fas (stag %loop ;~(pose (cold %$ buc) sym)))
- :- '@'
- ;~(pfix pat (stag %base (stag %atom mota)))
- :- '?'
- ;~ pose
- %+ stag %bcwt
- ;~(pfix wut (ifix [pal par] (most ace wyde)))
- ::
- (cold [%base %flag] wut)
- ==
- :- '~'
- (cold [%base %null] sig)
- :- '!'
- (cold [%base %void] ;~(plug zap zap))
- :- '^'
- ;~ pose
- (stag %like (most col rope))
- (cold [%base %cell] ket)
- ==
- :- '='
- ;~ pfix tis
- %+ sear
- |= [=(unit term) =spec]
- %+ bind
- ~(autoname ax spec)
- |= =term
- =* name ?~(unit term (cat 3 u.unit (cat 3 '-' term)))
- [%bcts name spec]
- ;~ pose
- ;~(plug (stag ~ ;~(sfix sym tis)) wyde)
- (stag ~ wyde)
- ==
- ==
- :- ['a' 'z']
- ;~ pose
- (stag %bcts ;~(plug sym ;~(pfix tis wyde)))
- (stag %like (most col rope))
- ==
- ==
- ::
- ++ scat
- %+ knee *hoon |. ~+
- %- stew
- ^. stet ^. limo
- :~
- :- ','
- ;~ pose
- (stag %ktcl ;~(pfix com wyde))
- (stag %wing rope)
- ==
- :- '!'
- ;~ pose
- (stag %wtzp ;~(pfix zap wide))
- (stag %zpzp (cold ~ ;~(plug zap zap)))
- ==
- :- '_'
- ;~(pfix cab (stag %ktcl (stag %bccb wide)))
- :- '$'
- ;~ pose
- ;~ pfix buc
- ;~ pose
- :: XX: these are all obsolete in hoon 142
- ::
- (stag %leaf (stag %tas (cold %$ buc)))
- (stag %leaf (stag %t qut))
- (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so))
- ==
- ==
- rump
- ==
- :- '%'
- ;~ pfix cen
- ;~ pose
- (stag %clsg (sear |~([a=@ud b=tyke] (posh ~ ~ a b)) porc))
- (stag %rock (stag %tas (cold %$ buc)))
- (stag %rock (stag %f (cold & pam)))
- (stag %rock (stag %f (cold | bar)))
- (stag %rock (stag %t qut))
- (cook (jock &) nuck:so)
- (stag %clsg (sear |=(a=(list) (posh ~ ~ (lent a) ~)) (star cen)))
- ==
- ==
- :- '&'
- ;~ pose
- (cook |=(a=wing [%cnts a ~]) rope)
- (stag %wtpm ;~(pfix pam (ifix [pal par] (most ace wide))))
- ;~(plug (stag %rock (stag %f (cold & pam))) wede)
- (stag %sand (stag %f (cold & pam)))
- ==
- :- '\''
- (stag %sand (stag %t qut))
- :- '('
- (stag %cncl (ifix [pal par] (most ace wide)))
- :- '*'
- ;~ pose
- (stag %kttr ;~(pfix tar wyde))
- (cold [%base %noun] tar)
- ==
- :- '@'
- ;~(pfix pat (stag %base (stag %atom mota)))
- :- '+'
- ;~ pose
- (stag %dtls ;~(pfix lus (ifix [pal par] wide)))
- ::
- %+ cook
- |= a=(list (list woof))
- :- %mcfs
- [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
- (most dog ;~(pfix lus soil))
- ::
- (cook |=(a=wing [%cnts a ~]) rope)
- ==
- :- '-'
- ;~ pose
- (stag %sand tash:so)
- ::
- %+ cook
- |= a=(list (list woof))
- [%clsg (phax a)]
- (most dog ;~(pfix hep soil))
- ::
- (cook |=(a=wing [%cnts a ~]) rope)
- ==
- :- '.'
- ;~ pose
- (cook (jock |) ;~(pfix dot perd:so))
- (cook |=(a=wing [%cnts a ~]) rope)
- ==
- :- ['0' '9']
- %+ cook
- |= [a=dime b=(unit hoon)]
- ?~(b [%sand a] [[%rock a] u.b])
- ;~(plug bisk:so (punt wede))
- :- ':'
- ;~ pfix col
- ;~ pose
- (stag %mccl (ifix [pal par] (most ace wide)))
- ;~(pfix fas (stag %mcfs wide))
- ==
- ==
- :- '='
- ;~ pfix tis
- ;~ pose
- (stag %dtts (ifix [pal par] ;~(glam wide wide)))
- ::
- %+ sear
- :: mainly used for +skin formation
- ::
- |= =spec
- ^- (unit hoon)
- %+ bind ~(autoname ax spec)
- |=(=term `hoon`[%ktts term %kttr spec])
- wyde
- ==
- ==
- :- '?'
- ;~ pose
- %+ stag %ktcl
- (stag %bcwt ;~(pfix wut (ifix [pal par] (most ace wyde))))
- ::
- (cold [%base %flag] wut)
- ==
- :- '['
- rupl
- :- '^'
- ;~ pose
- (stag %wing rope)
- (cold [%base %cell] ket)
- ==
- :- '`'
- ;~ pfix tic
- ;~ pose
- %+ cook
- |=([a=@ta b=hoon] [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]])
- ;~(pfix pat ;~(plug mota ;~(pfix tic wide)))
- ;~ pfix tar
- (stag %kthp (stag [%base %noun] ;~(pfix tic wide)))
- ==
- (stag %kthp ;~(plug wyde ;~(pfix tic wide)))
- (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tic wide))))
- (cook |=(a=hoon [[%rock %n ~] a]) wide)
- ==
- ==
- :- '"'
- %+ cook
- |= a=(list (list woof))
- [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
- (most dog soil)
- :- ['a' 'z']
- rump
- :- '|'
- ;~ pose
- (cook |=(a=wing [%cnts a ~]) rope)
- (stag %wtbr ;~(pfix bar (ifix [pal par] (most ace wide))))
- ;~(plug (stag %rock (stag %f (cold | bar))) wede)
- (stag %sand (stag %f (cold | bar)))
- ==
- :- '~'
- ;~ pose
- rupl
- ::
- ;~ pfix sig
- ;~ pose
- (stag %clsg (ifix [sel ser] (most ace wide)))
- ::
- %+ stag %cnsg
- %+ ifix
- [pal par]
- ;~(glam rope wide (most ace wide))
- ::
- (cook (jock |) twid:so)
- (stag [%bust %null] wede)
- (easy [%bust %null])
- ==
- ==
- ==
- :- '/'
- rood
- :- '<'
- (ifix [gal gar] (stag %tell (most ace wide)))
- :- '>'
- (ifix [gar gal] (stag %yell (most ace wide)))
- :- '#'
- ;~(pfix hax reed)
- ==
- ++ soil
- ;~ pose
- ;~ less (jest '"""')
- %+ ifix [doq doq]
- %- star
- ;~ pose
- ;~(pfix bas ;~(pose bas doq kel bix:ab))
- ;~(less doq bas kel prn)
- (stag ~ sump)
- ==
- ==
- ::
- %- iny %+ ifix
- [(jest '"""\0a') (jest '\0a"""')]
- %- star
- ;~ pose
- ;~(pfix bas ;~(pose bas kel bix:ab))
- ;~(less bas kel prn)
- ;~(less (jest '\0a"""') (just `@`10))
- (stag ~ sump)
- ==
- ==
- ++ sump (ifix [kel ker] (stag %cltr (most ace wide)))
- ++ norm :: rune regular form
- |= tol=?
- |%
- ++ structure
- %- stew
- ^. stet ^. limo
- :~ :- '$'
- ;~ pfix buc
- %- stew
- ^. stet ^. limo
- :~ [':' (rune col %bccl exqs)]
- ['%' (rune cen %bccn exqs)]
- ['<' (rune gal %bcgl exqb)]
- ['>' (rune gar %bcgr exqb)]
- ['^' (rune ket %bckt exqb)]
- ['~' (rune sig %bcsg exqd)]
- ['|' (rune bar %bcbr exqc)]
- ['&' (rune pam %bcpm exqc)]
- ['@' (rune pat %bcpt exqb)]
- ['_' (rune cab %bccb expa)]
- ['-' (rune hep %bchp exqb)]
- ['=' (rune tis %bcts exqg)]
- ['?' (rune wut %bcwt exqs)]
- [';' (rune mic %bcmc expa)]
- ['+' (rune lus %bcls exqg)]
- ==
- ==
- :- '%'
- ;~ pfix cen
- %- stew
- ^. stet ^. limo
- :~ :- '^'
- %+ cook
- |= [%cnkt a=hoon b=spec c=spec d=spec]
- [%make a b c d ~]
- (rune ket %cnkt exqy)
- ::
- :- '+'
- %+ cook
- |= [%cnls a=hoon b=spec c=spec]
- [%make a b c ~]
- (rune lus %cnls exqx)
- ::
- :- '-'
- %+ cook
- |= [%cnhp a=hoon b=spec]
- [%make a b ~]
- (rune hep %cnhp exqd)
- ::
- :- '.'
- %+ cook
- |= [%cndt a=spec b=hoon]
- [%make b a ~]
- (rune dot %cndt exqc)
- ::
- :- ':'
- %+ cook
- |= [%cncl a=hoon b=(list spec)]
- [%make a b]
- (rune col %cncl exqz)
- ==
- ==
- :- '#'
- ;~ pfix hax fas
- %+ stag %bccl
- %+ cook
- |= [[i=spec t=(list spec)] e=spec]
- [i (snoc t e)]
- ;~ plug
- %+ most ;~(less ;~(plug fas tar) fas)
- %- stew
- ^. stet ^. limo
- :~ :- ['a' 'z']
- ;~ pose
- :: /name=@aura
- ::
- %+ cook
- |= [=term =aura]
- ^- spec
- :+ %bccl
- [%leaf %tas aura]
- :_ ~
- :+ %bcts term
- ?+ aura [%base %atom aura]
- %f [%base %flag]
- %n [%base %null]
- ==
- ;~(plug sym ;~(pfix tis pat mota))
- ::
- :: /constant
- ::
- (stag %leaf (stag %tas ;~(pose sym (cold %$ buc))))
- ==
- ::
- :: /@aura
- ::
- :- '@'
- %+ cook
- |= =aura
- ^- spec
- :+ %bccl
- [%leaf %tas aura]
- [%base %atom aura]~
- ;~(pfix pat mota)
- ::
- :: /?
- ::
- :- '?'
- (cold [%bccl [%leaf %tas %f] [%base %flag] ~] wut)
- ::
- :: /~
- ::
- :- '~'
- (cold [%bccl [%leaf %tas %n] [%base %null] ~] sig)
- ==
- ::
- :: open-ended or fixed-length
- ::
- ;~ pose
- (cold [%base %noun] ;~(plug fas tar))
- (easy %base %null)
- ==
- ==
- ==
- ==
- ++ expression
- %- stew
- ^. stet ^. limo
- :~ :- '|'
- ;~ pfix bar
- %- stew
- ^. stet ^. limo
- :~ ['_' (rune cab %brcb exqr)]
- ['%' (runo cen %brcn ~ expe)]
- ['@' (runo pat %brpt ~ expe)]
- [':' (rune col %brcl expb)]
- ['.' (rune dot %brdt expa)]
- ['-' (rune hep %brhp expa)]
- ['^' (rune ket %brkt expr)]
- ['~' (rune sig %brsg exqc)]
- ['*' (rune tar %brtr exqc)]
- ['=' (rune tis %brts exqc)]
- ['?' (rune wut %brwt expa)]
- ['$' (rune buc %brbc exqe)]
- ==
- ==
- :- '$'
- ;~ pfix buc
- %- stew
- ^. stet ^. limo
- :~ ['@' (stag %ktcl (rune pat %bcpt exqb))]
- ['_' (stag %ktcl (rune cab %bccb expa))]
- [':' (stag %ktcl (rune col %bccl exqs))]
- ['%' (stag %ktcl (rune cen %bccn exqs))]
- ['<' (stag %ktcl (rune gal %bcgl exqb))]
- ['>' (stag %ktcl (rune gar %bcgr exqb))]
- ['|' (stag %ktcl (rune bar %bcbr exqc))]
- ['&' (stag %ktcl (rune pam %bcpm exqc))]
- ['^' (stag %ktcl (rune ket %bckt exqb))]
- ['~' (stag %ktcl (rune sig %bcsg exqd))]
- ['-' (stag %ktcl (rune hep %bchp exqb))]
- ['=' (stag %ktcl (rune tis %bcts exqg))]
- ['?' (stag %ktcl (rune wut %bcwt exqs))]
- ['+' (stag %ktcl (rune lus %bcls exqg))]
- ['.' (rune dot %kttr exqa)]
- [',' (rune com %ktcl exqa)]
- ==
- ==
- :- '%'
- ;~ pfix cen
- %- stew
- ^. stet ^. limo
- :~ ['_' (rune cab %cncb exph)]
- ['.' (rune dot %cndt expb)]
- ['^' (rune ket %cnkt expd)]
- ['+' (rune lus %cnls expc)]
- ['-' (rune hep %cnhp expb)]
- [':' (rune col %cncl expi)]
- ['~' (rune sig %cnsg expn)]
- ['*' (rune tar %cntr expm)]
- ['=' (rune tis %cnts exph)]
- ==
- ==
- :- ':'
- ;~ pfix col
- %- stew
- ^. stet ^. limo
- :~ ['_' (rune cab %clcb expb)]
- ['^' (rune ket %clkt expd)]
- ['+' (rune lus %clls expc)]
- ['-' (rune hep %clhp expb)]
- ['~' (rune sig %clsg exps)]
- ['*' (rune tar %cltr exps)]
- ==
- ==
- :- '.'
- ;~ pfix dot
- %- stew
- ^. stet ^. limo
- :~ ['+' (rune lus %dtls expa)]
- ['*' (rune tar %dttr expb)]
- ['=' (rune tis %dtts expb)]
- ['?' (rune wut %dtwt expa)]
- ['^' (rune ket %dtkt exqn)]
- ==
- ==
- :- '^'
- ;~ pfix ket
- %- stew
- ^. stet ^. limo
- :~ ['|' (rune bar %ktbr expa)]
- ['.' (rune dot %ktdt expb)]
- ['-' (rune hep %kthp exqc)]
- ['+' (rune lus %ktls expb)]
- ['&' (rune pam %ktpm expa)]
- ['~' (rune sig %ktsg expa)]
- ['=' (rune tis %ktts expj)]
- ['?' (rune wut %ktwt expa)]
- ['*' (rune tar %kttr exqa)]
- [':' (rune col %ktcl exqa)]
- ==
- ==
- :- '~'
- ;~ pfix sig
- %- stew
- ^. stet ^. limo
- :~ ['|' (rune bar %sgbr expb)]
- ['$' (rune buc %sgbc expf)]
- ['_' (rune cab %sgcb expb)]
- ['%' (rune cen %sgcn hind)]
- ['/' (rune fas %sgfs hine)]
- ['<' (rune gal %sggl hinb)]
- ['>' (rune gar %sggr hinb)]
- ['+' (rune lus %sgls hinc)]
- ['&' (rune pam %sgpm hinf)]
- ['?' (rune wut %sgwt hing)]
- ['=' (rune tis %sgts expb)]
- ['!' (rune zap %sgzp expb)]
- ==
- ==
- :- ';'
- ;~ pfix mic
- %- stew
- ^. stet ^. limo
- :~ [':' (rune col %mccl expi)]
- ['/' (rune fas %mcfs expa)]
- ['<' (rune gal %mcgl expz)]
- ['~' (rune sig %mcsg expi)]
- [';' (rune mic %mcmc exqc)]
- ==
- ==
- :- '='
- ;~ pfix tis
- %- stew
- ^. stet ^. limo
- :~ ['|' (rune bar %tsbr exqc)]
- ['.' (rune dot %tsdt expq)]
- ['?' (rune wut %tswt expw)]
- ['^' (rune ket %tskt expt)]
- [':' (rune col %tscl expp)]
- ['/' (rune fas %tsfs expo)]
- [';' (rune mic %tsmc expo)]
- ['<' (rune gal %tsgl expb)]
- ['>' (rune gar %tsgr expb)]
- ['-' (rune hep %tshp expb)]
- ['*' (rune tar %tstr expg)]
- [',' (rune com %tscm expb)]
- ['+' (rune lus %tsls expb)]
- ['~' (rune sig %tssg expi)]
- ==
- ==
- :- '?'
- ;~ pfix wut
- %- stew
- ^. stet ^. limo
- :~ ['|' (rune bar %wtbr exps)]
- [':' (rune col %wtcl expc)]
- ['.' (rune dot %wtdt expc)]
- ['<' (rune gal %wtgl expb)]
- ['>' (rune gar %wtgr expb)]
- ['-' ;~(pfix hep (toad txhp))]
- ['^' ;~(pfix ket (toad tkkt))]
- ['=' ;~(pfix tis (toad txts))]
- ['#' ;~(pfix hax (toad txhx))]
- ['+' ;~(pfix lus (toad txls))]
- ['&' (rune pam %wtpm exps)]
- ['@' ;~(pfix pat (toad tkvt))]
- ['~' ;~(pfix sig (toad tksg))]
- ['!' (rune zap %wtzp expa)]
- ==
- ==
- :- '!'
- ;~ pfix zap
- %- stew
- ^. stet ^. limo
- :~ [':' ;~(pfix col (toad expy))]
- ['.' ;~(pfix dot (toad |.(loaf(bug |))))]
- [',' (rune com %zpcm expb)]
- [';' (rune mic %zpmc expb)]
- ['>' (rune gar %zpgr expa)]
- ['<' (rune gal %zpgl exqc)]
- ['@' (rune pat %zppt expx)]
- ['=' (rune tis %zpts expa)]
- ['?' (rune wut %zpwt hinh)]
- ==
- ==
- ==
- ::
- ++ boog !:
- %+ knee [p=*whit q=*term r=*help s=*hoon]
- |.(~+((scye ;~(pose bola boba))))
- ++ bola :: ++ arms
- %+ knee [q=*term r=*help s=*hoon] |. ~+
- %+ cook
- |= [q=term r=whiz s=hoon]
- ?: =(r *whiz)
- [q *help s]
- [q [[%funk q]~ [r]~] s]
- ;~ pfix (jest '++')
- ;~ plug
- ;~(pfix gap ;~(pose (cold %$ buc) sym))
- apse:docs
- ;~(pfix jump loaf)
- ==
- ==
- ::TODO consider special casing $%
- ++ boba :: +$ arms
- %+ knee [q=*term r=*help s=*hoon] |. ~+
- %+ cook
- |= [q=term r=whiz s=spec]
- ?: =(r *whiz)
- [q *help [%ktcl %name q s]]
- [q [[%plan q]~ [r]~] [%ktcl %name q s]]
- ;~ pfix (jest '+$')
- ;~ plug
- ;~(pfix gap sym)
- apse:docs
- ;~(pfix jump loan)
- ==
- ==
- ::
- :: parses a or [a b c] or a b c ==
- ++ lynx
- =/ wid (ifix [sel ser] (most ace sym))
- =/ tal
- ;~ sfix
- (most gap sym)
- ;~(plug gap duz)
- ==
- =/ one
- %- cook :_ sym
- |= a=term
- `(list term)`~[a]
- %- cook
- :_ ;~(pose (runq wid tal) one)
- :: lestify
- |= a=(list term)
- ?~(a !! a)
- ::
- ++ whap !: :: chapter
- %+ cook
- |= a=(list (qual whit term help hoon))
- :: separate $helps into their own list to be passed to +glow
- =/ [duds=(list help) nude=(list (pair term hoon))]
- %+ roll a
- |= $: $= bog
- (qual whit term help hoon)
- ::
- $= gob
- [duds=(list help) nude=(list (pair term hoon))]
- ==
- =/ [unt=(list help) tag=(list help)]
- %+ skid ~(tap by bat.p.bog) |=(=help =(~ cuff.help))
- :- ?: =(*help r.bog)
- (weld tag duds.gob)
- [r.bog (weld tag duds.gob)]
- |-
- ?~ unt [[q.bog s.bog] nude.gob]
- =. s.bog [%note help/i.unt s.bog]
- $(unt t.unt)
- ::
- %+ glow duds
- |- ^- (map term hoon)
- ?~ nude ~
- =+ $(nude t.nude)
- %+ ~(put by -)
- p.i.nude
- ?: (~(has by -) p.i.nude)
- [%eror (weld "duplicate arm: +" (trip p.i.nude))]
- q.i.nude
- ::
- (most mush boog)
- ::
- :: +glow: moves batch comments to the correct arm
- ++ glow
- |= [duds=(list help) nude=(map term hoon)]
- ^- (map term hoon)
- |-
- ?~ duds nude
- :: if there is no link, its not part of a batch comment
- ?~ cuff.i.duds
- :: this shouldn't happen yet until we look for cuffs of length >1
- :: but we need to prove that cuff is nonempty anyways
- $(duds t.duds)
- ::
- ::TODO: look past the first link. this probably requires
- ::a major rethink on how batch comments work
- =/ nom=(unit term)
- ?+ i.cuff.i.duds ~
- :: we only support ++ and +$ batch comments right now
- ::
- ?([%funk *] [%plan *])
- `p.i.cuff.i.duds
- ==
- %= $
- duds t.duds
- nude ?~ nom nude
- ?. (~(has by nude) u.nom)
- :: ~> %slog.[0 leaf+"glow: unmatched link"]
- nude
- (~(jab by nude) u.nom |=(a=hoon [%note help+i.duds a]))
- ==
- ::
- ++ whip :: chapter declare
- %+ cook
- |= [[a=whit b=term c=whiz] d=(map term hoon)]
- ^- [whit (pair term (map term hoon))]
- ?. =(*whit a)
- [a b d]
- ?: =(*whiz c)
- [*whit b d]
- [%*(. *whit bat (malt [[%chat b]~ [c]~]~)) b d]
- ;~(plug (seam ;~(pfix (jest '+|') gap cen sym)) whap)
- ::
- ++ wasp :: $brcb aliases
- ;~ pose
- %+ ifix
- [;~(plug lus tar muck) muck]
- (most muck ;~(gunk sym loll))
- ::
- (easy ~)
- ==
- ::
- ++ wisp !: :: core tail
- ?. tol fail
- %+ cook
- |= a=(list [wit=whit wap=(pair term (map term hoon))])
- ^- (map term tome)
- =< p
- |- ^- (pair (map term tome) (map term hoon))
- ?~ a [~ ~]
- =/ mor $(a t.a)
- =. q.wap.i.a
- %- ~(urn by q.wap.i.a)
- |= b=(pair term hoon) ^+ +.b
- :: tests for duplicate arms between two chapters
- ?. (~(has by q.mor) p.b) +.b
- [%eror (weld "duplicate arm: +" (trip p.b))]
- :_ (~(uni by q.mor) q.wap.i.a)
- %+ ~(put by p.mor)
- p.wap.i.a
- :- %- ~(get by bat.wit.i.a)
- ?: (~(has by bat.wit.i.a) [%chat p.wap.i.a]~)
- [%chat p.wap.i.a]~
- ~
- ?. (~(has by p.mor) p.wap.i.a)
- q.wap.i.a
- [[%$ [%eror (weld "duplicate chapter: |" (trip p.wap.i.a))]] ~ ~]
- ::
- ::TODO: allow cores with unnamed chapter as well as named chapters?
- ;~ pose
- dun
- ;~ sfix
- ;~ pose
- (most mush whip)
- ;~(plug (stag *whit (stag %$ whap)) (easy ~))
- ==
- gap
- dun
- ==
- ==
- ::
- ::TODO: check parser performance
- ++ toad :: untrap parser expr
- |* har=_expa
- =+ dur=(ifix [pal par] $:har(tol |))
- ?. tol
- dur
- ;~(pose ;~(pfix jump $:har(tol &)) ;~(pfix gap $:har(tol &)) dur)
- ::
- ++ rune :: build rune
- |* [dif=rule tuq=* har=_expa]
- ;~(pfix dif (stag tuq (toad har)))
- ::
- ++ runo :: rune plus
- |* [dif=rule hil=* tuq=* har=_expa]
- ;~(pfix dif (stag hil (stag tuq (toad har))))
- ::
- ++ runq :: wide or tall if tol
- |* [wid=rule tal=rule] :: else wide
- ?. tol
- wid
- ;~(pose wid tal)
- ::
- ++ butt |* zor=rule :: closing == if tall
- ?:(tol ;~(sfix zor ;~(plug gap duz)) zor)
- ++ ulva |* zor=rule :: closing -- and tall
- ?.(tol fail ;~(sfix zor ;~(plug gap dun)))
- ++ glop ~+((glue mash)) :: separated by space
- ++ gunk ~+((glue muck)) :: separated list
- ++ goop ~+((glue mush)) :: separator list & docs
- ++ hank (most mush loaf) :: gapped hoons
- ++ hunk (most mush loan) :: gapped specs
- ++ jump ;~(pose leap:docs gap) :: gap before docs
- ++ loaf ?:(tol tall wide) :: hoon
- ++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs
- ++ loan ?:(tol till wyde) :: spec
- ++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin
- ++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name
- ++ mash ?:(tol gap ;~(plug com ace)) :: list separator
- ++ muss ?:(tol jump ;~(plug com ace)) :: list w/ doccords
- ++ muck ?:(tol gap ace) :: general separator
- ++ mush ?:(tol jump ace) :: separator w/ docs
- ++ teak %+ knee *tiki |. ~+ :: wing or hoon
- =+ ^= gub
- |= [a=term b=$%([%& p=wing] [%| p=hoon])]
- ^- tiki
- ?-(-.b %& [%& [~ a] p.b], %| [%| [~ a] p.b])
- =+ ^= wyp
- ;~ pose
- %+ cook gub
- ;~ plug
- sym
- ;~(pfix tis ;~(pose (stag %& rope) (stag %| wide)))
- ==
- ::
- (stag %& (stag ~ rope))
- (stag %| (stag ~ wide))
- ==
- ?. tol wyp
- ;~ pose
- wyp
- ::
- ;~ pfix
- ;~(plug ket tis gap)
- %+ cook gub
- ;~ plug
- sym
- ;~(pfix gap ;~(pose (stag %& rope) (stag %| tall)))
- ==
- ==
- ::
- (stag %| (stag ~ tall))
- ==
- ++ rack (most muss ;~(goop loaf loaf)) :: list [hoon hoon]
- ++ ruck (most muss ;~(goop loan loaf)) :: list [spec hoon]
- ++ rick (most mash ;~(goop rope loaf)) :: list [wing hoon]
- :: hoon contents
- ::
- ++ expa |.(loaf) :: one hoon
- ++ expb |.(;~(goop loaf loaf)) :: two hoons
- ++ expc |.(;~(goop loaf loaf loaf)) :: three hoons
- ++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons
- ++ expe |.(wisp) :: core tail
- ++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon
- ++ expg |.(;~(gunk lomp loll loaf)) :: term/spec, two hoons
- ++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s
- ++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons
- ++ expj |.(;~(goop lore loaf)) :: skin and hoon
- :: ++ expk |.(;~(gunk loaf ;~(plug loaf (easy ~)))):: list of two hoons
- :: ++ expl |.(;~(gunk sym loaf loaf)) :: term, two hoons
- ++ expm |.((butt ;~(gunk rope loaf rick))) :: several [spec hoon]s
- ++ expn |. ;~ gunk rope loaf :: wing, hoon,
- ;~(plug loaf (easy ~)) :: list of one hoon
- == ::
- ++ expo |.(;~(goop wise loaf loaf)) :: =;
- ++ expp |.(;~(goop (butt rick) loaf)) :: [wing hoon]s, hoon
- ++ expq |.(;~(goop rope loaf loaf)) :: wing and two hoons
- ++ expr |.(;~(goop loaf wisp)) :: hoon and core tail
- ++ exps |.((butt hank)) :: closed gapped hoons
- ++ expt |.(;~(gunk wise rope loaf loaf)) :: =^
- ++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, hoon, hoons
- :: ++ expv |.((butt rick)) :: just changes
- ++ expw |.(;~(goop rope loaf loaf loaf)) :: wing and three hoons
- ++ expx |.(;~(goop ropa loaf loaf)) :: wings and two hoons
- ++ expy |.(loaf(bug &)) :: hoon with tracing
- ++ expz |.(;~(goop loan loaf loaf loaf)) :: spec and three hoons
- :: spec contents
- ::
- ++ exqa |.(loan) :: one spec
- ++ exqb |.(;~(goop loan loan)) :: two specs
- ++ exqc |.(;~(goop loan loaf)) :: spec then hoon
- ++ exqd |.(;~(goop loaf loan)) :: hoon then spec
- ++ exqe |.(;~(goop lynx loan)) :: list of names then spec
- ++ exqs |.((butt hunk)) :: closed gapped specs
- ++ exqg |.(;~(goop sym loan)) :: term and spec
- ::++ exqk |.(;~(goop loaf ;~(plug loan (easy ~)))):: hoon with one spec
- ++ exqn |.(;~(gunk loan (stag %cltr (butt hank)))):: autoconsed hoons
- ++ exqr |.(;~(gunk loan ;~(plug wasp wisp))) :: spec/aliases?/tail
- ::++ exqw |.(;~(goop loaf loan)) :: hoon and spec
- ++ exqx |.(;~(goop loaf loan loan)) :: hoon, two specs
- ++ exqy |.(;~(goop loaf loan loan loan)) :: hoon, three specs
- ++ exqz |.(;~(goop loaf (butt hunk))) :: hoon, n specs
- ::
- :: tiki expansion for %wt runes
- ::
- ++ txhp |. %+ cook |= [a=tiki b=(list (pair spec hoon))]
- (~(wthp ah a) b)
- (butt ;~(gunk teak ruck))
- ++ tkkt |. %+ cook |= [a=tiki b=hoon c=hoon]
- (~(wtkt ah a) b c)
- ;~(gunk teak loaf loaf)
- ++ txls |. %+ cook |= [a=tiki b=hoon c=(list (pair spec hoon))]
- (~(wtls ah a) b c)
- (butt ;~(gunk teak loaf ruck))
- ++ tkvt |. %+ cook |= [a=tiki b=hoon c=hoon]
- (~(wtpt ah a) b c)
- ;~(gunk teak loaf loaf)
- ++ tksg |. %+ cook |= [a=tiki b=hoon c=hoon]
- (~(wtsg ah a) b c)
- ;~(gunk teak loaf loaf)
- ++ txts |. %+ cook |= [a=spec b=tiki]
- (~(wtts ah b) a)
- ;~(gunk loan teak)
- ++ txhx |. %+ cook |= [a=skin b=tiki]
- (~(wthx ah b) a)
- ;~(gunk lore teak)
- ::
- :: hint syntax
- ::
- ++ hinb |.(;~(goop bont loaf)) :: hint and hoon
- ++ hinc |. :: optional =en, hoon
- ;~(pose ;~(goop bony loaf) (stag ~ loaf)) ::
- ++ hind |.(;~(gunk bonk loaf ;~(goop bonz loaf))) :: jet hoon "bon"s hoon
- ++ hine |.(;~(goop bonk loaf)) :: jet-hint and hoon
- ++ hinf |. :: 0-3 >s, two hoons
- ;~ pose
- ;~(goop (cook lent (stun [1 3] gar)) loaf loaf)
- (stag 0 ;~(goop loaf loaf))
- ==
- ++ hing |. :: 0-3 >s, three hoons
- ;~ pose
- ;~(goop (cook lent (stun [1 3] gar)) loaf loaf loaf)
- (stag 0 ;~(goop loaf loaf loaf))
- ==
- ++ bonk :: jet signature
- ;~ pfix cen
- ;~ pose
- ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot ;~(pfix dot dem)))))
- ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot dem))))
- ;~(plug sym ;~(pfix dot dem))
- sym
- ==
- ==
- ++ hinh |. :: 1/2 numbers, hoon
- ;~ goop
- ;~ pose
- dem
- (ifix [sel ser] ;~(plug dem ;~(pfix ace dem)))
- ==
- loaf
- ==
- ++ bont ;~ (bend) :: term, optional hoon
- ;~(pfix cen sym)
- ;~(pfix dot ;~(pose wide ;~(pfix muck loaf)))
- ==
- ++ bony (cook |=(a=(list) (lent a)) (plus tis)) :: base 1 =en count
- ++ bonz :: term-labelled hoons
- ;~ pose
- (cold ~ sig)
- %+ ifix
- ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pal par])
- (more mash ;~(gunk ;~(pfix cen sym) loaf))
- ==
- --
- ::
- ++ lang :: lung sample
- $: ros=hoon
- $= vil
- $% [%tis p=hoon]
- [%col p=hoon]
- [%ket p=hoon]
- [%lit p=(list (pair wing hoon))]
- ==
- ==
- ::
- ++ lung
- ~+
- %- bend
- |: $:lang
- ^- (unit hoon)
- ?- -.vil
- %col ?:(=([%base %flag] ros) ~ [~ %tsgl ros p.vil])
- %lit (bind ~(reek ap ros) |=(hyp=wing [%cnts hyp p.vil]))
- %ket [~ ros p.vil]
- %tis =+ rud=~(flay ap ros)
- ?~(rud ~ `[%ktts u.rud p.vil])
- ==
- ::
- ++ long
- %+ knee *hoon |. ~+
- ;~ lung
- scat
- ;~ pose
- ;~(plug (cold %tis tis) wide)
- ;~(plug (cold %col col) wide)
- ;~(plug (cold %ket ket) wide)
- ;~ plug
- (easy %lit)
- (ifix [pal par] lobo)
- ==
- ==
- ==
- ::
- ++ lobo (most ;~(plug com ace) ;~(glam rope wide))
- ++ loon (most ;~(plug com ace) ;~(glam wide wide))
- ++ lute :: tall [] noun
- ~+
- %+ cook |=(hoon +<)
- %+ stag %cltr
- %+ ifix
- [;~(plug sel gap) ;~(plug gap ser)]
- (most gap tall)
- ::
- ++ ropa (most col rope)
- ++ rope :: wing form
- %+ knee *wing
- |. ~+
- %+ (slug |=([a=limb b=wing] [a b]))
- dot
- ;~ pose
- (cold [%| 0 ~] com)
- %+ cook
- |=([a=(list) b=term] ?~(a b [%| (lent a) `b]))
- ;~(plug (star ket) ;~(pose sym (cold %$ buc)))
- ::
- %+ cook
- |=(a=axis [%& a])
- ;~ pose
- ;~(pfix lus dim:ag)
- ;~(pfix pam (cook |=(a=@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag))
- ;~(pfix bar (cook |=(a=@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag))
- ven
- (cold 1 dot)
- ==
- ==
- ::
- ++ wise
- ;~ pose
- ;~ pfix tis
- %+ sear
- |= =spec
- ^- (unit skin)
- %+ bind ~(autoname ax spec)
- |= =term
- [%name term %spec spec %base %noun]
- wyde
- ==
- ::
- %+ cook
- |= [=term =(unit spec)]
- ^- skin
- ?~ unit
- term
- [%name term %spec u.unit %base %noun]
- ;~ plug sym
- (punt ;~(pfix ;~(pose fas tis) wyde))
- ==
- ::
- %+ cook
- |= =spec
- ^- skin
- [%spec spec %base %noun]
- wyde
- ==
- ::
- ++ tall :: full tall form
- %+ knee *hoon
- |.(~+((wart (clad ;~(pose expression:(norm &) long lute apex:(sail &))))))
- ++ till :: mold tall form
- %+ knee *spec
- |.(~+((wert (coat ;~(pose structure:(norm &) scad)))))
- ++ wede :: wide bulb
- :: XX: lus deprecated
- ::
- ;~(pfix ;~(pose lus fas) wide)
- ++ wide :: full wide form
- %+ knee *hoon
- |.(~+((wart ;~(pose expression:(norm |) long apex:(sail |)))))
- ++ wyde :: mold wide form
- %+ knee *spec
- |.(~+((wert ;~(pose structure:(norm |) scad))))
- ++ wart
- |* zor=rule
- %+ here
- |= [a=pint b=hoon]
- ?:(bug [%dbug [wer a] b] b)
- zor
- ++ wert
- |* zor=rule
- %+ here
- |= [a=pint b=spec]
- ?:(bug [%dbug [wer a] b] b)
- zor
- --
- ::
- ++ vest
- ~/ %vest
- |= tub=nail
- ^- (like hoon)
- %. tub
- %- full
- (ifix [gay gay] tall:vast)
- ::
- ++ vice
- |= txt=@ta
- ^- hoon
- (rash txt wide:vast)
- ::
- ++ make :: compile cord to nock
- |= txt=@
- q:(~(mint ut %noun) %noun (ream txt))
- ::
- ++ rain :: parse with % path
- |= [bon=path txt=@]
- ^- hoon
- =+ vaz=vast
- ~| bon
- (scan (trip txt) (full (ifix [gay gay] tall:vaz(wer bon))))
- ::
- ++ ream :: parse cord to hoon
- |= txt=@
- ^- hoon
- (rash txt vest)
- ::
- ++ reck :: parse hoon file
- |= bon=path
- (rain bon .^(@t %cx (weld bon `path`[%hoon ~])))
- ::
- ++ ride :: end-to-end compiler
- |= [typ=type txt=@]
- ^- (pair type nock)
- ~> %slog.[0 leaf/"ride: parsing"]
- =/ gen (ream txt)
- ~> %slog.[0 leaf/"ride: compiling"]
- ~< %slog.[0 leaf/"ride: compiled"]
- (~(mint ut typ) %noun gen)
- ::
- :: 5e: molds and mold builders
- +| %molds-and-mold-builders
- ::
- +$ mane $@(@tas [@tas @tas]) :: XML name+space
- +$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
- +$ marl (list manx) :: XML node list
- +$ mars [t=[n=%$ a=[i=[n=%$ v=tape] t=~]] c=~] :: XML cdata
- +$ mart (list [n=mane v=tape]) :: XML attributes
- +$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
- +$ mite (list @ta) :: mime type
- +$ pass @ :: public key
- +$ ring @ :: private key
- +$ ship @p :: network identity
- +$ shop (each ship (list @ta)) :: urbit/dns identity
- +$ spur path :: ship desk case spur
- +$ time @da :: galactic time
- ::
- :: 5f: profiling support (XX move)
- +| %profiling-support
- ::
- ++ pi-heck
- |= [nam=@tas day=doss]
- ^- doss
- =+ lam=(~(get by hit.day) nam)
- day(hit (~(put by hit.day) nam ?~(lam 1 +(u.lam))))
- ::
- ++ pi-noon :: sample trace
- |= [mot=term paz=(list path) day=doss]
- =| lax=(unit path)
- |- ^- doss
- ?~ paz day(mon (pi-mope mot mon.day))
- %= $
- paz t.paz
- lax `i.paz
- cut.day
- %+ ~(put by cut.day) i.paz
- ^- hump
- =+ nax=`(unit path)`?~(t.paz ~ `i.t.paz)
- =+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~]))
- :+ (pi-mope mot mon.hup)
- ?~ lax out.hup
- =+ hag=(~(get by out.hup) u.lax)
- (~(put by out.hup) u.lax ?~(hag 1 +(u.hag)))
- ?~ nax inn.hup
- =+ hag=(~(get by inn.hup) u.nax)
- (~(put by inn.hup) u.nax ?~(hag 1 +(u.hag)))
- ==
- ++ pi-mope :: add sample
- |= [mot=term mon=moan]
- ?+ mot mon
- %fun mon(fun +(fun.mon))
- %noc mon(noc +(noc.mon))
- %glu mon(glu +(glu.mon))
- %mal mon(mal +(mal.mon))
- %far mon(far +(far.mon))
- %coy mon(coy +(coy.mon))
- %euq mon(euq +(euq.mon))
- ==
- ++ pi-moth :: count sample
- |= mon=moan ^- @ud
- :(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon)
- ::
- ++ pi-mumm :: print sample
- |= mon=moan ^- tape
- =+ tot=(pi-moth mon)
- ;: welp
- ^- tape
- ?: =(0 noc.mon) ~
- (welp (scow %ud (div (mul 100 noc.mon) tot)) "n ")
- ::
- ^- tape
- ?: =(0 fun.mon) ~
- (welp (scow %ud (div (mul 100 fun.mon) tot)) "c ")
- ::
- ^- tape
- ?: =(0 glu.mon) ~
- (welp (scow %ud (div (mul 100 glu.mon) tot)) "g ")
- ::
- ^- tape
- ?: =(0 mal.mon) ~
- (welp (scow %ud (div (mul 100 mal.mon) tot)) "m ")
- ::
- ^- tape
- ?: =(0 far.mon) ~
- (welp (scow %ud (div (mul 100 far.mon) tot)) "f ")
- ::
- ^- tape
- ?: =(0 coy.mon) ~
- (welp (scow %ud (div (mul 100 coy.mon) tot)) "y ")
- ::
- ^- tape
- ?: =(0 euq.mon) ~
- (welp (scow %ud (div (mul 100 euq.mon) tot)) "e ")
- ==
- ::
- ++ pi-tell :: produce dump
- |= day=doss
- ^- (list tape)
- ?: =(day *doss) ~
- =+ tot=(pi-moth mon.day)
- ;: welp
- [(welp "events: " (pi-mumm mon.day)) ~]
- ::
- %+ turn
- %+ sort ~(tap by hit.day)
- |= [a=[* @] b=[* @]]
- (lth +.a +.b)
- |= [nam=term num=@ud]
- :(welp (trip nam) ": " (scow %ud num))
- ["" ~]
- ::
- %- zing
- ^- (list (list tape))
- %+ turn
- %+ sort ~(tap by cut.day)
- |= [one=(pair path hump) two=(pair path hump)]
- (gth (pi-moth mon.q.one) (pi-moth mon.q.two))
- |= [pax=path hup=hump]
- =+ ott=(pi-moth mon.hup)
- ;: welp
- [(welp "label: " (spud pax)) ~]
- [(welp "price: " (scow %ud (div (mul 100 ott) tot))) ~]
- [(welp "shape: " (pi-mumm mon.hup)) ~]
- ::
- ?: =(~ out.hup) ~
- :- "into:"
- %+ turn
- %+ sort ~(tap by out.hup)
- |=([[* a=@ud] [* b=@ud]] (gth a b))
- |= [pax=path num=@ud]
- ^- tape
- :(welp " " (spud pax) ": " (scow %ud num))
- ::
- ?: =(~ inn.hup) ~
- :- "from:"
- %+ turn
- %+ sort ~(tap by inn.hup)
- |=([[* a=@ud] [* b=@ud]] (gth a b))
- |= [pax=path num=@ud]
- ^- tape
- :(welp " " (spud pax) ": " (scow %ud num))
- ::
- ["" ~]
- ~
- ==
- ==
- --
|