urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-12 10:29:01 +03:00
Code Issues Packages Projects Releases Wiki Activity

Preparing to integrate new ford.

Browse Source
This commit is contained in:
C. Guy Yarvin 2014-07-17 13:56:08 -07:00
parent b9b6d522b9
commit f3e3eb01e0
2 changed files with 51 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

245
arvo/ford.hoon
View File

@ -11,27 +11,20 @@
$% [%made p=(each bead (list tank))] :: computed result $% [%made p=(each bead (list tank))] :: computed result
== :: == ::
++ hood :: assembly plan ++ hood :: assembly plan
$: sys=$|(@ud [@ud @ud]) :: system kelvin $: sum=@t :: summary text
pro=(map term beam) :: protocols mol=(map term beam) :: models
lib=(map term beam) :: libraries res=(map logo (map term beam)) :: data resources
:: res=(map term (trel horn beam path)) :: resource trees sys=$|(@ud [@ud @ud]) :: system version
src=(list hoop) :: program gel=(list hoop) :: telescoping stack
== :: == ::
++ hoop :: source in hood ++ hoop :: source in hood
$% [%code p=twig] :: direct twig $% [%code p=twig] :: direct twig
[%cone p=beam] :: core from folder [%cone p=beam] :: core from folder
[%coop p=(map term hoop)] :: complex core [%coop p=(map term hoop)] :: complex core
[%hood p=beam] :: recursive hood [%hood p=hood] :: recursive hood
[%hoon p=beam] :: load %hoon
[%text p=@] :: direct text [%text p=@] :: direct text
== :: == ::
++ horn :: resource tree
$| ~ :: leaf
$% [%day p=horn] :: list by time
[%fan p=(map term horn)] :: tuple
[%for p=logo q=horn] :: leaf protocol
[%hub p=horn] :: list by number
[%nap p=horn] :: soft map
== ::
++ kiss :: in request ->$ ++ kiss :: in request ->$
$% [%exec p=@p q=(unit silk)] :: make / kill $% [%exec p=@p q=(unit silk)] :: make / kill
== :: == ::
@ -58,11 +51,10 @@
[%cast p=logo q=beak r=silk] :: translate [%cast p=logo q=beak r=silk] :: translate
[%done p=(set beam) q=cage] :: literal [%done p=(set beam) q=cage] :: literal
[%dude p=tank q=silk] :: error wrap [%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit cage)] :: unit literal [%dune p=(set beam) q=(unit cage)] :: unit literal
[%mute p=silk q=(list (pair wing silk))] :: mutant [%mute p=silk q=(list (pair wing silk))] :: mutant
[%plan p=silk q=hood] :: structured build
[%reef ~] :: kernel reef [%reef ~] :: kernel reef
[%ride p=silk q=sill] :: obsolete old plan [%ride p=silk q=sill] :: twig construction
[%vale p=logo q=sack r=*] :: validate [our his] [%vale p=logo q=sack r=*] :: validate [our his]
== :: == ::
++ sill :: code construction ++ sill :: code construction
@ -110,9 +102,8 @@
dep=(set beam) :: dependencies dep=(set beam) :: dependencies
== :: == ::
++ calx :: concrete cache line ++ calx :: concrete cache line
$% [%hood p=calm q=(pair path cage) r=hood] :: compile to hood $% [%comp p=calm q=(pair path cage) r=twig] :: compile by text
[%slap p=calm q=[p=vase q=twig] r=vase] :: slap [%slap p=calm q=[p=vase q=twig] r=vase] :: slap
[%twig p=calm q=(pair path cage) r=twig] :: compile to twig
== :: == ::
++ task :: problem in progress ++ task :: problem in progress
$: nah=duct :: cause $: nah=duct :: cause
@ -125,7 +116,7 @@
|* sem=* :: a typesystem hack |* sem=* :: a typesystem hack
|= cax=calx |= cax=calx
?+ sem !! ?+ sem !!
%twig ?>(?=(%twig -.cax) r.cax) %comp ?>(?=(%comp -.cax) r.cax)
%slap ?>(?=(%slap -.cax) r.cax) %slap ?>(?=(%slap -.cax) r.cax)
== ==
:: ::
@ -365,29 +356,17 @@
|= gef=gift |= gef=gift
%_(+> mow :_(mow [hen %give gef])) %_(+> mow :_(mow [hen %give gef]))
:: ::
++ fade :: compile %hood ++ fade :: compile
|= [cof=cafe kas=silk]
^- (bolt hood)
%. [cof %hoon kas]
(fado |=(a=path (ifix [gay gay] hall:(vang | a))))
::
++ fane :: compile %hoon
|= [cof=cafe kas=silk] |= [cof=cafe kas=silk]
^- (bolt twig) ^- (bolt twig)
%. [cof %hoon kas] =+ pax=(home kas)
(fado |=(a=path (ifix [gay gay] tall:(vang | a)))) %+ (clef %comp) (maid cof pax kas)
::
++ fado :: compile by rule
|* lur=$+(path rule)
|= [cof=cafe for=logo kas=silk]
%+ (clef %twig) (maid cof kas)
^- (burg (pair path cage) twig) ^- (burg (pair path cage) twig)
|= [cof=cafe pay=(pair path cage)] |= [cof=cafe pay=(pair path cage)]
?. |(=(for p.q.pay) =(%noun p.q.pay))
(flaw cof [%leaf "source error: {<p.pay>} must be %{<(trip for)>}"])
?. ?=(@ q.q.q.pay) ?. ?=(@ q.q.q.pay)
(flaw cof [%leaf "source error: {<p.pay>} must be flat"]~) (flaw cof ~)
=+ vex=((full (lur p.pay)) [[1 1] (trip q.q.q.pay)]) =+ rul=(ifix [gay gay] tall:(vang | pax))
=+ vex=((full rul) [[1 1] (trip q.q.q.pay)])
?~ q.vex ?~ q.vex
(flaw cof [%leaf "syntax error: {<p.p.vex>} {<q.p.vex>}"] ~) (flaw cof [%leaf "syntax error: {<p.p.vex>} {<q.p.vex>}"] ~)
(fine cof p.u.q.vex) (fine cof p.u.q.vex)
@ -396,9 +375,9 @@
|= [cof=cafe sil=sill] |= [cof=cafe sil=sill]
^- (bolt twig) ^- (bolt twig)
?+ -.sil !! ?+ -.sil !!
%dire (fane cof [%done ~ [%atom [%atom %$] p.sil]]) %dire (fade cof [%done ~ [%atom [%atom %$] p.sil]])
%dirt (fine cof p.sil) %dirt (fine cof p.sil)
%drag (fane cof [%boil %hoon p.sil q.sil]) %drag (fade cof [%boil %hoon p.sil q.sil])
%drug %+ cope (make cof p.sil) %drug %+ cope (make cof p.sil)
|= [cof=cafe cay=cage] |= [cof=cafe cay=cage]
(fine cof (twig q.q.cay)) (fine cof (twig q.q.cay))
@ -451,9 +430,12 @@
++ krab :: load to vase ++ krab :: load to vase
|= [cof=cafe for=logo how=logo bem=beam rem=spur] |= [cof=cafe for=logo how=logo bem=beam rem=spur]
^- (bolt vase) ^- (bolt vase)
%+ cope (fane cof %bake how bem rem) %+ cope (fade cof %bake how bem rem)
|= [cof=cafe gen=twig] |= [cof=cafe gen=twig]
(maim cof pit gen) (maim cof pit gen)
:: %+ cope (maim cof pit gen)
:: |= [cof=cafe gat=vase]
:: (maul cof gat !>([`beak`[p.bem q.bem r.bem] for +:s.bem rem]))
:: ::
++ lace :: load and check ++ lace :: load and check
|= [cof=cafe for=logo bem=beam rem=spur] |= [cof=cafe for=logo bem=beam rem=spur]
@ -627,24 +609,11 @@
^$(cof cof, for i.yaw, yaw t.yaw, vax yed) ^$(cof cof, for i.yaw, yaw t.yaw, vax yed)
:: ::
++ maid :: make with path tag ++ maid :: make with path tag
|= [cof=cafe kas=silk] |= [cof=cafe pax=path kas=silk]
^- (bolt (pair path cage)) ^- (bolt (pair path cage))
%+ cope (make cof kas) %+ cope (make cof kas)
|= [cof=cafe cay=cage] |= [cof=cafe cay=cage]
(fine cof (home kas) cay) (fine cof pax cay)
::
++ maim :: slap
|= [cof=cafe vax=vase gen=twig]
^- (bolt vase)
%+ (clef %slap) (fine cof vax gen)
|= [cof=cafe vax=vase gen=twig]
=+ puz=(mule |.((~(mint ut p.vax) [%noun gen])))
?- -.puz
| (flaw cof p.puz)
& %+ (coup cof) (mock [q.vax q.p.puz] (mole ska))
|= val=*
`vase`[p.p.puz val]
==
:: ::
++ make :: reduce silk ++ make :: reduce silk
|= [cof=cafe kas=silk] |= [cof=cafe kas=silk]
@ -715,11 +684,6 @@
$(kas [%done p.kas u.q.kas]) $(kas [%done p.kas u.q.kas])
:: ::
%mute (kale cof p.kas q.kas) %mute (kale cof p.kas q.kas)
%plan
%+ cope (main cof p.kas)
|= [cof=cafe vax=vase]
(fine cof [%noun vax])
::
%reef (fine cof %noun pit) %reef (fine cof %noun pit)
%ride %ride
%+ cool |.(leaf/"ford: ride {<`@p`(mug kas)>}") %+ cool |.(leaf/"ford: ride {<`@p`(mug kas)>}")
@ -740,6 +704,19 @@
(fine cof `cage`[p.kas u.vux]) (fine cof `cage`[p.kas u.vux])
== ==
:: ::
++ maim :: slap
|= [cof=cafe vax=vase gen=twig]
^- (bolt vase)
%+ (clef %slap) (fine cof vax gen)
|= [cof=cafe vax=vase gen=twig]
=+ puz=(mule |.((~(mint ut p.vax) [%noun gen])))
?- -.puz
| (flaw cof p.puz)
& %+ (coup cof) (mock [q.vax q.p.puz] (mole ska))
|= val=*
`vase`[p.p.puz val]
==
::
++ maul :: slam ++ maul :: slam
|= [cof=cafe gat=vase sam=vase] |= [cof=cafe gat=vase sam=vase]
^- (bolt vase) ^- (bolt vase)
@ -751,152 +728,6 @@
`vase`[p.top val] `vase`[p.top val]
== ==
:: ::
++ plow :: true build
|= [cof=cafe pix=vase hyd=hood]
=| :* rop=(map term twig)
bil=(map term (trel beam (set term) twig))
ser=(map logo (map term vase)) :: XX update for horn
==
=< apex
|%
++ abet :: emit as vase
|= [gen=twig rex=vase]
^- (bolt vase)
%+ cope acme
|= [cof=cafe lib=twig]
%+ cope (maim cof pix [%tsgr able lib])
|= [cof=cafe vax=vase]
(maim cof ?~(ser vax (slop acta vax)) gen)
::
++ able :: assemble preamble
^- twig
?~(rop [%$ 1] [%brcn (~(run by rop) |=(a=twig [%ash a]))])
::
++ acta :: assemble resources
^- vase
=< apex
|%
++ apex
?~ ser !!
=+ top=(ayah p.n.ser (axel q.n.ser))
?~ l.ser
?~(r.ser top (slop top apex(ser r.ser)))
=+ lef=apex(ser l.ser)
?~(r.ser (slop lef top) :(slop lef top apex(ser r.ser)))
::
++ axel
|= ryz=(map term vase)
^= vax
|- ^- vase
?~ ryz !!
=+ top=(ayah n.ryz)
?~ l.ryz
?~(r.ryz top (slop top $(ryz r.ryz)))
=+ lef=$(ryz r.ryz)
?~(r.ryz (slop lef top) :(slop lef top $(ryz r.ryz)))
::
++ ayah
|= [cog=term vax=vase]
[[%face cog p.vax] q.vax]
--
::
++ acme :: libraries in order
^- (bolt twig)
%- cope
:_ |= [cof=cafe cus=(list twig)]
(fine cof [%tssg cus])
=+ kop=(turn (~(tap by bil) ~) |=([term *] -))
=| [dun=(set term) cus=(list twig)]
|- ^- (bolt (list twig))
?~ kop (fine cof cus)
=+ cog=i.kop
?: (~(has in dun) cog) $(kop t.kop)
=+ liv=`(set term)`[cog ~ ~]
|- ^- (bolt (list twig))
=+ zic=(need (~(get by bil) cog))
=+ dez=`(list term)`(~(tap in q.zic) ~)
|- ^- (bolt (list twig))
?~ dez
^^$(cus [p.zic cus], dun (~(put in dun) cog), kop t.kop)
?: (~(has in dun) i.dez)
$(dez t.dez)
?: (~(has in liv) cog)
(flaw cof [%leaf "build error: {<cog>} depends on itself}"])
^$(cog i.dez, liv (~(put in liv) cog), kop [i.kop kop])
::
++ aloe :: process all
^- (bolt (trel vase twig ,_..aloe))
%+ cope body
|= [cof=cafe cus=(list twig) sel=_..aloe]
=. ..aloe sel(cof cof)
%+ cope head
|= [cof=cafe sel=_..aloe]
=. ..aloe sel(cof cof)
%+ cope butt
|= [cof=cafe sel=_..aloe]
:: =. ..aloe sel(cof cof)
:: %+ cope eyes
:: |= [cof=cafe pix=vase sel=_..aloe]
:: (fine cof [%tssg (flop cus)] pix sel(cof cof))
(fine cof [%tssg (flop cus)] !>(~) sel(cof cof))
::
++ apex :: top level
^- (bolt vase)
%+ cope aloe
|= [cof=cafe cus=(list twig) sel=_..aloe]
(abet:sel(cof cof) cus)
::
++ body :: process body
=+ cus=(list twig)
|- ^- (bolt (pair (list twig) ,_..body))
?~ src.hyd
(fine cof cus ..body)
%+ cope (wilt i.src.hyd)
|= [cof=cafe gen=twig sel=_..body]
$(src.hyd t.src.hyd, cus [gen cus], ..body sel(cof cof))
::
++ butt :: process libraries
=+ bol=(~(tap by lib.hyd) ~)
|- ^- (bolt ,_..butt)
?~ bol ..butt
?. =+ olb=(~(get by bil) p.i.bol)
?~ olb &
=(`beam`p.u.olb `beam`q.i.bol)
(flaw cof [%leaf "build error: {<p.i.bol>} {<p.u.olb>} {<q.i.bol>}]~)
%+ cope (wine q.i.bol)
|= [cof=cafe gen=twig dep=(set term) dah=hood]
^$(olb
::
++ wilt :: process body entry
|= hop=hoop
^- (bolt ,[p=twig q=_..wilt])
?+ -.hop !!
%code (fine p.hop ..wilt)
%hoon (wine p.hop)
==
::
++ wind :: sub-hood, no deps
|= bem=beam
^- (bolt ,[p=twig r=_..wind])
%+ cope (fade cof %bake %hoon bem ~)
|= [cof=cafe dah=hood]
%+ cope aloe(hyd dah)
|= [cof=cafe cus=(list twig) sel=_..wind]
(fine [%tssg (flop cus)] sel(hyd hyd, cof cof))
::
++ wine :: sub-hood, deps
|= bem=beam
^- (bolt ,[p=twig q=(set term) r=_..wind])
%+ cope (fade cof %bake %hoon bem ~)
|= [cof=cafe dah=hood]
%+ cope aloe(hyd dah, lib ~)
|= [cof=cafe cus=(list twig) sel=_..wind]
%^ fine
[%tssg (flop cus)]
lib.sel
sel(hyd hyd, lib (~(uni in lib.sel) lib), cof cof)
--
::
++ resp ++ resp
|= [tik=@ud rot=riot] |= [tik=@ud rot=riot]
^+ ..zo ^+ ..zo

38
arvo/hoon.hoon
View File

@ -1221,7 +1221,7 @@
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 2cG, floating point :: :: section 2cG, floating point ::
:: ::
++ rlyd |= red=@rd ^- [s=? h=@ f=@ e=(unit tape) n=?] !: ++ rlyd |= red=@rd ^- [s=? h=@ f=@ e=(unit tape) n=?]
~& [%rlyd `@ux`red] ~& [%rlyd `@ux`red]
=+ s=(sea:rd red) =+ s=(sea:rd red)
=+ negexp==(1 (mod e.s 2)) =+ negexp==(1 (mod e.s 2))
@ -1229,7 +1229,7 @@
++ rlyh |=(reh=@rh ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!))) ++ rlyh |=(reh=@rh ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlyq |=(req=@rq ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!))) ++ rlyq |=(req=@rq ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlys |=(res=@rs ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!))) ++ rlys |=(res=@rs ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ ryld |= v=[syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ^- @rd !: ++ ryld |= v=[syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ^- @rd
?: &(=(hol.v 0) =(zer.v 0) =(fac.v 0)) ?: &(=(hol.v 0) =(zer.v 0) =(fac.v 0))
(bit:rd (szer:vl:fl 1.023 52 syn.v)) (bit:rd (szer:vl:fl 1.023 52 syn.v))
?~ exp.v ?~ exp.v
@ -1242,7 +1242,7 @@
:: Floating point operations for general floating points. :: Floating point operations for general floating points.
:: [s=sign, e=unbiased exponent, f=fraction a=ari] :: [s=sign, e=unbiased exponent, f=fraction a=ari]
:: Value of floating point = (-1)^s * 2^h * (1.f) = (-1)^s * 2^h * a :: Value of floating point = (-1)^s * 2^h * (1.f) = (-1)^s * 2^h * a
++ fl !: ++ fl
|% |%
:: ari, or arithmetic form = 1 + mantissa :: ari, or arithmetic form = 1 + mantissa
:: passing around this is convenient because it preserves :: passing around this is convenient because it preserves
@ -1524,7 +1524,7 @@
-- --
:: Real interface for @rd :: Real interface for @rd
++ rd !: ++ rd
~% %rd + ~ ~% %rd + ~
|% |%
:: Convert a sign/exp/ari cell into 64 bit atom :: Convert a sign/exp/ari cell into 64 bit atom
@ -3564,15 +3564,19 @@
++ royl !: ++ royl !:
=+ ^= zer =+ ^= zer
(cook lent (star (just '0'))) (cook lent (star (just '0')))
=+ ^= vox =+ ^= voy
%+ cook royl-cell
;~ plug ;~ plug
;~(pose (cold | hep) (easy &)) ;~(pose (cold | hep) (easy &))
;~(plug dim:ag ;~(pose ;~(pfix dot ;~(plug zer dim:ag)) (easy [0 0]))) ;~(plug dim:ag ;~(pose ;~(pfix dot ;~(plug zer dim:ag)) (easy [0 0])))
;~(pose ;~(pfix (just 'e') (cook some ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag))) (easy ~)) ;~ pose
;~ pfix
(just 'e')
(cook some ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag))
==
(easy ~)
==
== ==
=+ ^= voy
::(cook |=([a=? b=[c=@ d=@ e=@] f=(unit ,@) g=?] [a c.b d.b e.b f]) vox)k
(cook royl-cell vox)
;~ pose ;~ pose
(stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy))) (stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy)))
(stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy))) (stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy)))
@ -9473,22 +9477,7 @@
q=(set monk) :: authors q=(set monk) :: authors
== :: == ::
++ curd ,[p=@tas q=*] :: typeless card ++ curd ,[p=@tas q=*] :: typeless card
++ disk |*(a=$+(* *) (pair gene (hypo a))) :: global/local typed
++ duct (list wire) :: causal history ++ duct (list wire) :: causal history
++ gene :: global schema
$& [p=gene q=gene] :: autocons
$% [%at p=@tas] :: atom
[%gl p=glob] :: global objective
[%fa p=@tas q=gene] :: named
[%li p=gene] :: list
[%no ~] :: untyped
[%ma p=gene q=gene] :: map
[%se p=gene] :: set
[%sy p=@tas q=gene r=gene] :: symbolic declare
[%un p=gene] :: unit
[%va p=@tas] :: symbolic reference
== ::
++ glob ,[p=logo q=ship r=mark] :: global brand
++ herd (hypo curd) :: typed card ++ herd (hypo curd) :: typed card
++ hide :: standard app state ++ hide :: standard app state
$: $: our=ship :: owner/operator $: $: our=ship :: owner/operator
@ -9519,7 +9508,6 @@
++ z *(unit (unit cage)) :: current subtree ++ z *(unit (unit cage)) :: current subtree
-- :: -- ::
++ logo ,@tas :: content type ++ logo ,@tas :: content type
++ mark ,@uvH :: type by core hash
++ mill (each vase milt) :: vase/metavase ++ mill (each vase milt) :: vase/metavase
++ milt ,[p=* q=*] :: metavase ++ milt ,[p=* q=*] :: metavase
++ monk (each ship khan) :: general identity ++ monk (each ship khan) :: general identity