shrub/gen/analysis.hoon

935 lines
30 KiB
Plaintext
Raw Normal View History

2018-09-10 20:53:19 +03:00
!:
2018-09-06 03:38:36 +03:00
:- %say
2018-09-10 20:52:14 +03:00
|= {^ {{subject=type ~} ~}}
:- %txt
^- wain
=< =/ =spec specify:measure:(enter:an subject)
=/ =plum (spec-to-plum spec)
~(tall plume plum)
2018-09-06 03:38:36 +03:00
|%
2018-09-10 20:52:14 +03:00
::
:: =spec-to-plum: convert $spec to $plum
::
++ 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)
==
2018-09-06 03:38:36 +03:00
:: _an: type analysis gear
::
++ an
=> |%
:: $notebook: type analysis with explicit loops
::
+$ notebook
$: :: xray: analysis record
:: loop-map: loop dictionary
::
=xray
=loop=(map index zray)
==
:: $index: loop index
::
+$ index @ud
::
:: $shape: structural analysis
::
+$ shape
$~ %void
$@ $? :: %atom: any atom
:: %cell: any cell
:: %noun: any noun
:: %void: no nouns
:: %wide: cell with cell head
::
%atom
%cell
%noun
%void
%wide
==
$% :: %constant: constant atom
:: %instance: constant atom head
:: %option: fork of atomic choices
:: %union: fork of atom/tag head, noun/record tail
:: %junction: fork of atom or cell
:: %conjunction: fork of cell with atom or cell head
2018-09-07 05:01:44 +03:00
:: %misjunction: malformed superposition
2018-09-06 03:38:36 +03:00
::
[%constant =atom]
[%instance =atom]
[%option =(map atom xray)]
[%union =(map atom xray)]
[%junction flat=xray deep=xray]
2018-09-07 05:01:44 +03:00
[%conjunction wide=xray tall=xray]
2018-09-06 03:38:36 +03:00
[%misjunction one=xray two=xray]
==
:: $battery: battery analysis
::
+$ battery (map term (pair what (map term xray)))
::
2018-09-10 20:52:14 +03:00
:: $body: metadata (description) and data (structure)
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
+$ body [=meta =data]
::
::
:: $meta: all analysis metadata
::
+$ meta
$: :: shape-unit: geometric analysis
2018-09-06 03:38:36 +03:00
::
:: declare well-known local structural features
:: of .type, including geometry and superposition.
::
=shape=(unit shape)
::
:: pattern-set: well-known patterns
::
:: recognize common structures, containers, etc.
::
=pattern=(set pattern)
::
2018-09-10 20:52:14 +03:00
:: standard-set: compliance declarations
2018-09-06 03:38:36 +03:00
::
=standard=(set stud)
::
2018-09-10 20:52:14 +03:00
:: entry-unit: loop entry point (reverse of .loop-map)
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
=entry=(unit index)
2018-09-06 03:38:36 +03:00
::
:: recipe-set: construction declarations
::
:: recognize symbolic constructions provided by hints.
::
=recipe=(set recipe)
::
:: comment-set: literate comments
::
=comment=(set help)
==
:: $recipe: construction trace (for type printing)
::
+$ recipe
$~ [%direct %$]
$% :: %direct: named structure
:: %synthetic: generic construction
::
[%direct =term]
[%synthetic =term =(list xray)]
==
:: $pattern: common data patterns
::
+$ pattern
$@ $? :: %hoon: $hoon (hoon program)
2018-09-07 05:01:44 +03:00
:: %json: $json (json data)
2018-09-06 03:38:36 +03:00
:: %manx: $manx (xml node)
:: %nock: $nock (nock formula)
:: %path: $path (list @ta)
:: %plum: $plum (printable)
:: %skin: $skin (hoon texture)
:: %spec: $spec (hoon structure)
:: %tape: $tape (list @tD, utf8 string)
:: %tour: $tour (list @c, utf32/nfc grapheme clusters)
:: %type: $type (hoon inference type)
:: %vase: $vase (hoon dynamically-typed value)
:: %wall: $wall (list @t, text line)
::
%hoon
%manx
%nock
%path
%plum
%skin
%spec
%tape
%tour
%type
%vase
==
$% :: %gate: function
:: %gear: multifunction
:: %tree: n-l-r tree (including maps and sets)
:: %list: i-t list
:: %unit: ~-u unit (maybe)
::
[%gate sample=xray product=xray]
[%gear sample=xray context=xray =battery]
[%list item=xray]
[%tree item=xray]
[%unit item=xray]
==
::
2018-09-10 20:52:14 +03:00
:: $data: data structure of direct node
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
+$ data
2018-09-06 03:38:36 +03:00
$~ %void
$@ $? :: %noun: any noun
:: %void: no nouns
::
%noun
%void
==
$% :: %atom: atom, variable constant
:: %cell: ordered pair
:: %core: functional attribute battery
:: %face: name or namespace
:: %fork: superposition
::
[%atom =aura =constant=(unit @)]
[%cell head=xray tail=xray]
[%core =garb =xray =battery]
[%face face=$@(term tune) =xray]
[%fork =(set xray)]
==
::
2018-09-10 20:52:14 +03:00
:: $xray: direct or indirect (index in loop map) view
::
+$ xray $@(index zray)
::
:: $wray: direct xray without type
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
+$ wray [=meta =data]
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
:: $zray: direct xray, complete
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
+$ zray [=type wray]
2018-09-06 03:38:36 +03:00
--
|_ notebook
::
:: |make: constructions
::
+| %make
::
:: =enter: create with first-pass recursion analysis
::
++ enter
|= =type
^+ +>
=< =+ [xray state]=entry
%_ +>+>+
xray xray
loop-map %- ~(gas by *(map index zray))
%+ turn
~(tap by table.state)
|= [* =index =zray]
[index zray]
==
=| $: :: trace: set of holds that current analysis is within
::
trace=(set ^type)
:: state: accumulated state
::
$= state
$: :: count: cumulative loops detected
:: table: loop number and analysis
::
count=@ud
table=(map ^type (pair index zray))
== ==
|%
:: -entry: analyze at possible entry point
::
++ entry
:: ($xray of .type; updated .state)
::
|- ^- [^xray _state]
:: old: existing entry for .type in .table.state
::
=/ old (~(get by table.state) type)
:: if old entry is found in loop table, produce it
::
?^ old [q.u.old state]
:: if .type is already on our stack .trace
::
?: (~(has in trace) type)
:: then produce and record a loop
::
:- count.state
%= state
count :: (count.state incremented to the next unused index)
::
+(count.state)
table :: (table.state with the loop index and stub)
::
(~(put by table.state) type [count.state *zray])
==
:: else compute main analysis loop
::
=^ =^xray state main(trace (~(put in trace) type))
|- ^- [^^xray _state]
?@ xray [xray state]
:: new: any xray we added to .table.state for .type
::
=/ new (~(get by table.state) type)
:: if .new is empty, then .type is not an entry point
::
?~ new [xray state]
2018-09-10 20:52:14 +03:00
:: else add a loop entry meta, and replace stub in table
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
=. entry-unit.meta.xray `p.u.new
?< (~(has by table.state) p.u.new)
2018-09-06 03:38:36 +03:00
[xray state(table (~(put by table.state) type [p.u.new xray]))]
::
:: -main: main analysis without entry control
::
++ main
|^ ^- [^xray _state]
?- type
2018-09-10 20:52:14 +03:00
%void [[type *meta type] state]
%noun [[type *meta type] state]
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
[%atom *] [[type *meta type] state]
2018-09-06 03:38:36 +03:00
[%cell *] =^ hed-xray state $(type p.type)
=^ tyl-xray state $(type q.type)
2018-09-10 20:52:14 +03:00
[[type *meta %cell hed-xray tyl-xray] state]
[%core *] =^ wray state (core p.type q.type)
[[type wray] state]
2018-09-06 03:38:36 +03:00
[%face *] =^ xray state $(type q.type)
2018-09-10 20:52:14 +03:00
[[type *meta %face p.type xray] state]
[%hint *] =^ wray state (hint p.type q.type)
[[type wray] state]
[%fork *] =^ wray state (fork p.type)
[[type wray] state]
2018-09-06 03:38:36 +03:00
[%hold *] entry(type ~(repo ut type))
==
::
:: =core: convert a %core $type to an $xray
::
++ core
|= $: :: payload-type: type of payload data
:: coil: battery source
::
=payload=^type
=coil
==
2018-09-10 20:52:14 +03:00
^- [wray _state]
2018-09-06 03:38:36 +03:00
:: payload-xray: analyzed payload
::
=^ payload-xray state main(type payload-type)
:: chapters: analyzed chapters
::
:: this code looks complicated but is just an overly
:: bulky monadic traverse.
::
=^ chapters=(list (pair term (pair what (map term ^xray)))) state
=/ chapters=(list (pair term tome)) ~(tap by q.r.coil)
|- ^- [(list (pair term (pair what (map term ^xray)))) _state]
?~ chapters [~ state]
=^ more-chapters state $(chapters t.chapters)
=^ this-chapter state
=- :_ ->
:+ p.i.chapters
`what`p.q.i.chapters
(~(gas by *(map term ^xray)) -<)
=/ arms=(list (pair term hoon)) ~(tap by q.q.i.chapters)
|- ^- [(list (pair term ^xray)) _state]
?~ arms [~ state]
=^ more-arms state $(arms t.arms)
=^ this-arm state
main(type [%hold [%core payload-type coil] q.i.arms])
[[[p.i.arms this-arm] more-arms] state]
[[this-chapter more-chapters] state]
:_ state
2018-09-10 20:52:14 +03:00
^- wray
:- *meta
2018-09-06 03:38:36 +03:00
:^ %core
p.coil
payload-xray
(~(gas by *(map term (pair what (map term ^xray)))) chapters)
::
:: =hint: convert a %hint $type to an $xray
::
++ hint
|= $: :: subject-type: subject of note
:: note: hint information
:: content-type: type of hinted content
::
[=subject=^type =note]
=content=^type
==
=^ =^xray state main(type content-type)
2018-09-10 20:52:14 +03:00
|- ^- [wray _state]
?@ xray $(xray (~(got by loop-map) xray))
2018-09-06 03:38:36 +03:00
?- -.note
%help
:_ state
2018-09-10 20:52:14 +03:00
+:xray(comment-set.meta (~(put in comment-set.meta.xray) p.note))
2018-09-06 03:38:36 +03:00
::
%know
:_ state
2018-09-10 20:52:14 +03:00
+:xray(standard-set.meta (~(put in standard-set.meta.xray) p.note))
2018-09-06 03:38:36 +03:00
::
%made
=^ =recipe state
?~ q.note
:_(state [%direct p.note])
=- [`recipe`[%synthetic p.note -<] `_state`->]
|- ^- [(list ^^xray) _state]
?~ u.q.note [~ state]
=/ part
(~(play ut subject-type) [%tsld [%limb %$] [%wing i.u.q.note]])
=^ this state entry(type part)
=^ more state $(u.q.note t.u.q.note)
[[this more] state]
:_ state
2018-09-10 20:52:14 +03:00
+:xray(recipe-set.meta (~(put in recipe-set.meta.xray) recipe))
2018-09-06 03:38:36 +03:00
==
::
:: +fork: convert a %fork $type to an $xray
::
++ fork
|= :: set: set of union types
::
=(set ^type)
2018-09-10 20:52:14 +03:00
^- [wray _state]
2018-09-06 03:38:36 +03:00
=/ list ~(tap in set)
2018-09-10 20:52:14 +03:00
=- :_(-> `wray`[*meta %fork (~(gas in *(^set ^xray)) -<)])
2018-09-06 03:38:36 +03:00
|- ^- [(^list ^xray) _state]
?~ list [~ state]
=^ this-xray state main(type i.list)
=^ more-xrays state $(list t.list)
[[this-xray more-xrays] state]
--
--
::
:: |grow: continuations
::
+| %grow
::
:: -measure: add shape to metadata, possibly restructuring
::
++ measure
|- ^+ +
=< +>(+< complete:analyze)
|%
++ complete `notebook`+>+<
::
:: -remember: save measured xray in loop map as needed
::
++ remember
^+ .
?: ?=(@ xray) .
2018-09-10 20:52:14 +03:00
?~ entry-unit.meta.xray .
.(loop-map (~(put by loop-map) u.entry-unit.meta.xray xray))
2018-09-06 03:38:36 +03:00
::
:: -require: produce best currently available shape
::
++ require
|- ^- shape
:: resolve indirections
::
2018-09-10 20:52:14 +03:00
?@ xray $(xray (~(got by loop-map) xray))
2018-09-06 03:38:36 +03:00
:: produce already-computed shape
::
?^ shape-unit.meta.xray u.shape-unit.meta.xray
:: (minimal shape which has not angered the recursion gods)
::
^- shape
?- -.data.xray
%atom
?~ constant-unit.data.xray
%atom
[%constant u.constant-unit.data.xray]
::
%cell
=/ head-shape $(xray head.data.xray)
?: ?| ?=(?(%cell %wide) head-shape)
?=([?(%instance %union %junction %conjunction) *] head-shape)
==
%wide
?: ?=([%constant *] head-shape)
[%instance atom.head-shape]
%cell
::
%core %cell
%face $(xray xray.data.xray)
2018-09-07 05:01:44 +03:00
%fork $(xray (forge ~(tap in set.data.xray)))
2018-09-06 03:38:36 +03:00
==
::
2018-09-10 20:52:14 +03:00
:: -original: produce $type of xray
2018-09-06 03:38:36 +03:00
::
2018-09-10 20:52:14 +03:00
++ original
|- ^- type
?@(xray $(xray (~(got by loop-map) xray)) type.xray)
2018-09-07 05:01:44 +03:00
::
2018-09-10 20:52:14 +03:00
:: -fresh: produce trivial fork set if any
2018-09-07 05:01:44 +03:00
::
2018-09-10 20:52:14 +03:00
++ fresh
^- (unit (set ^xray))
?@ xray ~
?. ?=(%fork -.data.xray) ~
?^ entry-unit.meta.xray ~
`set.data.xray
2018-09-07 05:01:44 +03:00
::
2018-09-10 20:52:14 +03:00
:: =join: compose union of two xrays, collapsing simple forks
2018-09-07 05:01:44 +03:00
::
++ join
|= [this=^xray that=^xray]
^- ^xray
2018-09-10 20:52:14 +03:00
:- (fork original(xray this) original(xray that) ~)
:- *meta
^- data
:- %fork
^- (set ^xray)
=/ this-set-unit fresh(xray this)
=/ that-set-unit fresh(xray that)
?~ this-set-unit
?~ that-set-unit
(sy this that ~)
(~(put in u.that-set-unit) this)
?~ that-set-unit
(~(put in u.this-set-unit) that)
(~(uni in u.this-set-unit) u.that-set-unit)
2018-09-07 05:01:44 +03:00
::
2018-09-06 03:38:36 +03:00
:: =binary: compose binary junction/conjunction/misjunction
::
++ binary
|* joint=?(%junction %conjunction %misjunction)
|= [this=^xray that=^xray]
^- [shape ^xray]
[[joint this that] (join this that)]
::
:: -frame: computed shape with xray
::
++ frame `[shape ^xray]`[require xray]
::
:: =merge: merge two xrays intelligently, using shape
::
++ merge
|= [this=^xray that=^xray]
^- ^xray
=+ (combine frame(xray this) frame(xray that))
?@(-> -> ->(shape-unit.meta `-<))
::
2018-09-07 05:01:44 +03:00
:: =collate: merge option maps
::
++ collate
|= [thick=(map atom ^xray) thin=(map atom ^xray)]
=/ list ~(tap by thin)
|- ^- (map atom ^xray)
?~ list thick
=/ item (~(get by thick) p.i.list)
%= $
list t.list
thick
%+ ~(put by thick)
p.i.list
?~(item q.i.list (merge u.item q.i.list))
==
::
:: =forge: combine list of shape-described xrays
::
++ forge
|= =(list ^xray)
2018-09-10 20:52:14 +03:00
=/ new-xray `^xray`[%void *meta %void]
2018-09-07 05:01:44 +03:00
|- ^- ^xray
?~ list new-xray
$(list t.list, new-xray (merge i.list new-xray))
::
2018-09-06 03:38:36 +03:00
:: =combine: combine shape-described xrays
::
++ combine
|= [this=[=shape =^xray] that=[=shape =^xray]]
^- [shape ^xray]
?@ shape.this
?^ shape.that $(this that, that this)
:_ (join xray.this xray.that)
?: =(shape.this shape.that) shape.this
?: ?=(%void shape.this) shape.that
?: ?=(%void shape.that) shape.this
?: |(?=(%noun shape.this) ?=(%noun shape.that)) %noun
?- shape.this
%atom [%junction xray.this xray.that]
%cell ?: ?=(%wide shape.that)
%cell
[%junction xray.that xray.this]
%wide ?: ?=(%cell shape.that)
%cell
[%junction xray.that xray.this]
==
?@ shape.that
?: ?=(%void shape.that) this
?: ?=(%noun shape.that) that
?: ?=(%atom shape.that)
?+ -.shape.this
((binary %misjunction) xray.this xray.that)
%instance ((binary %junction) xray.this xray.that)
%union ((binary %junction) xray.this xray.that)
%junction %+ (binary %junction)
(merge xray.that flat.shape.this)
deep.shape.this
==
?+ -.shape.this
((binary %misjunction) xray.this xray.that)
%constant ((binary %junction) xray.that xray.this)
%option ((binary %junction) xray.that xray.this)
%junction %+ (binary %junction)
flat.shape.this
(merge xray.that deep.shape.this)
==
?: |(?=(%misjunction -.shape.this) ?=(%misjunction -.shape.that))
((binary %misjunction) xray.this xray.that)
?- -.shape.this
%constant
?- -.shape.that
%constant :_ (join xray.this xray.that)
:- %option
2018-09-07 05:01:44 +03:00
%+ collate
[[atom.shape.this xray.this] ~ ~]
[[atom.shape.that xray.that] ~ ~]
%instance ((binary %junction) xray.this xray.that)
%option ((binary %misjunction) xray.this xray.that)
%union ((binary %junction) xray.this xray.that)
%junction %+ (binary %junction)
(merge xray.this flat.shape.that)
deep.shape.that
%conjunction ((binary %junction) xray.this xray.that)
2018-09-06 03:38:36 +03:00
==
::
%instance
?+ -.shape.that $(this that, that this)
2018-09-07 05:01:44 +03:00
%instance :_ (join xray.this xray.that)
:- %union
%+ collate
[[atom.shape.this xray.this] ~ ~]
[[atom.shape.that xray.that] ~ ~]
%option ((binary %junction) xray.this xray.that)
%union :_ (join xray.this xray.that)
:- %union
%+ collate
map.shape.that
[[atom.shape.this xray.this] ~ ~]
%junction %+ (binary %junction)
flat.shape.that
(merge xray.this deep.shape.that)
%conjunction %+ (binary %junction)
wide.shape.that
(merge xray.this tall.shape.that)
2018-09-06 03:38:36 +03:00
==
::
%option
?+ -.shape.that $(this that, that this)
2018-09-07 05:01:44 +03:00
%option :_ (join xray.this xray.that)
:- %option
(collate map.shape.this map.shape.that)
%union ((binary %junction) xray.this xray.that)
%junction %+ (binary %junction)
(merge xray.this flat.shape.that)
deep.shape.that
%conjunction ((binary %junction) xray.this xray.that)
2018-09-06 03:38:36 +03:00
==
::
%union
?+ -.shape.that $(this that, that this)
2018-09-07 05:01:44 +03:00
%union :_ (join xray.this xray.that)
:- %union
(collate map.shape.this map.shape.that)
%junction %+ (binary %junction)
flat.shape.that
(merge xray.this deep.shape.that)
%conjunction %+ (binary %conjunction)
wide.shape.that
(merge xray.this tall.shape.that)
2018-09-06 03:38:36 +03:00
==
::
%junction
?+ -.shape.that $(this that, that this)
2018-09-07 05:01:44 +03:00
%junction %+ (binary %junction)
(merge flat.shape.this flat.shape.that)
(merge deep.shape.this deep.shape.that)
%conjunction %+ (binary %junction)
flat.shape.this
(merge deep.shape.this xray.that)
2018-09-06 03:38:36 +03:00
==
::
%conjunction
?+ -.shape.that $(this that, that this)
2018-09-07 05:01:44 +03:00
%conjunction %+ (binary %conjunction)
(merge wide.shape.this wide.shape.that)
(merge tall.shape.this tall.shape.that)
2018-09-06 03:38:36 +03:00
==
==
::
:: -analyze
::
++ analyze
:: afterward, record result in loop map as needed
::
=< remember
:: loop-set: set of loops we are analyzing
::
=| loop-set=(set index)
|- ^+ +>
:: if .xray is a loop reference
::
?@ xray
:: zray: direct target of indirect .xray
::
2018-09-10 20:52:14 +03:00
=/ =zray (~(got by loop-map) xray)
2018-09-06 03:38:36 +03:00
:: if we have already measured .zray, do nothing
::
?^ shape-unit.meta.zray +>+
:: otherwise, measure it eagerly; it will save itself
::
+>+(loop-map loop-map:complete:analyze(xray zray))
:: if we've already measured this xray, do nothing
::
?^ shape-unit.meta.xray +>
:: if we're currently measuring this xray, do nothing
::
2018-09-10 20:52:14 +03:00
?: ?& ?=(^ entry-unit.meta.xray)
(~(has in loop-set) u.entry-unit.meta.xray)
==
+>
2018-09-06 03:38:36 +03:00
:: record any loops we enter
::
2018-09-10 20:52:14 +03:00
=. loop-set ?~ entry-unit.meta.xray loop-set
(~(put in loop-set) u.entry-unit.meta.xray)
2018-09-06 03:38:36 +03:00
:: %noun and %void are their own shape
::
?@ data.xray +>(shape-unit.meta.xray `data.xray)
?- -.data.xray
%atom
+>(shape-unit.meta.xray `require)
::
%cell
=^ head loop-map complete:analyze(xray head.data.xray)
=^ tail loop-map complete:analyze(xray tail.data.xray)
=. head.data.xray head
=. tail.data.xray tail
+>+>(shape-unit.meta.xray `require)
::
%core
::
:: this code looks complicated but is just an overly
:: bulky monadic traverse.
::
=^ payload loop-map complete:analyze(xray xray.data.xray)
=^ chapters loop-map
=/ chapters ~(tap by battery.data.xray)
|- ^+ [chapters loop-map]
?~ chapters [~ loop-map]
=^ more-chapters loop-map $(chapters t.chapters)
=^ this-chapter loop-map
=- :_ ->
:+ p.i.chapters
`what`p.q.i.chapters
(~(gas by *(map term ^xray)) -<)
=/ arms=(list (pair term ^xray)) ~(tap by q.q.i.chapters)
|- ^- [(list (pair term ^xray)) _loop-map]
?~ arms [~ loop-map]
=^ more-arms loop-map $(arms t.arms)
=^ this-arm loop-map complete:analyze(xray q.i.arms)
[[[p.i.arms this-arm] more-arms] loop-map]
[[this-chapter more-chapters] loop-map]
=. xray.data.xray payload
=. battery.data.xray (~(gas by *battery) chapters)
+>+>(shape-unit.meta.xray `%cell)
::
%face
=^ body loop-map complete:analyze(xray xray.data.xray)
=. xray.data.xray body
+>+(shape-unit.meta.xray `require(xray body))
::
%fork
2018-09-07 05:01:44 +03:00
=^ list loop-map
=/ list ~(tap in set.data.xray)
|- ^- [(^list ^xray) _loop-map]
?~ list [~ loop-map]
=^ this loop-map complete:analyze(xray i.list)
=^ rest loop-map $(list t.list)
[[this rest] loop-map]
=/ new-xray (forge list)
?@ new-xray +>+>(xray new-xray)
2018-09-10 20:52:14 +03:00
+>+>(xray new-xray(entry-unit.meta entry-unit.meta.xray))
2018-09-06 03:38:36 +03:00
==
--
::
:: -match: refine pattern analysis
::
++ match
|- ^+ +
2018-09-10 20:52:14 +03:00
:: (self with $pattern metadata on every relevant $xray)
2018-09-06 03:38:36 +03:00
::
!!
::
:: |take: completions
::
+| %take
::
2018-09-10 20:52:14 +03:00
:: -specify: convert to spec
2018-09-06 03:38:36 +03:00
::
++ specify
2018-09-10 20:52:14 +03:00
=| loop-set=(set index)
2018-09-06 03:38:36 +03:00
|- ^- spec
2018-09-10 20:52:14 +03:00
?@ xray
?: (~(has in loop-set) xray)
[%loop (synthetic xray)]
$(xray (~(got by loop-map) xray))
?^ entry-unit.meta.xray
=/ =spec $(entry-unit.meta.xray ~)
:+ %bsbs
spec
[[(synthetic u.entry-unit.meta.xray) spec] ~ ~]
?^ recipe-set.meta.xray
=/ =recipe n.recipe-set.meta.xray
?- -.recipe
%direct `spec`[%like `wing`[term.recipe ~] ~]
%synthetic :+ %make
[%limb term.recipe]
%+ turn list.recipe
|=(=^xray `spec`^$(xray xray))
==
?@ data.xray [%base data.xray]
?- -.data.xray
%atom ?~ constant-unit.data.xray
[%base %atom aura.data.xray]
?: &(=(%n aura.data.xray) =(`@`0 u.constant-unit.data.xray))
[%base %null]
[%leaf aura.data.xray u.constant-unit.data.xray]
%cell =/ head $(xray head.data.xray)
=/ tail $(xray tail.data.xray)
?: &(=([%base %noun] head) =([%base %noun] tail))
[%base %cell]
?: ?=(%bscl -.tail)
[%bscl head +.tail]
[%bscl head tail ~]
%core =/ payload $(xray xray.data.xray)
=/ battery
^- (map term spec)
%- ~(run by (flatten-battery battery.data.xray))
|= =^xray
^$(xray xray)
?- r.garb.data.xray
%lead [%bszp payload battery]
%gold [%bsdt payload battery]
%zinc [%bstc payload battery]
%iron [%bsnt payload battery]
==
%face =/ =spec $(xray xray.data.xray)
:: we discard the $tune case, a $spec can't express it
::
:: XX: should exist a %misjunction spec
::
?^(face.data.xray spec [%bsts face.data.xray spec])
%fork =/ =shape (need shape-unit.meta.xray)
|^ ?+ shape ~|([%strange-fork-shape shape] !!)
[%option *] [%bswt choices]
[%union *] [%bscn choices]
[%junction *] :+ %bsvt
^$(xray flat.shape)
^$(xray deep.shape)
[%conjunction *] :+ %bskt
^$(xray wide.shape)
^$(xray tall.shape)
[%misjunction *] [%bswt choices]
==
::
++ choices
^- [i=spec t=(list spec)]
=- ?>(?=(^ -) -)
(turn ~(tap in set.data.xray) |=(=^xray ^^$(xray xray)))
--
==
::
:: -display: convert to plum via spec
2018-09-06 03:38:36 +03:00
::
++ display
|- ^- plum
!!
:: =present: convert noun to plum
::
++ present
|= =noun
^- plum
!!
::
:: |work: productions
::
+| %work
++ foo %bar
::
:: |tool: functions
::
+| %tool
2018-09-10 20:52:14 +03:00
::
:: =flatten-battery: temporary function (XX)
::
:: $spec should have chapters but it doesn't. so we flatten.
::
++ flatten-battery
|= =battery
=/ chapter-list ~(tap by battery)
|- ^- (map term ^xray)
?~ chapter-list ~
(~(uni by q.q.i.chapter-list) $(chapter-list t.chapter-list))
::
:: =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)))
2018-09-06 03:38:36 +03:00
--
--