degen.hoon 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369
  1. :: XX this whole thing is a mess and needs one more rewrite
  2. /- *sock
  3. /- *gene
  4. /+ ska
  5. =| burg=town
  6. |%
  7. ++ vent
  8. |= barn
  9. [sub for 1 %vent]
  10. ++ dole
  11. |= barn
  12. [sub for 1 %dole]
  13. ++ mill :: XX todo observe crashes
  14. =* this .
  15. |= [ject=* gist=barn]
  16. ^- [* _this]
  17. =| quay=(list [curb=berm sign=(map @ *) vale=@])
  18. =^ [goes=lake uses=pool rump=@] this (belt gist)
  19. =/ sign (~(put by *(map @ *)) rump ject)
  20. =/ reed (~(got by goes) (vent gist))
  21. |^ ^- [* _this]
  22. ?~ body.reed
  23. ?- -.bend.reed
  24. %clq
  25. ?@ (loan +<.bend.reed)
  26. (lump +>+.bend.reed)
  27. (lump +>-.bend.reed)
  28. ::
  29. %eqq
  30. ~! +<.bend.reed
  31. ~! +>-.bend.reed
  32. ?: =((loan +<.bend.reed) (loan +>-.bend.reed))
  33. (lump +>+<.bend.reed)
  34. (lump +>+>.bend.reed)
  35. ::
  36. %brn
  37. ?: =(0 (loan +<.bend.reed))
  38. (lump +>-.bend.reed)
  39. ?: =(1 (loan +<.bend.reed))
  40. (lump +>+.bend.reed)
  41. ~| %bad-bean !!
  42. ::
  43. %hop (lump +.bend.reed)
  44. %lnk
  45. =/ gunk `barn`[[%toss ~] (loan +<.bend.reed)]
  46. =^ [goop=lake ruse=pool rump=@] this
  47. (belt [%toss ~] (loan +<.bend.reed))
  48. %= $
  49. quay [[+>+>.bend.reed sign +>+<.bend.reed] quay]
  50. goes goop
  51. sign (lend +>-.bend.reed rump)
  52. ==
  53. ::
  54. %cal
  55. =/ [goop=lake ruse=pool rump=@] does:(~(got by land.burg) +<.bend.reed)
  56. %= $
  57. quay [[+>+>.bend.reed sign +>+<.bend.reed] quay]
  58. goes goop
  59. sign (yoke +>-.bend.reed ruse)
  60. reed (~(got by goop) (vent +<.bend.reed))
  61. ==
  62. ::
  63. %bec ~| %bec-slip !!
  64. %lnt
  65. =^ [goop=lake ruse=pool rump=@] this
  66. (belt [%toss ~] (loan +<.bend.reed))
  67. ~! +>.bend.reed
  68. %= $
  69. goes goop
  70. sign (lend +>.bend.reed rump)
  71. ==
  72. ::
  73. %jmp
  74. =/ [goop=lake ruse=pool rump=@] does:(~(got by land.burg) +<.bend.reed)
  75. %= $
  76. goes goop
  77. sign (yoke +>.bend.reed ruse)
  78. ==
  79. ::
  80. %eye ~| %eye-slip !!
  81. %spy ~| %fbi !!
  82. %hnt ?>((~(has by sign) +<.bend.reed) (lump +>.bend.reed))
  83. %don
  84. ?~ quay [(loan +.bend.reed) this]
  85. =/ rail [sub for]:curb.i.quay
  86. =/ [goop=lake ruse=pool bump=@] does:(~(got by land.burg) rail)
  87. %= $
  88. sign (~(put by sign.i.quay) vale.i.quay (loan +.bend.reed))
  89. goes goop
  90. reed ~|(%miss-entry (~(got by goes) curb.i.quay))
  91. quay t.quay
  92. ==
  93. ::
  94. %bom
  95. ~| %boom !!
  96. ==
  97. %= $
  98. body.reed t.body.reed
  99. sign
  100. %- ~(put by sign)
  101. ?- -.i.body.reed
  102. %imm [+> +<]:i.body.reed
  103. %mov
  104. :- +>.i.body.reed
  105. (loan +<.i.body.reed)
  106. ::
  107. %inc
  108. :- +>.i.body.reed
  109. =/ bink (loan +<.i.body.reed)
  110. ?> ?=(@ bink)
  111. .+(bink)
  112. ::
  113. %unc
  114. :- +>.i.body.reed
  115. =/ bink (loan +<.i.body.reed)
  116. ?> ?=(@ bink)
  117. .+(bink)
  118. ::
  119. %con
  120. :- +>+.i.body.reed
  121. :- (loan +<.i.body.reed)
  122. (loan +>-.i.body.reed)
  123. ::
  124. %hed
  125. =/ cash (loan +<.i.body.reed)
  126. ?> ?=(^ cash)
  127. [+>.i.body.reed -.cash]
  128. ::
  129. %hud
  130. =/ cash (loan +<.i.body.reed)
  131. ?> ?=(^ cash)
  132. [+>.i.body.reed -.cash]
  133. ::
  134. %tal
  135. =/ cash (loan +<.i.body.reed)
  136. ?> ?=(^ cash)
  137. [+>.i.body.reed +.cash]
  138. ::
  139. %tul
  140. =/ cash (loan +<.i.body.reed)
  141. ?> ?=(^ cash)
  142. [+>.i.body.reed +.cash]
  143. ==
  144. ==
  145. ++ loan
  146. |= @
  147. ~| %loan-miss (~(got by sign) +<)
  148. ++ lend
  149. |= [src=@ dst=@]
  150. ^- _sign
  151. (~(put by `_sign`~) dst (loan src))
  152. ++ lump
  153. |= berm
  154. ^$(reed ~|(%miss-entry (~(got by goes) +<)))
  155. ++ yoke
  156. |= [ox=(list @) lo=pool]
  157. =| link=(map @ *)
  158. |- ^- (map @ *)
  159. ?~ ox
  160. ?~ lo link
  161. ~| %yoke-match !!
  162. ?~ lo
  163. ~| %yoke-match !!
  164. $(link (~(put by link) ssa.i.lo (loan i.ox)), ox t.ox, lo t.lo)
  165. --
  166. ++ belt
  167. =* this .
  168. |= gist=barn
  169. ^- [rice _this]
  170. =. this +:(reap gist)
  171. :_ this
  172. does:(~(got by land.burg) gist)
  173. ++ reap
  174. =* this .
  175. |= =barn
  176. ^- [boot _this]
  177. =/ [=boot =farm] (plot barn)
  178. =^ work this (till farm)
  179. :- boot
  180. (weed:(rake:this work) work)
  181. ++ plot :: subject knowledge analysis, emitting nock-- or "nomm"
  182. =* this .
  183. =| ski=farm
  184. |= ent=barn
  185. ^- [boot farm]
  186. =/ bot (~(get by land.burg) ent)
  187. ?. ?=(~ bot) [says.u.bot ski] :: no need to re-plot a barn we already know
  188. =/ ext (~(get by yard.ski) ent)
  189. ?. ?=(~ ext) [says.u.ext ski]
  190. =; [res=[does=nomm says=boot:ska] sku=farm]
  191. [says.res sku(yard (~(put by yard.sku) ent res), wood [ent wood.sku])]
  192. :: blackhole, guard recursion
  193. =. ski ski(yard (~(put by yard.ski) ent [[%zer 0 %.n] [%risk %toss ~]]))
  194. |- ^- [[does=nomm says=boot:ska] farm]
  195. =<
  196. ?+ for.ent bomb
  197. [[* *] *]
  198. =^ [doth=nomm sath=boot:ska] ski $(for.ent -.for.ent)
  199. ?: ?=([%boom ~] sath) bomb
  200. =^ [toes=nomm tays=boot:ska] ski $(for.ent +.for.ent)
  201. ?: ?=([%boom ~] tays) bomb
  202. :_ ski
  203. :_ (cobb:ska sath tays)
  204. [%par doth toes]
  205. ::
  206. [%0 @]
  207. :: we can decompose the axis into two axes, a safe axis which can
  208. :: be implemented unchecked, and an unsafe axis which must be
  209. :: checked. We then compose these two axes into safe %zer and
  210. :: unsafe %zer composed by %sev
  211. =+ [saf rik ken]=(punt:ska +.for.ent sub.ent)
  212. ?: =(0 saf) bomb
  213. :_ ski
  214. ?: =(1 rik) [[%zer saf %.y] [%safe ken]]
  215. ?: =(1 saf) [[%zer rik %.n] [%risk ken]]
  216. :_ [%risk ken]
  217. [%sev [%zer saf %.y] [%zer rik %.n]]
  218. ::
  219. [%1 *]
  220. :_ ski
  221. :_ [%safe %know +.for.ent]
  222. [%one +.for.ent]
  223. ::
  224. [%2 * *]
  225. =^ [dost=nomm sass=boot:ska] ski $(for.ent +<.for.ent)
  226. ?: ?=([%boom ~] sass) bomb
  227. =^ [doff=nomm faff=boot:ska] ski $(for.ent +>.for.ent)
  228. ?: ?=([%boom ~] faff) bomb
  229. =/ skun
  230. ?- sass
  231. [%safe *] sure.sass
  232. [%risk *] hope.sass
  233. ==
  234. ?: ?=([%safe %know *] faff)
  235. =^ ret ski ^$(ent [skun know.sure.faff])
  236. :_ ski
  237. :_ ?: ?=([%safe *] sass) ret (dare:ska ret)
  238. [%two dost doff skun (some know.sure.faff) %.y]
  239. ?: ?=([%risk %know *] faff)
  240. =^ ret ski ^$(ent [skun know.hope.faff])
  241. :_ ski
  242. :_ (dare:ska ret)
  243. [%two dost doff skun (some know.hope.faff) %.n]
  244. :_ ski
  245. :_ [%risk %toss ~]
  246. [%two dost doff skun ~ %.n]
  247. ::
  248. [%3 *]
  249. =^ [deft=nomm koob=boot:ska] ski $(for.ent +.for.ent)
  250. ?: ?=([%boom ~] koob) bomb
  251. :_ ski
  252. :_ (ques:ska koob)
  253. [%thr deft]
  254. ::
  255. [%4 *]
  256. =^ [dink=nomm sink=boot:ska] ski $(for.ent +.for.ent)
  257. ?: ?=([%boom ~] sink) bomb
  258. =/ rink
  259. ?- sink
  260. [%safe *] sure.sink
  261. [%risk *] hope.sink
  262. ==
  263. :_ ski
  264. :_ (pile:ska sink)
  265. [%fou dink ?|(?=([%dice ~] rink) ?=([%flip ~] rink) ?=([%know @] rink))]
  266. ::
  267. [%5 * *]
  268. =^ [dome=nomm foam=boot:ska] ski $(for.ent +<.for.ent)
  269. ?: ?=([%boom ~] foam) bomb
  270. =^ [doot=nomm foot=boot:ska] ski $(for.ent +>.for.ent)
  271. ?: ?=([%boom ~] foot) bomb
  272. :_ ski
  273. :_ (bopp:ska foam foot)
  274. [%fiv dome doot]
  275. ::
  276. [%6 * * *]
  277. =^ [dawn=nomm sond=boot:ska] ski $(for.ent +<.for.ent)
  278. ?: ?=([%safe %know %0] sond) $(for.ent +>-.for.ent)
  279. ?: ?=([%safe %know %1] sond) $(for.ent +>+.for.ent)
  280. ?: ?=([%safe %know *] sond) bomb
  281. ?: ?=([%safe %bets *] sond) bomb
  282. ?: ?=([%safe %flip ~] sond)
  283. =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent)
  284. =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent)
  285. :_ ski
  286. :_ (gnaw:ska slew song)
  287. [%six dawn drew darn]
  288. ?: ?=([%risk %know %0] sond)
  289. =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent)
  290. :_ ski
  291. :_ (dare:ska slew)
  292. :: run dawn in case it crashes, but throw it away
  293. [%sev [%par dawn drew] [%zer 3 %.y]]
  294. ?: ?=([%risk %know %1] sond)
  295. =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent)
  296. :_ ski
  297. :_ (dare:ska song)
  298. :: run dawn in case it crashes, but throw it away
  299. [%sev [%par dawn darn] [%zer 3 %.y]]
  300. ?: ?=([%risk %know *] sond) bomb
  301. ?: ?=([%risk %bets *] sond) bomb
  302. =^ [drew=nomm slew=boot:ska] ski $(for.ent +>-.for.ent)
  303. =^ [darn=nomm song=boot:ska] ski $(for.ent +>+.for.ent)
  304. :_ ski
  305. :_ (dare:ska (gnaw:ska slew song))
  306. [%six dawn drew darn]
  307. ::
  308. [%7 * *]
  309. =^ [deck=nomm keck=boot:ska] ski $(for.ent +<.for.ent)
  310. ?: ?=([%boom ~] keck) bomb
  311. =/ news
  312. ?- keck
  313. [%safe *] sure.keck
  314. [%risk *] hope.keck
  315. ==
  316. =^ [dest=nomm zest=boot:ska] ski $(sub.ent news, for.ent +>.for.ent)
  317. ?: ?=([%boom ~] zest) bomb
  318. :_ ski
  319. :_ ?: ?=([%safe *] keck) zest (dare:ska zest)
  320. [%sev deck dest]
  321. ::
  322. [%8 * *]
  323. =^ [pink=nomm pest=boot:ska] ski $(for.ent +<.for.ent)
  324. ?: ?=([%boom ~] pest) bomb
  325. =/ nest
  326. ?- pest
  327. [%safe *] sure.pest
  328. [%risk *] hope.pest
  329. ==
  330. =^ [dest=nomm zest=boot:ska] ski
  331. $(sub.ent (knit:ska nest sub.ent), for.ent +>.for.ent)
  332. ?: ?=([%boom ~] zest) bomb
  333. :_ ski
  334. :_ ?: ?=([%safe *] pest)
  335. zest
  336. (dare:ska zest)
  337. [%sev [%par pink %zer 1 %.y] dest]
  338. ::
  339. [%9 @ *]
  340. =^ [lore=nomm sore=boot:ska] ski $(for.ent +>.for.ent)
  341. ?: ?=([%boom ~] sore) bomb
  342. =/ news
  343. ?- sore
  344. [%safe *] sure.sore
  345. [%risk *] hope.sore
  346. ==
  347. =/ fork (pull:ska +<.for.ent news)
  348. ?: ?=([%safe %know *] fork)
  349. =^ ret ski ^$(ent [news know.sure.fork])
  350. :_ ski
  351. :_ ?: ?=([%safe *] sore)
  352. ret
  353. (dare:ska ret)
  354. [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent %.y] news (some know.sure.fork) %.y]]
  355. ?: ?=([%risk %know *] fork)
  356. =^ ret ski ^$(ent [news know.hope.fork])
  357. :_ ski
  358. :_ (dare:ska ret)
  359. [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent %.n] news (some know.hope.fork) %.n]]
  360. :_ ski
  361. :_ [%risk %toss ~]
  362. [%sev lore [%two [%zer 1 %.y] [%zer +<.for.ent ?=(%safe -.fork)] news ~ ?=(%safe -.fork)]]
  363. ::
  364. [%10 [@ *] *]
  365. =^ [neat=nomm seat=boot:ska] ski $(for.ent +>.for.ent)
  366. ?: ?=([%boom ~] seat) bomb
  367. =^ [pace=nomm spat=boot:ska] ski $(for.ent +<+.for.ent)
  368. ?: ?=([%boom ~] spat) bomb
  369. =/ teak
  370. ?- seat
  371. [%safe *] sure.seat
  372. [%risk *] hope.seat
  373. ==
  374. =+ [saf rik ken]=(punt:ska +<-.for.ent teak)
  375. ?: =(0 saf) bomb
  376. :_ ski
  377. :_ (welt:ska +<-.for.ent spat seat)
  378. ?: =(1 rik)
  379. [%ten [+<-.for.ent pace] neat %.y]
  380. ^- nomm
  381. :+ %sev [%par neat pace]
  382. :+ %ten
  383. [saf %ten [rik %zer 3 %.n] [%zer (peg saf 2) %.y] %.y]
  384. [[%zer 2 %.y] %.y]
  385. ::
  386. [%11 @ *]
  387. =^ [real=nomm seal=boot:ska] ski $(for.ent +>.for.ent)
  388. ?: ?=([%boom ~] seal) bomb
  389. ^- [[does=nomm says=boot:ska] farm]
  390. [[[%els +<.for.ent real] seal] ski]
  391. ::
  392. [%11 [@ *] *]
  393. =^ [fake=nomm sake=boot:ska] ski $(for.ent +<+.for.ent)
  394. ?: ?=([%boom ~] sake) bomb
  395. =^ [real=nomm seal=boot:ska] ski $(for.ent +>.for.ent)
  396. ?: ?=([%boom ~] seal) bomb
  397. :_ ski
  398. ?: ?=([%safe *] sake)
  399. [[%eld [+<-.for.ent fake] real %.y] seal]
  400. [[%eld [+<-.for.ent fake] real %.n] seal]
  401. ::
  402. [%12 * *]
  403. =^ [fear=nomm sear=boot:ska] ski $(for.ent +<.for.ent)
  404. ?: ?=([%boom ~] sear) bomb
  405. =^ [pack=nomm sack=boot:ska] ski $(for.ent +>.for.ent)
  406. ?: ?=([%boom ~] sack) bomb
  407. :_ ski
  408. :_ [%risk %toss ~]
  409. [%twe fear pack]
  410. ==
  411. |%
  412. ++ bomb
  413. ^- [[nomm boot:ska] farm]
  414. [[[%zer 0 %.n] [%boom ~]] ski]
  415. --
  416. ++ till
  417. =* this .
  418. |= =farm
  419. ^- [(list barn) _this]
  420. =/ work (flop (skip wood.farm ~(has by land.burg)))
  421. :- work
  422. |- ^- _this
  423. ?~ work this
  424. =/ next i.work
  425. =+ ~| %next-miss (~(got by yard.farm) next)
  426. :: now we have the nock-- in does
  427. =/ dock [lamb=lamb.burg lake=*lake]
  428. =| flow=line
  429. =/ axle=@ 1
  430. =/ fawn does
  431. |^
  432. =- =. lamb.burg lamb.dock
  433. =. land.burg
  434. %+ ~(put by land.burg) next
  435. =/ flue (~(got by lake.dock) her)
  436. :_ says
  437. ~| ~(key by lake.dock)
  438. =. lake.dock (~(put by (~(del by lake.dock) her)) (vent next) flue)
  439. ~| ~(key by lake.dock)
  440. =. ^dock dock
  441. =^ [hose=@ bole=berm] dock (peel hat (vent next))
  442. ~| ~(key by lake.dock)
  443. ~| bole
  444. =/ alms (~(got by lake.dock) bole)
  445. =. lake.dock (~(put by (~(del by lake.dock) bole)) (dole next) alms)
  446. :- lake.dock
  447. :_ hose
  448. =| safe=? :: XX state maximal safe axes, as this will overly pessimize
  449. =/ bolt=@ 1
  450. |- ^- (list [@ @ ?])
  451. ?- -.hat
  452. %tine [[bolt +.hat safe]]~
  453. %disc ~
  454. %fork
  455. %+ weld
  456. $(hat left.hat, bolt (peg bolt 2), safe ?&(safe safe.hat))
  457. $(hat rite.hat, bolt (peg bolt 3), safe ?&(safe safe.hat))
  458. ==
  459. ^$(work t.work)
  460. |- ^- [[hat=plow her=berm] dock=_dock]
  461. ?- fawn
  462. [%par * *]
  463. =^ [one=plow two=plow her=berm] dock twin
  464. =^ [bat=plow bit=berm] dock
  465. $(fawn +>.fawn, axle (peg axle 3), flow [%moat her two])
  466. =^ [hat=plow hit=berm] dock
  467. $(fawn +<.fawn, axle (peg axle 2), flow [%moat bit one])
  468. (copy hat bat hit)
  469. ::
  470. [%zer *]
  471. ?- -.flow
  472. %moat
  473. =/ slow (take +<.fawn what.flow +>.fawn)
  474. ?~ slow
  475. fail
  476. :_ dock
  477. [u.slow wher.flow]
  478. ::
  479. %rift
  480. =^ miff dock wean
  481. =/ slow (take +<.fawn [%tine miff] +>.fawn)
  482. ?~ slow
  483. fail
  484. =^ her dock (mend %miff ~ [%brn miff [troo fals]:flow])
  485. :_ dock
  486. [u.slow her]
  487. ::
  488. %pond
  489. =^ tend dock wean
  490. =/ slow (take +<.fawn [%tine tend] +>.fawn)
  491. ?~ slow
  492. fail
  493. =^ her dock (mend %tend ~ [%don tend])
  494. :_ dock
  495. [u.slow her]
  496. ==
  497. ::
  498. [%one *]
  499. (bang +.fawn)
  500. ::
  501. [%two *]
  502. ?- -.flow
  503. %moat
  504. =^ flaw dock (peel what.flow wher.flow)
  505. (tool `flaw +.fawn)
  506. ::
  507. %rift
  508. =^ muse dock wean
  509. =^ skit dock (mend %skit ~ [%brn muse [troo fals]:flow])
  510. (tool `[muse skit] +.fawn)
  511. ::
  512. %pond
  513. (tool ~ +.fawn)
  514. ==
  515. ::
  516. [%thr *]
  517. ?- -.flow
  518. %moat
  519. ?- -.what.flow
  520. %fork fail
  521. %disc $(fawn +.fawn, axle (peg axle 3))
  522. %tine
  523. =^ pear dock (mend %pear [%imm 0 +.what.flow]~ [%hop wher.flow])
  524. =^ bock dock (mend %bock [%imm 1 +.what.flow]~ [%hop wher.flow])
  525. =^ noon dock wean
  526. =^ keck dock (mend %keck ~ [%clq noon pear bock])
  527. $(fawn +.fawn, axle (peg axle 3), flow [%moat keck [%tine noon]])
  528. ==
  529. ::
  530. %rift
  531. =^ noon dock wean
  532. =^ keck dock (mend %keck ~ [%clq noon [troo fals]:flow])
  533. $(fawn +.fawn, axle (peg axle 3), flow [%moat keck [%tine noon]])
  534. ::
  535. %pond
  536. =^ tend dock wean
  537. =^ pear dock (mend %pear [%imm 0 tend]~ [%don tend])
  538. =^ bock dock (mend %bock [%imm 1 tend]~ [%don tend])
  539. =^ noon dock wean
  540. =^ keck dock (mend %keck ~ [%clq noon pear bock])
  541. $(fawn +.fawn, axle (peg axle 3), flow [%moat keck [%tine noon]])
  542. ==
  543. ::
  544. [%fou *]
  545. ?- -.flow
  546. %moat
  547. ?- -.what.flow
  548. %fork fail
  549. %disc
  550. =^ left dock wean
  551. ?: +>.fawn :: safe?
  552. $(fawn +<.fawn, axle (peg axle 6), flow [%moat wher.flow [%tine left]])
  553. =^ meal dock wean
  554. =^ dink dock (mend %dink ~[[%inc meal left]] [%hop wher.flow])
  555. $(fawn +<.fawn, axle (peg axle 6), flow [%moat dink [%tine meal]])
  556. ::
  557. %tine
  558. =^ meal dock wean
  559. =^ rink dock
  560. ?: +>.fawn
  561. (mend %rink ~[[%unc meal +.what.flow]] [%hop wher.flow])
  562. (mend %rink ~[[%inc meal +.what.flow]] [%hop wher.flow])
  563. $(fawn +<.fawn, axle (peg axle 6), flow [%moat rink [%tine meal]])
  564. ==
  565. ::
  566. %rift
  567. =^ iffy dock wean
  568. =^ miff dock wean
  569. =^ kink dock
  570. ?: +>.fawn :: safe?
  571. (mend %kink ~[[%unc miff iffy]] [%brn iffy [troo fals]:flow])
  572. (mend %kink ~[[%inc miff iffy]] [%brn iffy [troo fals]:flow])
  573. $(fawn +<.fawn, axle (peg axle 6), flow [%moat kink [%tine miff]])
  574. ::
  575. %pond
  576. =^ pend dock wean
  577. =^ spin dock wean
  578. =^ pink dock
  579. ?: +>.fawn :: safe?
  580. (mend %pink ~[[%unc spin pend]] [%don pend])
  581. (mend %pink ~[[%inc spin pend]] [%don pend])
  582. $(fawn +<.fawn, axle (peg axle 6), flow [%moat pink [%tine spin]])
  583. ==
  584. ::
  585. [%fiv *]
  586. ?- -.flow
  587. %moat
  588. ?- -.what.flow
  589. %fork fail
  590. %disc
  591. =^ [hit=plow his=berm] dock $(fawn +<.fawn, axle (peg axle 6))
  592. =^ [hot=plow hog=berm] dock
  593. $(fawn +<.fawn, axle (peg axle 7), flow [%moat his [%disc ~]])
  594. (copy hit hot hog)
  595. ::
  596. %tine
  597. =^ root dock (mend %root ~[[%imm 0 +.what.flow]] [%hop wher.flow])
  598. =^ salt dock (mend %salt ~[[%imm 1 +.what.flow]] [%hop wher.flow])
  599. =^ load dock wean
  600. =^ toad dock wean
  601. =^ qual dock (mend %qual ~ [%eqq load toad root salt])
  602. =^ [hit=plow his=berm] dock
  603. $(fawn +<.fawn, axle (peg axle 6), flow [%moat qual [%tine load]])
  604. =^ [hot=plow hog=berm] dock
  605. $(fawn +>.fawn, axle (peg axle 7), flow [%moat his [%tine toad]])
  606. (copy hit hot hog)
  607. ==
  608. ::
  609. %rift
  610. =^ load dock wean
  611. =^ toad dock wean
  612. =^ rail dock (mend %rail ~ [%eqq load toad [troo fals]:flow])
  613. =^ [hit=plow his=berm] dock
  614. $(fawn +<.fawn, axle (peg axle 6), flow [%moat rail [%tine load]])
  615. =^ [hot=plow hog=berm] dock
  616. $(fawn +>.fawn, axle (peg axle 7), flow [%moat his [%tine toad]])
  617. (copy hit hot hog)
  618. ::
  619. %pond
  620. =^ bean dock wean
  621. =^ root dock (mend %root ~[[%imm 0 bean]] [%don bean])
  622. =^ salt dock (mend %salt ~[[%imm 1 bean]] [%don bean])
  623. =^ load dock wean
  624. =^ toad dock wean
  625. =^ fall dock (mend %fall ~ [%eqq load toad root salt])
  626. =^ [hit=plow his=berm] dock
  627. $(fawn +<.fawn, axle (peg axle 6), flow [%moat fall [%tine load]])
  628. =^ [hot=plow hog=berm] dock
  629. $(fawn +>.fawn, axle (peg axle 7), flow [%moat his [%tine toad]])
  630. (copy hit hot hog)
  631. ==
  632. ::
  633. [%six *]
  634. =^ [hut=plow hum=berm] dock $(fawn +>-.fawn, axle (peg axle 14))
  635. =^ [hat=plow ham=berm] dock $(fawn +>+.fawn, axle (peg axle 15))
  636. =^ [hot=plow hog=berm] dock
  637. $(fawn +<.fawn, axle (peg axle 6), flow [%rift hum ham])
  638. =^ [hit=plow him=berm] dock (copy hut hat hog)
  639. (copy hit hot him)
  640. ::
  641. [%sev *]
  642. =^ [hit=plow his=berm] dock $(fawn +>.fawn, axle (peg axle 7))
  643. $(fawn +<.fawn, axle (peg axle 6), flow [%moat his hit])
  644. ::
  645. [%ten *]
  646. ?- -.flow
  647. %moat
  648. =^ [out=plow inn=plow tub=berm] dock (tear +<-.fawn what.flow +>+.fawn wher.flow)
  649. =^ [hat=plow him=berm] dock $(fawn +<+.fawn, axle (peg axle 13), flow [%moat tub inn])
  650. =^ [hut=plow mud=berm] dock $(fawn +>-.fawn, axle (peg axle 14), flow [%moat him out])
  651. (copy hat hut mud)
  652. ::
  653. %rift
  654. :: this is a weird case. It only works if the axis is one,
  655. :: otherwise it crashes, and there's no point in an axis edit of
  656. :: one except to discard the first result
  657. ?. =(1 +<-.fawn) fail
  658. =^ hide dock wean
  659. =^ mood dock (mend %mood ~ [%brn hide [troo fals]:flow])
  660. =^ [hat=plow him=berm] dock
  661. $(fawn +<+.fawn, axle (peg axle 13), flow [%moat mood [%tine hide]])
  662. =^ [hut=plow mud=berm] dock
  663. $(fawn +>-.fawn, axle (peg axle 14), flow [%moat him [%disc ~]])
  664. (copy hat hut mud)
  665. ::
  666. %pond
  667. =^ dire dock wean
  668. =^ eden dock (mend %eden ~ [%don dire])
  669. =^ [out=plow inn=plow tub=berm] dock (tear +<-.fawn [%tine dire] +>+.fawn eden)
  670. =^ [hat=plow him=berm] dock $(fawn +<+.fawn, axle (peg axle 13), flow [%moat tub inn])
  671. =^ [hut=plow mud=berm] dock $(fawn +>-.fawn, axle (peg axle 14), flow [%moat him out])
  672. (copy hat hut mud)
  673. ==
  674. ::
  675. [%els *]
  676. =^ [hat=plow him=berm] dock $(fawn +>.fawn, axle (peg axle 7))
  677. =^ pint dock wean
  678. =^ tint dock (mend %tint ~[[%imm +<.fawn pint]] [%hnt pint him])
  679. :_ dock
  680. [hat tint]
  681. ::
  682. [%eld *]
  683. =^ [hat=plow him=berm] dock $(fawn +>-.fawn, axle (peg axle 7))
  684. =^ pint dock wean
  685. =^ dint dock wean
  686. =^ aint dock wean
  687. =^ tint dock (mend %tint ~[[%imm +<-.fawn pint] [%con pint dint aint]] [%hnt aint him])
  688. =^ [hit=plow his=berm] dock $(fawn +<+.fawn, axle (peg axle 13), flow [%moat tint [%tine dint]])
  689. (copy hat hit his)
  690. ::
  691. [%twe *]
  692. ?- -.flow
  693. %moat
  694. =^ [use=@ her=berm] dock (peel what.flow wher.flow)
  695. =^ fens dock wean
  696. =^ phat dock wean
  697. =^ cope dock (mend %cope ~ [%spy fens phat use her])
  698. =^ [ham=plow pan=berm] dock
  699. $(fawn +>.fawn, axle (peg axle 7), flow [%moat cope [%tine phat]])
  700. =^ [hen=plow pen=berm] dock
  701. $(fawn +<.fawn, axle (peg axle 6), flow [%moat pan [%tine fens]])
  702. (copy ham hen pen)
  703. ::
  704. %rift
  705. =^ sift dock wean
  706. =^ bars dock (mend %bars ~ [%brn sift [troo fals]:flow])
  707. =^ fens dock wean
  708. =^ phat dock wean
  709. =^ cope dock (mend %cope ~ [%spy fens phat sift bars])
  710. =^ [ham=plow pan=berm] dock
  711. $(fawn +>.fawn, axle (peg axle 7), flow [%moat cope [%tine phat]])
  712. =^ [hen=plow pen=berm] dock
  713. $(fawn +<.fawn, axle (peg axle 6), flow [%moat pan [%tine fens]])
  714. (copy ham hen pen)
  715. ::
  716. %pond
  717. =^ sped dock wean
  718. =^ sear dock (mend %sear ~ [%don sped])
  719. =^ fens dock wean
  720. =^ phat dock wean
  721. =^ cope dock (mend %cope ~ [%spy fens phat sped sear])
  722. =^ [ham=plow pan=berm] dock
  723. $(fawn +>.fawn, axle (peg axle 7), flow [%moat cope [%tine phat]])
  724. =^ [hen=plow pen=berm] dock
  725. $(fawn +<.fawn, axle (peg axle 6), flow [%moat pan [%tine fens]])
  726. (copy ham hen pen)
  727. ==
  728. ==
  729. ++ fail
  730. ^- [[hat=plow her=berm] dock=_dock]
  731. =^ hole dock bomb
  732. :_ dock
  733. [[%disc ~] hole]
  734. ++ tear :: take apart an ssa map for an edit
  735. |= [axe=@ bit=plow safe=? her=berm]
  736. ^- [[out=plow inn=plow his=berm] _dock]
  737. ?: =(0 axe)
  738. =^ hole dock bomb
  739. [[[%disc ~] [%disc ~] hole] dock]
  740. =+
  741. |- ^- [[out=plow inn=plow rind=(list bran)] deck=_dock]
  742. ?: =(1 axe)
  743. :_ dock
  744. [[%disc ~] bit ~]
  745. ?- -.bit
  746. %disc
  747. ?: safe [[[%disc ~] [%disc ~] ~] dock]
  748. ?- (cap axe)
  749. %2
  750. =^ ruck dock $(axe (mas axe))
  751. :_ dock
  752. [[%fork out.ruck [%disc ~] %.n] inn.ruck rind.ruck]
  753. %3
  754. =^ ruck dock $(axe (mas axe))
  755. :_ dock
  756. [[%fork [%disc ~] out.ruck %.n] inn.ruck rind.ruck]
  757. ==
  758. ::
  759. %tine
  760. =^ tour dock wean
  761. =^ plat dock wean
  762. ?- (cap axe)
  763. %2
  764. =^ ruck dock $(axe (mas axe), bit [%tine plat])
  765. :_ dock
  766. [[%fork out.ruck [%tine tour] safe] inn.ruck [[%con plat tour +.bit] rind.ruck]]
  767. %3
  768. =^ ruck dock $(axe (mas axe), bit [%tine plat])
  769. :_ dock
  770. [[%fork [%tine tour] out.ruck safe] inn.ruck [[%con tour plat +.bit] rind.ruck]]
  771. ==
  772. ::
  773. %fork
  774. ?- (cap axe)
  775. %2
  776. =^ ruck dock $(axe (mas axe), bit left.bit)
  777. :_ dock
  778. [[%fork out.ruck rite.bit ?&(safe safe.bit)] inn.ruck rind.ruck]
  779. %3
  780. =^ ruck dock $(axe (mas axe), bit rite.bit)
  781. :_ dock
  782. [[%fork left.bit out.ruck ?&(safe safe.bit)] inn.ruck rind.ruck]
  783. ==
  784. ==
  785. =. dock deck
  786. ?~ rind
  787. :_ dock
  788. [out inn her]
  789. =^ him dock (mend %diet rind [%hop her])
  790. :_ dock
  791. [out inn him]
  792. ++ tool :: generate calls
  793. |= [flaw=(unit [rut=@ rot=berm]) sums=nomm form=nomm sunk=sock fork=(unit *) safe=?]
  794. ^- [[plow berm] _dock]
  795. ?~ fork
  796. =^ lash dock wean
  797. =^ frog dock wean
  798. =^ coil dock
  799. ?~ flaw
  800. (mend %coil ~ [%lnt frog lash])
  801. (mend %coil ~ [%lnk frog lash rut.u.flaw rot.u.flaw])
  802. =^ [bow=plow urn=berm] dock
  803. $(fawn sums, axle (peg axle 6), flow [%moat coil [%tine lash]])
  804. =^ [fog=plow sog=berm] dock
  805. $(fawn form, axle (peg axle 14), flow [%moat urn [%tine frog]])
  806. (copy fog bow sog)
  807. =/ bale=barn [sunk u.fork]
  808. =/ bore (~(get by land.burg) bale)
  809. ?~ bore :: we don't know the registerization of the subject for the call, yet
  810. =^ lash dock wean
  811. =^ dote dock
  812. ?~ flaw
  813. (mend %dote ~ [%eye bale lash])
  814. (mend %dote ~ [%bec bale lash rut.u.flaw rot.u.flaw])
  815. =^ [bow=plow urn=berm] dock
  816. $(fawn sums, axle (peg axle 6), flow [%moat dote [%tine lash]])
  817. ?: safe [[bow urn] dock]
  818. =^ [fog=plow sog=berm] dock
  819. $(fawn form, axle (peg axle 14), flow [%moat urn [%disc ~]])
  820. (copy fog bow sog)
  821. =^ uses dock (cool uses.does.u.bore)
  822. =^ dote dock
  823. ?~ flaw
  824. (mend %dote ~ [%jmp bale (boil uses)])
  825. (mend %dote ~ [%cal bale (boil uses) rut.u.flaw rot.u.flaw])
  826. =^ [ash=plow dot=berm] dock (whop uses dote)
  827. =^ [bow=plow urn=berm] dock
  828. $(fawn sums, axle (peg axle 6), flow [%moat dot ash])
  829. ?: safe [[bow urn] dock]
  830. =^ [fog=plow sog=berm] dock
  831. $(fawn form, axle (peg axle 14), flow [%moat urn [%disc ~]])
  832. (copy fog bow sog)
  833. ++ cool :: generate SSAs for the call side of a use list
  834. |= use=(list [@ @ ?])
  835. ^- [(list [@ @ ?]) _dock]
  836. ?~ use [~ dock]
  837. =^ pan dock wean
  838. =^ lid dock $(use t.use)
  839. :_ dock
  840. [[-.i.use pan +>.i.use] lid]
  841. ++ boil :: ssas from a use list
  842. |= use=(list [@ @ ?])
  843. ^- (list @)
  844. (turn use |=([@ ssa=@ ?] ssa))
  845. ++ whop :: turn a use list into a plow
  846. |= [use=(list [@ @ ?]) her=berm]
  847. ^- [[plow berm] _dock]
  848. ?~ use [[*plow her] dock]
  849. =^ [low=plow him=berm] dock $(use t.use)
  850. =/ ace (take -.i.use [%tine +<.i.use] +>.i.use)
  851. ?~ ace fail
  852. (copy low u.ace him)
  853. ++ bang
  854. |= non=*
  855. ^- [[hat=plow her=berm] _dock]
  856. ?- flow
  857. [%pond ~]
  858. =^ ret dock wean
  859. =^ her dock (mend %rime ~[[%imm +.fawn ret]] [%don ret])
  860. :_ dock
  861. [[%disc ~] her]
  862. ::
  863. [%rift *]
  864. ?: =(0 +.fawn) [[[%disc ~] troo.flow] dock]
  865. ?: =(1 +.fawn) [[[%disc ~] fals.flow] dock]
  866. :: XX maybe we should assert that SKA should have caught this?
  867. =^ hole dock bomb
  868. :_ dock
  869. [[%disc ~] hole]
  870. ::
  871. [%moat *]
  872. =/ what what.flow
  873. =/ mitt
  874. |- ^- (unit (list bran))
  875. ?- what
  876. [%disc ~]
  877. (some ~)
  878. ::
  879. [%tine @]
  880. (some ~[[%imm non +.what]])
  881. ::
  882. [%fork *]
  883. ?@ non
  884. ?: safe.what
  885. ~| %safe-axis-atom !!
  886. ~
  887. (clap $(what left.what, non -.non) $(what rite.what, non +.non) weld)
  888. ==
  889. ?~ mitt
  890. =^ hole dock bomb
  891. :_ dock
  892. [[%disc ~] hole]
  893. =^ rock dock (mend %toil u.mitt [%hop wher.flow])
  894. :_ dock
  895. [[%disc ~] rock]
  896. ==
  897. ++ take :: axis
  898. |= [sax=@ tow=plow row=?] :: axis, destination, safety
  899. ^- (unit plow) :: nullary case = crash
  900. ?: =(0 sax) ~
  901. %- some
  902. |- ^- plow
  903. ?: =(1 sax) tow
  904. ?- (cap sax)
  905. %2 [%fork $(sax (mas sax)) [%disc ~] row]
  906. %3 [%fork [%disc ~] $(sax (mas sax)) row]
  907. ==
  908. ++ copy :: replicate values to two destinations
  909. |= [hat=plow bat=plow her=berm]
  910. ^- [[hat=plow her=berm] _dock]
  911. =^ [tog=plow moot=(list bran)] dock
  912. |-
  913. ^- [[tog=plow moot=(list bran)] _dock]
  914. ?: ?=([%disc ~] hat) [[bat ~] dock]
  915. ?: ?=([%disc ~] bat) [[hat ~] dock]
  916. ?- hat
  917. [%tine @]
  918. ?- bat
  919. [%tine @]
  920. ?: =(+.hat +.bat)
  921. [[hat ~] dock]
  922. [[hat ~[[%mov +.hat +.bat]]] dock]
  923. ::
  924. [%fork *]
  925. =^ one dock wean
  926. =^ two dock wean
  927. =^ [hog=plow hoot=(list bran)] dock
  928. $(hat [%tine one], bat left.bat)
  929. =^ [log=plow loot=(list bran)] dock
  930. $(hat [%tine two], bat rite.bat)
  931. :_ dock
  932. :- ^- plow
  933. [%fork hog log safe.bat]
  934. [[%con one two +.hat] (weld hoot loot)]
  935. ==
  936. ::
  937. [%fork *]
  938. ?- bat
  939. [%tine @]
  940. =^ one dock wean
  941. =^ two dock wean
  942. =^ [hog=plow hoot=(list bran)] dock
  943. $(hat left.hat, bat [%tine one])
  944. =^ [log=plow loot=(list bran)] dock
  945. $(hat rite.hat, bat [%tine two])
  946. :_ dock
  947. [[%fork hog log safe.hat] [%con one two +.bat] (weld hoot loot)]
  948. ::
  949. [%fork *]
  950. =^ [hog=plow hoot=(list bran)] dock $(hat left.hat, bat left.bat)
  951. =^ [log=plow loot=(list bran)] dock $(hat rite.hat, bat rite.bat)
  952. :_ dock
  953. [[%fork hog log ?&(safe.hat safe.bat)] (weld hoot loot)]
  954. ==
  955. ==
  956. =/ blab (milk %copy)
  957. :_ dock(lake (~(put by lake.dock) blab [moot %hop her]))
  958. [tog blab]
  959. ++ twin :: split sans from flow
  960. ^- [[plow plow berm] _dock]
  961. ?- flow
  962. [%rift *]
  963. =^ hole dock bomb
  964. :_ dock
  965. [[%disc ~] [%disc ~] hole]
  966. ::
  967. [%pond ~]
  968. =^ one dock wean
  969. =^ two dock wean
  970. =^ ret dock wean
  971. =^ her dock (mend %taco ~[[%con one two ret]] [%don ret])
  972. :_ dock
  973. [[%tine one] [%tine two] her]
  974. ::
  975. [%moat *]
  976. ?- what.flow
  977. [%fork *]
  978. :_ dock
  979. [left.what.flow rite.what.flow wher.flow]
  980. ::
  981. [%disc ~]
  982. :_ dock
  983. [[%disc ~] [%disc ~] wher.flow]
  984. ::
  985. [%tine @]
  986. =^ one dock wean
  987. =^ two dock wean
  988. =^ her dock
  989. (mend %cons ~[[%con one two +.what.flow]] [%hop wher.flow])
  990. :_ dock
  991. [[%tine one] [%tine two] her]
  992. ==
  993. ==
  994. ++ bomb
  995. ^- [berm _dock]
  996. (mend %boom ~ [%bom ~])
  997. ++ milk :: local label
  998. |= gen=@
  999. ^- berm
  1000. ~! next
  1001. [sub.next for.next axle gen]
  1002. ++ mend
  1003. |= [gen=@ =lock]
  1004. ^- [berm _dock]
  1005. =/ curb (milk gen)
  1006. :- curb
  1007. dock(lake (~(put by lake.dock) curb lock))
  1008. ++ wean :: fresh ssa
  1009. ^- [@ _dock]
  1010. [lamb.dock dock(lamb .+(lamb.dock))]
  1011. ++ peel :: split a define among a plow's worth of uses
  1012. |= [mole=plow hill=berm]
  1013. ^- [[use=@ her=berm] _dock]
  1014. ~& ~(key by lake.dock)
  1015. =+
  1016. |- ^- [[fine=(unit @) load=(list bran)] dock=_dock]
  1017. ?- -.mole
  1018. %tine [[`+.mole ~] dock]
  1019. %disc [[~ ~] dock]
  1020. %fork
  1021. =^ [file=(unit @) loaf=(list bran)] dock $(mole left.mole)
  1022. =^ [fire=(unit @) road=(list bran)] dock $(mole rite.mole)
  1023. ?~ file
  1024. ?~ fire
  1025. [[~ ~] dock]
  1026. [[fire road] dock]
  1027. ?~ fire
  1028. [[file loaf] dock]
  1029. =^ fell dock wean
  1030. ?: safe.mole
  1031. :_ dock
  1032. :- `fell
  1033. [[%hud fell u.file] [%tul fell u.fire] (weld loaf road)]
  1034. :_ dock
  1035. :- `fell
  1036. [[%hed fell u.file] [%tal fell u.fire] (weld loaf road)]
  1037. ==
  1038. ?~ fine
  1039. =^ crap dock wean :: no uses in the plow, so just make a trash register for the result and return
  1040. =^ her dock (mend %peel ~ [%hop hill])
  1041. [[crap her] dock]
  1042. =^ her dock (mend %peel load [%hop hill]) :: loads necessary, add those to the dock and return
  1043. [[u.fine her] dock]
  1044. --
  1045. ++ rake :: clean up unused basic blocks, and rewrite bec/eye into cal/jmp
  1046. =* this .
  1047. |= work=(list barn)
  1048. ^- _this
  1049. ?~ work this
  1050. %= $
  1051. burg
  1052. =+ ~| %barn-miss (~(got by land.burg) i.work)
  1053. ^- town
  1054. =| loch=lake
  1055. =| sigh=(map @ $%([%mov @] [%con @ @] [%rug ~]))
  1056. =/ tack=[(list berm) (list berm)] [[(vent i.work) ~] ~] :: label queue
  1057. |- ^- town :: loop over basic blocks using a queue
  1058. ?~ -.tack
  1059. ?~ +.tack
  1060. %= burg
  1061. land
  1062. (~(put by land.burg) i.work [[loch uses.does lump.does] says])
  1063. ==
  1064. $(tack [(flop +.tack) ~])
  1065. =/ hock ~| %miss-berm ~| i.-.tack (~(got by goes.does) i.-.tack)
  1066. =/ bock body.hock
  1067. |^ ^- town :: loop over instructions in a basic block
  1068. ?~ body.hock
  1069. ?: ?=(%bec -.bend.hock)
  1070. (rend [+< +>- `+>+]:bend.hock)
  1071. ?: ?=(%eye -.bend.hock)
  1072. (rend [+< +> ~]:bend.hock)
  1073. =. loch (~(put by loch) i.-.tack [bock bend.hock])
  1074. ?- bend.hock
  1075. [%clq *]
  1076. ^$(-.tack t.-.tack, +.tack [+>-.bend.hock +>+.bend.hock +.tack])
  1077. ::
  1078. [%eqq *]
  1079. ^$(-.tack t.-.tack, +.tack [+>+<.bend.hock +>+>.bend.hock +.tack])
  1080. ::
  1081. [%brn *]
  1082. ^$(-.tack t.-.tack, +.tack [+>-.bend.hock +>+.bend.hock +.tack])
  1083. ::
  1084. [%hop *]
  1085. ^$(-.tack t.-.tack, +.tack [+.bend.hock +.tack])
  1086. ::
  1087. [%lnk *]
  1088. %= ^$
  1089. sigh (~(put by sigh) +>+<.bend.hock [%rug ~])
  1090. -.tack t.-.tack
  1091. +.tack [+>+>.bend.hock +.tack]
  1092. ==
  1093. ::
  1094. [%cal *]
  1095. %= ^$
  1096. sigh (~(put by sigh) +>+<.bend.hock [%rug ~])
  1097. -.tack t.-.tack
  1098. +.tack [+>+>.bend.hock +.tack]
  1099. ==
  1100. ::
  1101. [%lnt *] ^$(-.tack t.-.tack)
  1102. [%jmp *] ^$(-.tack t.-.tack)
  1103. [%spy *]
  1104. %= ^$
  1105. sigh (~(put by sigh) +>+<.bend.hock [%rug ~])
  1106. -.tack t.-.tack
  1107. +.tack [+>+>.bend.hock +.tack]
  1108. ==
  1109. ::
  1110. [%hnt *]
  1111. ^$(-.tack t.-.tack, +.tack [+>.bend.hock +.tack])
  1112. ::
  1113. [%don *] ^$(-.tack t.-.tack)
  1114. [%bom *] ^$(-.tack t.-.tack)
  1115. ==
  1116. ?- i.body.hock
  1117. [%imm *] :: XX we should split immediates too
  1118. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1119. ::
  1120. [%mov *]
  1121. %= $
  1122. body.hock t.body.hock
  1123. sigh (~(put by sigh) +>.i.body.hock [%mov +<.i.body.hock])
  1124. ==
  1125. ::
  1126. [%inc *]
  1127. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1128. ::
  1129. [%unc *]
  1130. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1131. ::
  1132. [%con *]
  1133. %= $
  1134. body.hock t.body.hock
  1135. sigh
  1136. %+ ~(put by sigh)
  1137. +>+.i.body.hock
  1138. [%con +<.i.body.hock +>-.i.body.hock]
  1139. ==
  1140. ::
  1141. [%hed @ @]
  1142. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1143. ::
  1144. [%hud @ @]
  1145. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1146. ::
  1147. [%tal @ @]
  1148. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1149. ::
  1150. [%tul @ @]
  1151. $(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
  1152. ==
  1153. ++ rend :: make register assignments to translate a bec/eye into a cal/jmp.
  1154. |= [=barn tart=@ poem=(unit [@ berm])]
  1155. =/ uses ~| %uses-miss uses:does:(~(got by land.burg) barn)
  1156. ^- town
  1157. =-
  1158. =. burg fort
  1159. =? sigh ?=([~ *] poem) (~(put by sigh) -.u.poem [%rug ~])
  1160. =/ term
  1161. ?~ poem
  1162. [%jmp barn bits]
  1163. [%cal barn bits u.poem]
  1164. %= ^^$
  1165. loch
  1166. (~(put by loch) i.-.tack [(weld bock bins) term])
  1167. ::
  1168. -.tack t.-.tack
  1169. ==
  1170. =/ gasp :: turn the sigh register-relating map into a register-for-axis map
  1171. =/ axe 1
  1172. |- ^- (map @ @)
  1173. =/ waft (~(put by *(map @ @)) axe tart)
  1174. =/ puff (~(gut by sigh) tart [%rug ~])
  1175. ?- puff
  1176. [%rug ~] waft
  1177. [%mov *] (~(uni by waft) $(tart +.puff))
  1178. [%con *]
  1179. =/ left $(tart +<.puff, axe (peg axe 2))
  1180. %- ~(uni by waft)
  1181. %- ~(uni by left)
  1182. $(tart +>.puff, axe (peg axe 3))
  1183. ==
  1184. =| bits=(list @)
  1185. =| bins=(list bran)
  1186. |- ^- [bits=(list @) bins=(list bran) fort=town]
  1187. ?~ uses [(flop bits) bins burg]
  1188. =/ sour -.i.uses
  1189. =/ axle 1
  1190. =/ vale ~| %vale-miss (~(got by gasp) 1)
  1191. |- ^- [bits=(list @) bins=(list bran) fort=town]
  1192. ?: =(1 sour)
  1193. ^$(bits [vale bits], uses t.uses)
  1194. ?- (cap sour)
  1195. %2
  1196. =. axle (peg axle 2)
  1197. =. sour (mas sour)
  1198. =/ pale (~(get by gasp) axle)
  1199. ?~ pale
  1200. %= $
  1201. bins [[%hed vale lamb.burg] bins]
  1202. vale lamb.burg
  1203. gasp (~(put by gasp) axle lamb.burg)
  1204. lamb.burg .+(lamb.burg)
  1205. ==
  1206. $(vale u.pale)
  1207. ::
  1208. %3
  1209. =. axle (peg axle 3)
  1210. =. sour (mas sour)
  1211. =/ pale (~(get by gasp) axle)
  1212. ?~ pale
  1213. %= $
  1214. bins [[%tal vale lamb.burg] bins]
  1215. vale lamb.burg
  1216. gasp (~(put by gasp) axle lamb.burg)
  1217. lamb.burg .+(lamb.burg)
  1218. ==
  1219. $(vale u.pale)
  1220. ==
  1221. --
  1222. ::
  1223. work t.work
  1224. ==
  1225. ++ weed :: remove unused safe operations (imm,mov,unc,con,hud,tul)
  1226. =* this .
  1227. |= work=(list barn)
  1228. ^- _this
  1229. ?~ work this
  1230. =/ herd (~(got by land.burg) i.work) :: sack for this arm
  1231. =| dead=(jug berm @) :: values used by a label and its successor code
  1232. =/ furs=(list berm) [[sub for 1 %vent]:i.work ~]
  1233. |- ^- _this
  1234. ?~ furs
  1235. ^$(work t.work, land.burg (~(put by land.burg) i.work herd))
  1236. ?: (~(has by dead) i.furs) :: did we already analyze this arm
  1237. $(furs t.furs)
  1238. =/ meat (~(got by goes.does.herd) i.furs)
  1239. |^
  1240. ?- -.bend.meat
  1241. %clq
  1242. =/ troo (~(get by dead) +>-.bend.meat)
  1243. ?~ troo $(furs [+>-.bend.meat furs])
  1244. =/ fals (~(get by dead) +>+.bend.meat)
  1245. ?~ fals $(furs [+>+.bend.meat furs])
  1246. ~! u.troo
  1247. ~! u.fals
  1248. ~! +<.bend.meat
  1249. (vein (~(uni in u.troo) (~(put in u.fals) +<.bend.meat)))
  1250. ::
  1251. %eqq
  1252. =/ troo (~(get by dead) +>+<.bend.meat)
  1253. ?~ troo $(furs [+>+<.bend.meat furs])
  1254. =/ fals (~(get by dead) +>+>.bend.meat)
  1255. ?~ fals $(furs [+>+>.bend.meat furs])
  1256. (vein (~(uni in u.troo) (~(gas in u.fals) [+<.bend.meat +>-.bend.meat ~])))
  1257. ::
  1258. %brn
  1259. =/ troo (~(get by dead) +>-.bend.meat)
  1260. ?~ troo $(furs [+>-.bend.meat furs])
  1261. =/ fals (~(get by dead) +>+.bend.meat)
  1262. ?~ fals $(furs [+>+.bend.meat furs])
  1263. (vein (~(uni in u.troo) (~(put in u.fals) +<.bend.meat)))
  1264. ::
  1265. %hop
  1266. =/ want (~(get by dead) +.bend.meat)
  1267. ?~ want $(furs [+.bend.meat furs])
  1268. (vein u.want)
  1269. ::
  1270. %lnk
  1271. =/ want (~(get by dead) +>+>.bend.meat)
  1272. ?~ want $(furs [+>+>.bend.meat furs])
  1273. (vein (~(gas in u.want) [+<.bend.meat +>-.bend.meat ~]))
  1274. ::
  1275. %cal
  1276. =/ want (~(get by dead) +>+>.bend.meat)
  1277. ?~ want $(furs [+>+>.bend.meat furs])
  1278. (vein (~(gas in u.want) +>-.bend.meat))
  1279. ::
  1280. %bec
  1281. ~| %bec-trip !!
  1282. ::
  1283. %lnt
  1284. (vein (silt [+<.bend.meat]~))
  1285. ::
  1286. %jmp
  1287. (vein (silt +>.bend.meat))
  1288. ::
  1289. %eye
  1290. ~| %eye-trip !!
  1291. ::
  1292. %spy
  1293. =/ want (~(get by dead) +>+>.bend.meat)
  1294. ?~ want $(furs [+>+>.bend.meat furs])
  1295. (vein (~(gas in u.want) [+<.bend.meat +>-.bend.meat ~]))
  1296. ::
  1297. %hnt
  1298. =/ want (~(get by dead) +>.bend.meat)
  1299. ?~ want $(furs [+>.bend.meat furs])
  1300. (vein (~(put in u.want) +<.bend.meat))
  1301. ::
  1302. %don
  1303. (vein (silt [+.bend.meat]~))
  1304. ::
  1305. %bom
  1306. (vein ~)
  1307. ==
  1308. ++ vein
  1309. |= uses=(set @)
  1310. =/ boyd (flop body.meat)
  1311. =| bond=(list bran)
  1312. |- ^- _this
  1313. ~! goes.does.herd
  1314. ~! i.furs
  1315. ?~ boyd
  1316. %= ^^^$
  1317. furs t.furs
  1318. goes.does.herd
  1319. (~(put by goes.does.herd) i.furs [bond bend.meat])
  1320. dead
  1321. (~(put by dead) i.furs uses)
  1322. ==
  1323. ?- -.i.boyd
  1324. %imm
  1325. ?: (~(has in uses) +>.i.boyd)
  1326. $(bond [i.boyd bond], boyd t.boyd)
  1327. $(boyd t.boyd)
  1328. ::
  1329. %mov
  1330. ?: (~(has in uses) +>.i.boyd)
  1331. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1332. $(boyd t.boyd)
  1333. ::
  1334. %inc
  1335. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1336. ::
  1337. %unc
  1338. ?: (~(has in uses) +>.i.boyd)
  1339. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1340. $(boyd t.boyd)
  1341. ::
  1342. %con
  1343. ?: (~(has in uses) +>+.i.boyd)
  1344. %= $
  1345. bond [i.boyd bond]
  1346. boyd t.boyd
  1347. uses (~(gas in uses) [+<.i.boyd +>-.i.boyd ~])
  1348. ==
  1349. $(boyd t.boyd)
  1350. ::
  1351. %hed
  1352. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1353. ::
  1354. %hud
  1355. ?: (~(has in uses) +>.i.boyd)
  1356. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1357. $(boyd t.boyd)
  1358. ::
  1359. %tal
  1360. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1361. ::
  1362. %tul
  1363. ?: (~(has in uses) +>.i.boyd)
  1364. $(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
  1365. $(boyd t.boyd)
  1366. ==
  1367. --
  1368. --