From f3e3eb01e0333c0ec401cab418abafc9dab297e7 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 17 Jul 2014 13:56:08 -0700 Subject: [PATCH] Preparing to integrate new ford. --- arvo/ford.hoon | 245 ++++++++----------------------------------------- arvo/hoon.hoon | 38 +++----- 2 files changed, 51 insertions(+), 232 deletions(-) diff --git a/arvo/ford.hoon b/arvo/ford.hoon index 65b84e6bd3..1468db6d06 100644 --- a/arvo/ford.hoon +++ b/arvo/ford.hoon @@ -11,27 +11,20 @@ $% [%made p=(each bead (list tank))] :: computed result == :: ++ hood :: assembly plan - $: sys=$|(@ud [@ud @ud]) :: system kelvin - pro=(map term beam) :: protocols - lib=(map term beam) :: libraries - :: res=(map term (trel horn beam path)) :: resource trees - src=(list hoop) :: program + $: sum=@t :: summary text + mol=(map term beam) :: models + res=(map logo (map term beam)) :: data resources + sys=$|(@ud [@ud @ud]) :: system version + gel=(list hoop) :: telescoping stack == :: ++ hoop :: source in hood $% [%code p=twig] :: direct twig [%cone p=beam] :: core from folder [%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 == :: -++ 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 ->$ $% [%exec p=@p q=(unit silk)] :: make / kill == :: @@ -58,11 +51,10 @@ [%cast p=logo q=beak r=silk] :: translate [%done p=(set beam) q=cage] :: literal [%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 - [%plan p=silk q=hood] :: structured build [%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] == :: ++ sill :: code construction @@ -110,9 +102,8 @@ dep=(set beam) :: dependencies == :: ++ 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 - [%twig p=calm q=(pair path cage) r=twig] :: compile to twig == :: ++ task :: problem in progress $: nah=duct :: cause @@ -125,7 +116,7 @@ |* sem=* :: a typesystem hack |= cax=calx ?+ sem !! - %twig ?>(?=(%twig -.cax) r.cax) + %comp ?>(?=(%comp -.cax) r.cax) %slap ?>(?=(%slap -.cax) r.cax) == :: @@ -365,29 +356,17 @@ |= gef=gift %_(+> mow :_(mow [hen %give gef])) :: - ++ fade :: compile %hood - |= [cof=cafe kas=silk] - ^- (bolt hood) - %. [cof %hoon kas] - (fado |=(a=path (ifix [gay gay] hall:(vang | a)))) - :: - ++ fane :: compile %hoon + ++ fade :: compile |= [cof=cafe kas=silk] ^- (bolt twig) - %. [cof %hoon kas] - (fado |=(a=path (ifix [gay gay] tall:(vang | a)))) - :: - ++ fado :: compile by rule - |* lur=$+(path rule) - |= [cof=cafe for=logo kas=silk] - %+ (clef %twig) (maid cof kas) + =+ pax=(home kas) + %+ (clef %comp) (maid cof pax kas) ^- (burg (pair path cage) twig) |= [cof=cafe pay=(pair path cage)] - ?. |(=(for p.q.pay) =(%noun p.q.pay)) - (flaw cof [%leaf "source error: {} must be %{<(trip for)>}"]) ?. ?=(@ q.q.q.pay) - (flaw cof [%leaf "source error: {} must be flat"]~) - =+ vex=((full (lur p.pay)) [[1 1] (trip q.q.q.pay)]) + (flaw cof ~) + =+ rul=(ifix [gay gay] tall:(vang | pax)) + =+ vex=((full rul) [[1 1] (trip q.q.q.pay)]) ?~ q.vex (flaw cof [%leaf "syntax error: {} {}"] ~) (fine cof p.u.q.vex) @@ -396,9 +375,9 @@ |= [cof=cafe sil=sill] ^- (bolt twig) ?+ -.sil !! - %dire (fane cof [%done ~ [%atom [%atom %$] p.sil]]) + %dire (fade cof [%done ~ [%atom [%atom %$] 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) |= [cof=cafe cay=cage] (fine cof (twig q.q.cay)) @@ -451,9 +430,12 @@ ++ krab :: load to vase |= [cof=cafe for=logo how=logo bem=beam rem=spur] ^- (bolt vase) - %+ cope (fane cof %bake how bem rem) + %+ cope (fade cof %bake how bem rem) |= [cof=cafe gen=twig] (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 |= [cof=cafe for=logo bem=beam rem=spur] @@ -627,24 +609,11 @@ ^$(cof cof, for i.yaw, yaw t.yaw, vax yed) :: ++ maid :: make with path tag - |= [cof=cafe kas=silk] + |= [cof=cafe pax=path kas=silk] ^- (bolt (pair path cage)) %+ cope (make cof kas) |= [cof=cafe cay=cage] - (fine cof (home kas) 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] - == + (fine cof pax cay) :: ++ make :: reduce silk |= [cof=cafe kas=silk] @@ -715,11 +684,6 @@ $(kas [%done p.kas u.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) %ride %+ cool |.(leaf/"ford: ride {<`@p`(mug kas)>}") @@ -740,6 +704,19 @@ (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 |= [cof=cafe gat=vase sam=vase] ^- (bolt vase) @@ -751,152 +728,6 @@ `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: {} 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: {} {} {}]~) - %+ 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 |= [tik=@ud rot=riot] ^+ ..zo diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 05ab1307ec..2b6369f991 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1221,7 +1221,7 @@ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: 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] =+ s=(sea:rd red) =+ negexp==(1 (mod e.s 2)) @@ -1229,7 +1229,7 @@ ++ rlyh |=(reh=@rh ~|(%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=?] !!))) -++ 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)) (bit:rd (szer:vl:fl 1.023 52 syn.v)) ?~ exp.v @@ -1242,7 +1242,7 @@ :: Floating point operations for general floating points. :: [s=sign, e=unbiased exponent, f=fraction a=ari] :: Value of floating point = (-1)^s * 2^h * (1.f) = (-1)^s * 2^h * a -++ fl !: +++ fl |% :: ari, or arithmetic form = 1 + mantissa :: passing around this is convenient because it preserves @@ -1524,7 +1524,7 @@ -- :: Real interface for @rd -++ rd !: +++ rd ~% %rd + ~ |% :: Convert a sign/exp/ari cell into 64 bit atom @@ -3564,15 +3564,19 @@ ++ royl !: =+ ^= zer (cook lent (star (just '0'))) - =+ ^= vox + =+ ^= voy + %+ cook royl-cell ;~ plug ;~(pose (cold | hep) (easy &)) ;~(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 (stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy))) (stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy))) @@ -9473,22 +9477,7 @@ q=(set monk) :: authors == :: ++ curd ,[p=@tas q=*] :: typeless card -++ disk |*(a=$+(* *) (pair gene (hypo a))) :: global/local typed ++ 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 ++ hide :: standard app state $: $: our=ship :: owner/operator @@ -9519,7 +9508,6 @@ ++ z *(unit (unit cage)) :: current subtree -- :: ++ logo ,@tas :: content type -++ mark ,@uvH :: type by core hash ++ mill (each vase milt) :: vase/metavase ++ milt ,[p=* q=*] :: metavase ++ monk (each ship khan) :: general identity