mirror of
https://github.com/urbit/shrub.git
synced 2024-12-15 12:43:31 +03:00
1040 lines
28 KiB
Plaintext
1040 lines
28 KiB
Plaintext
:: "Hello world" sample generator
|
|
::
|
|
:::: /hoon/hello/gen
|
|
::
|
|
/? 310
|
|
!:
|
|
::
|
|
::::
|
|
::
|
|
:- %say
|
|
|= {^ {{subject=type ~} ~}}
|
|
:- %txt
|
|
^- wain
|
|
=< =/ spec=spec ~(structure cosmetic subject)
|
|
=/ plum=plum (spec-to-plum spec)
|
|
~(tall plume plum)
|
|
|%
|
|
::
|
|
:: *cosmetic-state: for cosmetic below
|
|
::
|
|
+* cosmetic-state [form]
|
|
$: :: count: cumulative blocks detected
|
|
:: pairs: blocking numbers and specs
|
|
::
|
|
count=@ud
|
|
pairs=(map type (pair @ud form))
|
|
==
|
|
::
|
|
+* analyst [form]
|
|
$_ ^?
|
|
|%
|
|
++ atom *$-([aura=term constant=(unit @)] form)
|
|
++ cell *$-([=form =form] form)
|
|
++ core *$-([=vair =form =(map term form)] form)
|
|
++ face *$-([decor=$@(term tune) =form] form)
|
|
++ fork *$-(=(list form) form)
|
|
++ loop *$-([=form =(map @ud form)] form)
|
|
--
|
|
::
|
|
:: $xray: initial type analysis
|
|
::
|
|
|
|
+$ scan
|
|
$-
|
|
$@ $? %noun
|
|
%void
|
|
==
|
|
$% [%bare =atom =aura] :: constant
|
|
[%bark =(map atom aura)] :: constant set
|
|
|
|
|
|
|
|
+$ shoe
|
|
$@ %void :: empty
|
|
$% [%bark =(map atom type)] :: flat constants
|
|
[%bush wide=shoe long=shoe] :: by cell/atom head
|
|
[%leaf =type] :: any atom
|
|
[%root flat=shoe deep=shoe] :: by atom/cell
|
|
[%tree =type] :: any cell
|
|
[%wood =(map atom (pair type type))] :: by atom head
|
|
== ::
|
|
::
|
|
:: =merge: combine two shoes
|
|
::
|
|
++ merge-shoes
|
|
|= [one=shoe two=shoe]
|
|
^- (unit shoe)
|
|
?@ one `two
|
|
?@ two `one
|
|
?- -.one
|
|
%bark
|
|
?- -.two
|
|
%bark
|
|
:+ ~ %bark
|
|
:: (both maps merged, combining collisions)
|
|
::
|
|
=/ list ~(tap by map.one)
|
|
|- ^- (map atom type)
|
|
?~ list map.two
|
|
%= $
|
|
list t.list
|
|
map.two
|
|
%+ ~(put by map.two)
|
|
p.i.list
|
|
=+ (~(get by map.two) p.i.list)
|
|
?~ - q.i.list
|
|
(fork u.- q.i.list ~)
|
|
==
|
|
::
|
|
%bush
|
|
`[%root one two]
|
|
::
|
|
%leaf
|
|
:- ~
|
|
:- %leaf
|
|
%+ fork
|
|
type.two
|
|
(turn ~(tap by map.one) |=([* =type] type))
|
|
::
|
|
%root
|
|
%+ bind $(two flat.two)
|
|
|= new=shoe
|
|
[%root new deep.two]
|
|
::
|
|
%tree
|
|
`[%root one two]
|
|
::
|
|
%wood
|
|
`[%root one two]
|
|
==
|
|
::
|
|
%bush
|
|
?+ -.two $(one two, two one)
|
|
::
|
|
%bush
|
|
%^ clef
|
|
$(one wide.one, two wide.two)
|
|
$(one long.one, two long.two)
|
|
|=([wide=shoe long=shoe] `[%root wide long])
|
|
::
|
|
%leaf
|
|
`[%root two one]
|
|
::
|
|
%root
|
|
%+ bind $(two deep.two)
|
|
|= new=shoe
|
|
[%root flat.two new]
|
|
::
|
|
%tree
|
|
~
|
|
::
|
|
%wood
|
|
%+ bind $(one long.one)
|
|
|= new=shoe
|
|
[%bush wide.one new]
|
|
==
|
|
::
|
|
%leaf
|
|
?+ -.two $(one two, two one)
|
|
::
|
|
%leaf
|
|
`[%leaf (fork type.one type.two ~)]
|
|
::
|
|
%root
|
|
%+ bind $(two flat.two)
|
|
|= new=shoe
|
|
[%root new deep.two]
|
|
::
|
|
%tree
|
|
`[%root one two]
|
|
::
|
|
%wood
|
|
`[%root one two]
|
|
==
|
|
::
|
|
%root
|
|
?+ -.two $(one two, two one)
|
|
::
|
|
%root
|
|
%^ clef
|
|
$(one flat.one, two flat.two)
|
|
$(one deep.one, two deep.two)
|
|
|=([flat=shoe deep=shoe] `[%root flat deep])
|
|
::
|
|
%tree
|
|
%+ bind $(one deep.one)
|
|
|= new=shoe
|
|
[%root one new]
|
|
::
|
|
%wood
|
|
%+ bind $(one deep.one)
|
|
|= new=shoe
|
|
[%root one new]
|
|
==
|
|
::
|
|
%tree
|
|
?+ -.two $(one two, two one)
|
|
::
|
|
%tree
|
|
`[%tree (fork type.one type.two ~)]
|
|
::
|
|
%wood
|
|
~
|
|
==
|
|
::
|
|
%wood
|
|
?+ -.two $(one two, two one)
|
|
::
|
|
%wood
|
|
:: (both maps merged, combining collisions)
|
|
::
|
|
:- ~
|
|
:- %wood
|
|
=/ list ~(tap by map.one)
|
|
|- ^- (map atom (pair type type))
|
|
?~ list map.two
|
|
%= $
|
|
list t.list
|
|
map.two
|
|
%+ ~(put by map.two)
|
|
p.i.list
|
|
=+ (~(get by map.two) p.i.list)
|
|
?~ - q.i.list
|
|
[(fork p.u.- p.q.i.list ~) (fork q.u.- q.q.i.list ~)]
|
|
==
|
|
==
|
|
==
|
|
::
|
|
:: =shew: deconstruct type
|
|
::
|
|
++ shew
|
|
|= =type
|
|
:: (analysis of .type, if well-formed)
|
|
::
|
|
^- (unit shoe)
|
|
=- :: (analysis without trivial cases)
|
|
::
|
|
%+ biff -
|
|
|= =shoe
|
|
?- shoe
|
|
%void ~
|
|
[%bark *] ?:(?=([* ~ ~] map.shoe) ~ `shoe)
|
|
[%bush *] `shoe
|
|
[%leaf *] ~
|
|
[%root *] `shoe
|
|
[%tree *] ~
|
|
[%wood *] ?:(?=([* ~ ~] map.shoe) ~ `shoe)
|
|
==
|
|
|^ =| gil/(set ^type)
|
|
|- ^- (unit shoe)
|
|
?- type
|
|
%void `%void
|
|
%noun ~
|
|
::
|
|
[%atom *] as-done
|
|
[%cell *] :: if the head of .type is always a cell
|
|
::
|
|
?: is-cell(type p.type)
|
|
:: (a trivial bush)
|
|
::
|
|
`[%bush [%tree type] %void]
|
|
:: unless the head of .type is an atom
|
|
::
|
|
?. is-atom(type p.type)
|
|
:: (an opaque cell)
|
|
::
|
|
`[%tree type]
|
|
%+ biff to-atom(type p.type)
|
|
|= =atom
|
|
:: (a trivial wood)
|
|
::
|
|
`[%wood [%atom p.type q.type] ~ ~]
|
|
[%core *] ~
|
|
[%face *] as-done
|
|
[%fork *] =/ list ~(tap in p.type)
|
|
|- ^- (unit shoe)
|
|
?~ list `%void
|
|
%+ biff ^$(type i.list)
|
|
|= =shoe
|
|
%+ biff ^$(list t.list)
|
|
|= =^shoe
|
|
(merge-shoes shoe ^shoe)
|
|
::
|
|
[%hint *] $(type q.type)
|
|
[%hold *] ?: (~(has in gil) type) `%void
|
|
$(gil (~(put in gil) type), type ~(repo ut type))
|
|
==
|
|
::
|
|
++ is-atom (~(nest ut [%atom %$ ~]) %| type)
|
|
++ is-cell (~(nest ut [%cell %noun %noun]) %| type)
|
|
++ as-done ?: is-atom
|
|
=+ to-atom
|
|
?~ -
|
|
`[%leaf type]
|
|
`[%bark [u.- type] ~ ~]
|
|
?: is-cell
|
|
`[%tree type]
|
|
~
|
|
++ to-atom |- ^- (unit atom)
|
|
?- type
|
|
%void ~
|
|
%noun !!
|
|
[%atom *] q.type
|
|
[%cell *] !!
|
|
[%core *] !!
|
|
[%fork *] =/ list ~(tap in p.type)
|
|
?~ list !!
|
|
|- ^- (unit atom)
|
|
=+ ^$(type i.list)
|
|
?~ t.list -
|
|
%+ biff -
|
|
|= =atom
|
|
%+ biff ^$(i.list i.t.list, t.list t.t.list)
|
|
|= =^atom
|
|
?.(=(atom ^atom) ~ `atom)
|
|
[%face *] $(type q.type)
|
|
[%hint *] $(type q.type)
|
|
[%hold *] $(type ~(repo ut type))
|
|
==
|
|
--
|
|
::
|
|
++ cosmetic
|
|
%- (kismet spec)
|
|
|%
|
|
++ atom
|
|
|= $: :: aura: flavor of atom
|
|
:: constant: one value, or all values
|
|
::
|
|
aura=term
|
|
constant=(unit @)
|
|
==
|
|
^- spec
|
|
:: if atom is not constant
|
|
::
|
|
?~ constant
|
|
:: %base: flavored atom with arbitrary value
|
|
::
|
|
[%base atom/aura]
|
|
:: %leaf: flavored constant
|
|
::
|
|
[%leaf aura u.constant]
|
|
::
|
|
++ cell
|
|
|= $: :: head: head of cell
|
|
:: tail: tail of cell
|
|
::
|
|
head=spec
|
|
tail=spec
|
|
==
|
|
^- spec
|
|
:: %bscl: raw tuple
|
|
::
|
|
?: ?=(%bscl -.tail)
|
|
[%bscl head +.tail]
|
|
[%bscl head tail ~]
|
|
::
|
|
++ core
|
|
|= $: :: variance: co/contra/in/bi
|
|
:: payload: data
|
|
:: battery: code
|
|
::
|
|
variance=vair
|
|
payload=spec
|
|
battery=(map term spec)
|
|
==
|
|
?- variance
|
|
%lead [%bszp payload battery]
|
|
%gold [%bsdt payload battery]
|
|
%zinc [%bstc payload battery]
|
|
%iron [%bsnt payload battery]
|
|
==
|
|
::
|
|
++ face
|
|
|= $: :: decor: decoration
|
|
:: content: decorated content
|
|
::
|
|
decor=$@(term tune)
|
|
body=spec
|
|
==
|
|
^- spec
|
|
?@ decor [%bsts decor body]
|
|
:: discard aliases, etc
|
|
::
|
|
body
|
|
::
|
|
++ fork
|
|
|= specs=(list spec)
|
|
^- spec
|
|
?< ?=(~ specs)
|
|
[%bswt specs]
|
|
--
|
|
::
|
|
:: type-to-spec
|
|
::
|
|
++ kismet
|
|
|* form=mold
|
|
|= producer=(analyst form)
|
|
=| :: coat: contextual metadata
|
|
::
|
|
$= coat
|
|
$: :: trace: type analysis stack
|
|
::
|
|
trace=(set type)
|
|
==
|
|
=| :: load: accumulating metadata (state)
|
|
::
|
|
load=(cosmetic-state form)
|
|
::
|
|
:: sut: type we're analyzing
|
|
::
|
|
|_ sut/type
|
|
::
|
|
:: +structure: make cosmetic spec from :sut
|
|
::
|
|
++ structure
|
|
^- spec
|
|
:: clear superficial structure and hints
|
|
::
|
|
=. sut |- ^- type
|
|
?. ?=([?(%hint %hold) *] sut) sut
|
|
$(sut ~(repo ut sut))
|
|
::
|
|
:: spec: raw analysis product
|
|
::
|
|
=^ spec load specify
|
|
:: if we didn't block, just use it
|
|
::
|
|
?: =(~ pairs.load) spec
|
|
:: otherwise, insert hygienic recursion
|
|
::
|
|
:+ %bsbs spec
|
|
%- ~(gas by *(map term ^spec))
|
|
%+ turn
|
|
~(tap by pairs.load)
|
|
|= [=type index=@ud spec=^spec]
|
|
[(synthetic index) spec]
|
|
::
|
|
:: +pattern: pattern and context for data inspection
|
|
::
|
|
++ pattern
|
|
^- $: :: main: rendering pattern
|
|
:: context: recursion points by counter
|
|
::
|
|
main=plot
|
|
loop=(map @ud plot)
|
|
==
|
|
!!
|
|
::
|
|
:: +synthetic: convert :number to a synthetic name
|
|
::
|
|
++ synthetic
|
|
|= number=@ud
|
|
^- @tas
|
|
=/ alf/(list term)
|
|
^~ :~ %alf %bet %gim %dal %hej %vav %zay %het
|
|
%tet %yod %kaf %lam %mem %nun %sam %ayn
|
|
%pej %sad %qof %res %sin %tav
|
|
==
|
|
?: (lth number 22)
|
|
(snag number alf)
|
|
(cat 3 (snag (mod number 22) alf) $(number (div number 22)))
|
|
::
|
|
:: +specify: make spec that matches :sut
|
|
::
|
|
++ specify
|
|
^- [spec _load]
|
|
=< entry
|
|
|%
|
|
:: +entry: make spec at potential entry point
|
|
::
|
|
++ entry
|
|
^- [spec _load]
|
|
:: old: old recursion binding for :sut
|
|
::
|
|
=/ old (~(get by pairs.load) sut)
|
|
:: if, already bound, reuse binding
|
|
::
|
|
?^ old [[%loop (synthetic p.u.old)] load]
|
|
:: if, we are already inside :sut
|
|
::
|
|
?: (~(has in trace.coat) sut)
|
|
:: then, produce and record a block reference
|
|
::
|
|
=+ [%loop (synthetic count.load)]
|
|
:- -
|
|
%_ load
|
|
count +(count.load)
|
|
pairs (~(put by pairs.load) sut [count.load -])
|
|
==
|
|
:: else, filter main loop for block promotion
|
|
::
|
|
=^ spec load main(trace.coat (~(put in trace.coat) sut))
|
|
:: check if we re-entered :sut while traversing
|
|
::
|
|
=/ new (~(get by pairs.load) sut)
|
|
:: if, we did not find :sut inside itself
|
|
::
|
|
?~ new
|
|
:: then, :sut is not a true entry point
|
|
::
|
|
[spec load]
|
|
:: else, produce a reference and record the analysis
|
|
::
|
|
:- [%loop (synthetic p.u.new)]
|
|
load(pairs (~(put by pairs.load) sut [p.u.new spec]))
|
|
::
|
|
:: +meta: try to make spec from type of filter
|
|
::
|
|
::++ meta ^- [(unit spec) _load]
|
|
::
|
|
:: +main: make spec from any type
|
|
::
|
|
++ main
|
|
^- [spec _load]
|
|
?- sut
|
|
%void :_(load [%base %void])
|
|
%noun :_(load [%base %noun])
|
|
::
|
|
[%atom *] (atom p.sut q.sut)
|
|
[%cell *] (cell p.sut q.sut)
|
|
[%core *] (core p.sut q.sut)
|
|
[%face *] (face p.sut q.sut)
|
|
[%hint *] =+((rely p.p.sut q.p.sut) ?^(- u.- main(sut q.sut)))
|
|
[%fork *] (fork p.sut)
|
|
[%hold *] entry(sut ~(repo ut sut))
|
|
==
|
|
::
|
|
:: +rely: rationalize structure from type (stub)
|
|
::
|
|
++ rely
|
|
|= [=type =note]
|
|
^- (unit [spec _load])
|
|
?. ?=(%made -.note) ~
|
|
?~ q.note
|
|
`[`spec`[%like [[p.note ~] ~]] load]
|
|
=- `[[%make [%limb p.note] -<] ->]
|
|
|- ^- [(list spec) _load]
|
|
?~ u.q.note [~ load]
|
|
=^ more load $(u.q.note t.u.q.note)
|
|
=/ part (~(play ut type) [%tsld [%limb %$] [%wing i.u.q.note]])
|
|
=^ spec load entry(sut part)
|
|
[[spec more] load]
|
|
::
|
|
:: +atom: convert atomic type to spec
|
|
::
|
|
++ atom
|
|
|= $: :: aura: flavor of atom
|
|
:: constant: one value, or all values
|
|
::
|
|
aura=term
|
|
constant=(unit @)
|
|
==
|
|
:: pure function
|
|
::
|
|
[(atom:producer aura constant) load]
|
|
::
|
|
:: +cell: convert a %cell to a spec
|
|
::
|
|
++ cell
|
|
|= $: :: left: head of cell
|
|
:: rite: tail of cell
|
|
::
|
|
left=type
|
|
rite=type
|
|
==
|
|
^- [spec _load]
|
|
:: head: cosmetic structure of head
|
|
:: tail: cosmetic structure of tail
|
|
::
|
|
=^ head load main(sut left)
|
|
=^ tail load main(sut rite)
|
|
[(cell:producer head tail) load]
|
|
::
|
|
:: +core: convert a %core to a spec
|
|
::
|
|
++ core
|
|
|= $: :: payload: data
|
|
:: battery: code
|
|
::
|
|
payload=type
|
|
battery=coil
|
|
==
|
|
^- [spec _load]
|
|
:: payload-spec: converted payload
|
|
::
|
|
=^ payload-spec load main(sut payload)
|
|
:: arms: all arms in the core, as hoons
|
|
::
|
|
=/ arms
|
|
^- (list (pair term hoon))
|
|
%- zing
|
|
^- (list (list (pair term hoon)))
|
|
%+ turn ~(tap by q.r.battery)
|
|
|= [term =tome]
|
|
~(tap by q.tome)
|
|
:: arm-specs: all arms in the core, as specs
|
|
::
|
|
=^ arm-specs load
|
|
|- ^- [(list (pair term spec)) _load]
|
|
?~ arms [~ load]
|
|
=^ mor load $(arms t.arms)
|
|
=^ les load
|
|
main(sut [%hold [%core payload battery] q.i.arms])
|
|
[[[p.i.arms les] mor] load]
|
|
:: arm-map: all arms in the core, as a a spec map
|
|
::
|
|
=* arm-map (~(gas by *(map term spec)) arm-specs)
|
|
[(core:producer r.p.battery payload-spec arm-map) load]
|
|
::
|
|
:: +face: convert a %face to a +spec
|
|
::
|
|
++ face
|
|
|= $: :: decor: decoration
|
|
:: content: decorated content
|
|
::
|
|
decor=$@(term tune)
|
|
content=type
|
|
==
|
|
^- [spec _load]
|
|
=^ body load main(sut content)
|
|
[(face:producer decor body) load]
|
|
::
|
|
:: +fork: convert a %fork to a +spec
|
|
::
|
|
++ fork
|
|
|= types=(set type)
|
|
^- [spec _load]
|
|
:: type-list: type set as a list
|
|
::
|
|
=/ type-list ~(tap by types)
|
|
:: specs: type set as a list of specs
|
|
::
|
|
=^ specs load
|
|
|- ^- [(list spec) _load]
|
|
?~ type-list [~ load]
|
|
=^ mor load $(type-list t.type-list)
|
|
=^ les load main(sut i.type-list)
|
|
[[les mor] load]
|
|
[(fork:producer specs) load]
|
|
--
|
|
--
|
|
::
|
|
++ plume
|
|
|_ =plum
|
|
::
|
|
:: +flat: print as a single line
|
|
::
|
|
++ flat
|
|
text:linear
|
|
::
|
|
:: +tall: print as multiple lines
|
|
::
|
|
++ tall
|
|
^- wain
|
|
%+ turn window
|
|
|= [indent=@ud text=tape]
|
|
(crip (runt [indent ' '] text))
|
|
::
|
|
:: +adjust: adjust lines to right
|
|
::
|
|
++ adjust
|
|
|= [tab=@ud =(list [length=@ud text=tape])]
|
|
(turn list |=([@ud tape] [(add tab +<-) +<+]))
|
|
::
|
|
:: +window: print as list of tabbed lines
|
|
::
|
|
++ window
|
|
^- (list [indent=@ud text=tape])
|
|
:: memoize for random access
|
|
::
|
|
~+
|
|
:: trivial text
|
|
::
|
|
?@ plum [0 (trip plum)]~
|
|
?- -.plum
|
|
:: %|: text wrap
|
|
::
|
|
%| :: wrapping stub, should wrap text to 40 characters
|
|
::
|
|
[0 +:linear]~
|
|
::
|
|
:: %&: text tree
|
|
::
|
|
%& :: trial: attempt at wide hint
|
|
::
|
|
=/ trial ?~(wide.plum ~ [~ u=linear])
|
|
:: if wide hint is available or optimal
|
|
::
|
|
?: ?& ?=(^ trial)
|
|
?| ?=(~ tall.plum)
|
|
(lte length.u.trial 40)
|
|
== ==
|
|
:: then produce wide hint
|
|
::
|
|
[0 text.u.trial]~
|
|
:: else assert tall style (you gotta set either wide or tall)
|
|
::
|
|
?> ?=(^ tall.plum)
|
|
:: blocks: subwindows
|
|
:: prelude: intro as tape
|
|
::
|
|
=/ blocks (turn list.plum |=(=^plum window(plum plum)))
|
|
=/ prelude (trip intro.u.tall.plum)
|
|
:: if, :indef is empty
|
|
::
|
|
?~ indef.u.tall.plum
|
|
:: then, print in sloping mode
|
|
::
|
|
:: if, no children
|
|
::
|
|
?: =(~ blocks)
|
|
:: then, the prelude if any
|
|
::
|
|
?~(prelude ~ [0 prelude]~)
|
|
:: else, format children and inject any prelude
|
|
::
|
|
^- (list [indent=@ud text=tape])
|
|
:: concatenate child blocks into a single output
|
|
::
|
|
%- zing
|
|
:: count: number of children
|
|
:: index: current child from 1 to n
|
|
::
|
|
=/ count (lent blocks)
|
|
=/ index 1
|
|
|- ^+ blocks
|
|
?~ blocks ~
|
|
:_ $(blocks t.blocks, index +(index))
|
|
^- (list [indent=@ud text=tape])
|
|
:: indent: backstep indentation level
|
|
::
|
|
=/ indent (mul 2 (sub count index))
|
|
:: unless, we're on the first block
|
|
::
|
|
?. =(1 index)
|
|
:: else, apply normal backstep indentation
|
|
::
|
|
(adjust indent i.blocks)
|
|
:: then, apply and/or inject prelude
|
|
::
|
|
:: this fixes the naive representations
|
|
::
|
|
:: :+
|
|
:: foo
|
|
:: bar
|
|
:: baz
|
|
::
|
|
:: and
|
|
::
|
|
:: :-
|
|
:: foo
|
|
:: bar
|
|
::
|
|
=. indent (max indent (add 2 (lent prelude)))
|
|
=. i.blocks (adjust indent i.blocks)
|
|
?~ i.blocks ?~(prelude ~ [0 prelude]~)
|
|
?~ prelude i.blocks
|
|
:_ t.i.blocks
|
|
:- 0
|
|
~| [%indent indent]
|
|
~| [%prelude prelude]
|
|
~| [%kids list.plum]
|
|
~| [%blocks blocks]
|
|
%+ weld prelude
|
|
(runt [(sub indent.i.i.blocks (lent prelude)) ' '] text.i.i.blocks)
|
|
::
|
|
:: else, print in vertical mode
|
|
::
|
|
:: prefix: before each entry
|
|
:: finale: after all entries
|
|
::
|
|
=/ prefix (trip sigil.u.indef.u.tall.plum)
|
|
=/ finale (trip final.u.indef.u.tall.plum)
|
|
:: if, no children, then, just prelude and finale
|
|
::
|
|
?: =(~ blocks)
|
|
%+ weld
|
|
?~(prelude ~ [0 prelude]~)
|
|
?~(finale ~ [0 finale]~)
|
|
:: if, no :prefix
|
|
::
|
|
?: =(~ prefix)
|
|
:: kids: flat list of child lines
|
|
:: tab: amount to indent kids
|
|
::
|
|
=/ kids `(list [indent=@ud text=tape])`(zing blocks)
|
|
=* tab =+((lent prelude) ?+(- 2 %0 0, %1 2, %2 4))
|
|
:: indent kids by tab
|
|
::
|
|
=. kids (turn kids |=([@ud tape] [(add tab +<-) +<+]))
|
|
:: prepend or inject prelude
|
|
::
|
|
=. kids
|
|
?: =(~ prelude) kids
|
|
:: if, no kids, or prelude doesn't fit
|
|
::
|
|
?: |(?=(~ kids) (gte +((lent prelude)) indent.i.kids))
|
|
:: don't inject, just add to head if needed
|
|
::
|
|
[[0 prelude] kids]
|
|
:: inject: prelude
|
|
::
|
|
=* inject %+ weld
|
|
prelude
|
|
%+ runt
|
|
[(sub indent.i.kids (lent prelude)) ' ']
|
|
text.i.kids
|
|
[[0 inject] t.kids]
|
|
:: append finale
|
|
::
|
|
?~ finale kids
|
|
(weld kids ^+(kids [0 finale]~))
|
|
:: else, with :prefix
|
|
::
|
|
:: append :finale
|
|
::
|
|
=- ?~ finale -
|
|
(weld - ^+(- [0 finale]~))
|
|
^- (list [indent=@ud text=tape])
|
|
:: clear: clearance needed to miss prefix
|
|
::
|
|
=/ clear (add 2 (lent prefix))
|
|
%- zing
|
|
:: combine each subtree with the prefix
|
|
::
|
|
%+ turn blocks
|
|
|= =(list [indent=@ud text=tape])
|
|
^+ +<
|
|
:: tab: depth to indent
|
|
::
|
|
=* tab ?~(list 0 (sub clear (min clear indent.i.list)))
|
|
=. list (turn list |=([@ud tape] [(add tab +<-) +<+]))
|
|
?~ list ~
|
|
:_ t.list
|
|
:- 0
|
|
%+ weld
|
|
prefix
|
|
(runt [(sub indent.i.list (lent prefix)) ' '] text.i.list)
|
|
==
|
|
::
|
|
:: +linear: make length and tape
|
|
::
|
|
++ linear
|
|
^- $: length=@ud
|
|
text=tape
|
|
==
|
|
:: memoize for random access
|
|
::
|
|
~+
|
|
:: atomic plums are just text
|
|
::
|
|
?@ plum [(met 3 plum) (trip plum)]
|
|
?- -.plum
|
|
:: %|: text wrap
|
|
::
|
|
%| :: lay the text out flat, regardless of length
|
|
::
|
|
|- ^- [length=@ud text=tape]
|
|
?~ list.plum [0 ~]
|
|
=/ next $(list.plum t.list.plum)
|
|
=/ this [length=(met 3 i.list.plum) text=(trip i.list.plum)]
|
|
:- (add +(length.this) length.next)
|
|
(weld text.this `tape`[' ' text.next])
|
|
::
|
|
:: %&: text tree
|
|
::
|
|
%& :: if there is no wide representation
|
|
::
|
|
?~ wide.plum
|
|
:: then lay out a window, then separate with double-spaces
|
|
::
|
|
=/ window window
|
|
|- ^- [length=@ud text=tape]
|
|
?~ window [0 ~]
|
|
=/ next $(window t.window)
|
|
:- :(add (lent text.i.window) 2 length.next)
|
|
?~(text.next text.i.window :(weld text.i.window " " text.next))
|
|
::
|
|
:: else use wide layout
|
|
::
|
|
=- :: add enclosure if any
|
|
::
|
|
?~ enclose.u.wide.plum body
|
|
=* clamps u.enclose.u.wide.plum
|
|
=/ close [(trip -.clamps) (trip +.clamps)]
|
|
:- :(add length.body (lent -.close) (lent +.close))
|
|
:(weld -.close text.body +.close)
|
|
::
|
|
:: body: body of wide rendering
|
|
::
|
|
^= body
|
|
=/ stop (trip delimit.u.wide.plum)
|
|
|- ^- [length=@ud text=tape]
|
|
?~ list.plum [0 ~]
|
|
=/ next $(list.plum t.list.plum)
|
|
=/ this linear(plum i.list.plum)
|
|
?~ text.next this
|
|
:- :(add length.this (lent stop) length.next)
|
|
:(weld text.this stop text.next)
|
|
==
|
|
--
|
|
:: highly unsatisfactory temporary tank printer
|
|
::
|
|
++ plum-to-tank
|
|
|= =plum
|
|
^- tank
|
|
?@ plum [%leaf (trip plum)]
|
|
?- -.plum
|
|
%| :+ %rose
|
|
["" " " ""]
|
|
(turn list.plum |=(@ta [%leaf (trip +<)]))
|
|
%& =/ list (turn list.plum ..$)
|
|
?~ tall.plum
|
|
?> ?=(^ wide.plum)
|
|
=? enclose.u.wide.plum ?=(~ enclose.u.wide.plum) `['{' '}']
|
|
:+ %rose
|
|
:* (trip delimit.u.wide.plum)
|
|
(trip +<:enclose.u.wide.plum)
|
|
(trip +>:enclose.u.wide.plum)
|
|
==
|
|
list
|
|
?: ?=(^ indef.u.tall.plum)
|
|
:+ %rose
|
|
:* (trip sigil.u.indef.u.tall.plum)
|
|
(weld (trip intro.u.tall.plum) "[")
|
|
(weld "]" (trip final.u.indef.u.tall.plum))
|
|
==
|
|
list
|
|
:+ %palm
|
|
:* (weld (trip intro.u.tall.plum) "(")
|
|
""
|
|
""
|
|
")"
|
|
==
|
|
list
|
|
==
|
|
++ limb-to-plum
|
|
|= =limb
|
|
?@ limb limb
|
|
?- -.limb
|
|
%& (scot %ui p.limb)
|
|
%| (crip (runt [0 p.limb] ?~(q.limb "," (trip u.q.limb))))
|
|
==
|
|
::
|
|
++ wing-to-plum
|
|
|= =wing
|
|
^- plum
|
|
:+ %&
|
|
[`['.' ~] ~]
|
|
(turn wing limb-to-plum)
|
|
::
|
|
++ battery-to-plum
|
|
|= =(map term spec)
|
|
%+ turn ~(tap by map)
|
|
|= [=term =spec]
|
|
:+ %&
|
|
[`[' ' ~] `['' ~]]
|
|
[term (spec-to-plum spec) ~]
|
|
::
|
|
++ core-to-plum
|
|
|= [=knot =spec =(map term spec)]
|
|
^- plum
|
|
:+ %&
|
|
[~ `[knot ~]]
|
|
:~ (spec-to-plum spec)
|
|
:+ %&
|
|
[~ `['' `['++' '--']]]
|
|
(battery-to-plum map)
|
|
==
|
|
::
|
|
++ varying
|
|
|= [intro=knot final=knot]
|
|
[`[' ' `[(cat 3 intro '(') ')']] `[intro `['' final]]]
|
|
::
|
|
++ fixed
|
|
|= @ta
|
|
[`[' ' `[(cat 3 +< '(') ')']] `[+< ~]]
|
|
::
|
|
++ standard
|
|
|= =stud
|
|
^- plum
|
|
?@ stud stud
|
|
:+ %&
|
|
[`['/' ~] ~]
|
|
`(list plum)`[auth.stud type.stud]
|
|
::
|
|
++ hoon-to-plum
|
|
|= =hoon
|
|
^- plum
|
|
:: XX fill this in please
|
|
::
|
|
?: ?=([%limb *] hoon)
|
|
p.hoon
|
|
%hooon
|
|
::
|
|
++ skin-to-plum
|
|
|= =skin
|
|
^- plum
|
|
%skinny
|
|
::
|
|
++ spec-to-plum
|
|
|= =spec
|
|
^- plum
|
|
?- -.spec
|
|
%base ?- p.spec
|
|
%noun '*'
|
|
%cell '^'
|
|
%flag '?'
|
|
%null '~'
|
|
%void '!!'
|
|
[%atom *] (cat 3 '@' p.p.spec)
|
|
==
|
|
%dbug $(spec q.spec)
|
|
%leaf =+((scot p.spec q.spec) ?:(=('~' -) - (cat 3 '%' -)))
|
|
%like &/[[`[':' ~] ~] (turn `(list wing)`+.spec wing-to-plum)]
|
|
%loop (cat 3 '$' p.spec)
|
|
%name $(spec q.spec)
|
|
%made $(spec q.spec)
|
|
%over $(spec q.spec)
|
|
%make =+ (lent q.spec)
|
|
:+ %&
|
|
:- `[' ' `['(' ')']]
|
|
:- ~
|
|
?: |((gth - 3) =(- 0))
|
|
['%:' `['' '==']]
|
|
:_ ~
|
|
?: =(- 3) '%^'
|
|
?: =(- 2) '%+' '%-'
|
|
[(hoon-to-plum p.spec) (turn q.spec ..$)]
|
|
%bsbs (core-to-plum '$$' p.spec q.spec)
|
|
%bsbr &/[(fixed '$|') $(spec p.spec) (hoon-to-plum q.spec) ~]
|
|
%bscb (hoon-to-plum p.spec)
|
|
%bscl :+ %&
|
|
[`[' ' `['[' ']']] `['$:' `['' '==']]]
|
|
(turn `(list ^spec)`+.spec ..$)
|
|
%bscn &/[(varying '$%' '==') (turn `(list ^spec)`+.spec ..$)]
|
|
%bsdt (core-to-plum '$.' p.spec q.spec)
|
|
%bsld &/[(fixed '$<') $(spec p.spec) $(spec q.spec) ~]
|
|
%bsbn &/[(fixed '$>') $(spec p.spec) $(spec q.spec) ~]
|
|
%bshp &/[(fixed '$-') $(spec p.spec) $(spec q.spec) ~]
|
|
%bskt &/[(fixed '$-') $(spec p.spec) $(spec q.spec) ~]
|
|
%bsls &/[(fixed '$+') (standard p.spec) $(spec q.spec) ~]
|
|
%bsnt (core-to-plum '$/' p.spec q.spec)
|
|
%bsmc &/[(fixed '$;') (hoon-to-plum p.spec) ~]
|
|
%bspd &/[(fixed '$&') $(spec p.spec) (hoon-to-plum q.spec) ~]
|
|
%bssg &/[(fixed '$~') (hoon-to-plum p.spec) $(spec q.spec) ~]
|
|
%bstc (core-to-plum '$`' p.spec q.spec)
|
|
%bsts :+ %&
|
|
[`['=' ~] `['$=' ~]]
|
|
:~ (skin-to-plum p.spec)
|
|
$(spec q.spec)
|
|
==
|
|
%bsvt &/[(fixed '$@') $(spec p.spec) $(spec q.spec) ~]
|
|
%bswt :+ %&
|
|
[`[' ' `['?(' ')']] `['$?' `['' '==']]]
|
|
(turn `(list ^spec)`+.spec ..$)
|
|
%bszp (core-to-plum '$.' p.spec q.spec)
|
|
==
|
|
--
|