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

Apply actual type checks in arvo core.

Browse Source
This commit is contained in:
C. Guy Yarvin 2014-06-06 18:03:36 -07:00
parent aece7472a4
commit 3d1b20cfdd
1 changed files with 37 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
arvo/hoon.hoon
View File

@ -9173,6 +9173,8 @@
++ slut $+(* (unit (unit))) :: old namespace ++ slut $+(* (unit (unit))) :: old namespace
++ vile :: reflexive constants ++ vile :: reflexive constants
$: typ=type :: -:!>(*type) $: typ=type :: -:!>(*type)
duc=type :: -:!>(*duct)
pah=type :: -:!>(*path)
mev=type :: -:!>([%meta *vase]) mev=type :: -:!>([%meta *vase])
moh=type :: -:!>(*(list mosh)) moh=type :: -:!>(*(list mosh))
== :: == ::
@ -9222,7 +9224,7 @@
:: section 3bE, Arvo core :: :: section 3bE, Arvo core ::
:: ::
++ vent :: vane core ++ vent :: vane core
|= [vil=vile bud=vase ves=vase] |= [lal=@tas vil=vile bud=vase ves=vase]
|% |%
++ ruck :: update vase ++ ruck :: update vase
|= [pax=path txt=@ta] |= [pax=path txt=@ta]
@ -9256,6 +9258,14 @@
[%& (slop p.hed p.tal)] [%& (slop p.hed p.tal)]
[%| [%cell p.p.hed p.p.tal] [q.p.hed q.p.tal]] [%| [%cell p.p.hed p.p.tal] [q.p.hed q.p.tal]]
:: ::
++ slix
|= hil=mill
^- mill
?- -.hil
& [%& (slop [typ.vil p.p.hil] p.hil)]
| [%| [%cell typ.vil p.p.hil] p.hil]
==
::
++ slur ++ slur
|= [gat=vase hil=mill] |= [gat=vase hil=mill]
^- (unit vase) ^- (unit vase)
@ -9263,8 +9273,8 @@
?. ?- -.hil ?. ?- -.hil
& (souk p.sam p.p.hil) & (souk p.sam p.p.hil)
| (sike p.sam p.p.hil) | (sike p.sam p.p.hil)
== ~ == ~
`(slym gat sam) `(slym gat +>.hil)
:: ::
++ souk :: check type ++ souk :: check type
|= [sub=type ref=type] |= [sub=type ref=type]
@ -9354,7 +9364,7 @@
:* fur :* fur
ren ren
p.bed p.bed
q.bed q.bed
`coin`[%$ r.bed] `coin`[%$ r.bed]
(flop s.bed) (flop s.bed)
== ==
@ -9378,27 +9388,32 @@
hil=mill hil=mill
== ==
^- [p=(list move) q=vase] ^- [p=(list move) q=vase]
=+ ^= pro =+ ^= pru
:: %- need
?~ pux ?~ pux
(slym (slap rig [%cnzy %call]) [hen +.hil]) %+ slur (slap rig [%cnzy %call])
(slym (slap rig [%cnzy %take]) [u.pux hen +.hil]) (slid [%& duc.vil hen] (slix hil))
:: (slur (slap rig [%cnzy %call]) (slid [%& !>(hen)] hil)) %+ slur (slap rig [%cnzy %take])
:: (slur (slap rig [%cnzy %take]) (slid [%& !>([u.pux hen])] hil)) :(slid [%& pah.vil u.pux] [%& duc.vil hen] (slix hil))
?~ pru
~& [%swim-lost lal (,@tas +>-.hil)]
[~ ves]
=+ pro=(need pru)
:- (said (slap pro [%cnzy %p])) :- (said (slap pro [%cnzy %p]))
(soar (slap pro [%cnzy %q])) (soar (slap pro [%cnzy %q]))
-- --
-- --
:: ::
++ vint :: create vane ++ vint :: create vane
|= [vil=vile bud=vase pax=path txt=@ta] :: |= [lal=@tas vil=vile bud=vase pax=path txt=@ta] ::
(vent vil bud (slym (slap bud (rain pax txt)) bud)) (vent lal vil bud (slym (slap bud (rain pax txt)) bud))
:: ::
++ viol :: vane tools ++ viol :: vane tools
|= but=type |= but=type
^- vile ^- vile
=+ pal=|=(a=@t ^-(type (~(play ut but) (vice a)))) =+ pal=|=(a=@t ^-(type (~(play ut but) (vice a))))
:* typ=(pal '_type') :* typ=(pal '_type')
duc=(pal '_duct')
pah=(pal '_path')
mev=(pal '_[%meta vase]') mev=(pal '_[%meta vase]')
moh=(pal '_(list mosh)') moh=(pal '_(list mosh)')
== ==
@ -9411,12 +9426,12 @@
|= [fur=(unit (set monk)) ron=term bed=bead] |= [fur=(unit (set monk)) ron=term bed=bead]
^- (unit (unit cage)) ^- (unit (unit cage))
=> .(fur ?^(fur fur `[[%& p.bed] ~ ~])) :: XX heinous => .(fur ?^(fur fur `[[%& p.bed] ~ ~])) :: XX heinous
=+ dis=(end 3 1 ron) =+ lal=(end 3 1 ron)
=+ ren=(care (rsh 3 1 ron)) =+ ren=(care (rsh 3 1 ron))
|- ^- (unit (unit cage)) |- ^- (unit (unit cage))
?~ fan ~ ?~ fan ~
?. =(dis p.i.fan) $(fan t.fan) ?. =(lal p.i.fan) $(fan t.fan)
%- scry:(wink:(vent vil bud q.i.fan) now (shax now) ..^$) %- scry:(wink:(vent lal vil bud q.i.fan) now (shax now) ..^$)
[fur ren bed] [fur ren bed]
:: ::
++ dink :: vase by char ++ dink :: vase by char
@ -9436,7 +9451,8 @@
:: ::
++ doos :: sleep until ++ doos :: sleep until
|= hap=path ^- (unit ,@da) |= hap=path ^- (unit ,@da)
(doze:(wink:(vent vil bud (dink (dint hap))) now 0 beck) now [hap ~]) =+ lal=(dint hap)
(doze:(wink:(vent lal vil bud (dink lal)) now 0 beck) now [hap ~])
:: ::
++ hurl :: start loop ++ hurl :: start loop
|= [lac=? ovo=ovum] |= [lac=? ovo=ovum]
@ -9455,9 +9471,9 @@
== ==
:: ::
++ race :: take ++ race :: take
|= [pux=(unit wire) hen=duct hil=mill ves=vase] |= [lal=@tas pux=(unit wire) hen=duct hil=mill ves=vase]
^- [p=(list move) q=vase] ^- [p=(list move) q=vase]
=+ ven=(vent vil bud ves) =+ ven=(vent lal vil bud ves)
=+ win=(wink:ven now (shax now) beck) =+ win=(wink:ven now (shax now) beck)
(swim:win pux hen hil) (swim:win pux hen hil)
:: ::
@ -9471,7 +9487,7 @@
?. =(lal p.i.naf) ?. =(lal p.i.naf)
=+ tuh=$(naf t.naf) =+ tuh=$(naf t.naf)
[-.tuh [i.naf +.tuh]] [-.tuh [i.naf +.tuh]]
=+ fiq=(race pux hen hil q.i.naf) =+ fiq=(race lal pux hen hil q.i.naf)
[[~ (turn p.fiq |=(a=move [lal a]))] [[p.i.naf q.fiq] t.naf]] [[~ (turn p.fiq |=(a=move [lal a]))] [[p.i.naf q.fiq] t.naf]]
:: ::
++ jack :: dispatch card ++ jack :: dispatch card
@ -9631,11 +9647,11 @@
|- ^+ fan |- ^+ fan
?~ fan ?~ fan
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)] ~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
[[lal.fav ves:(vint vil bud pax.fav txt.fav)] fan] [[lal.fav ves:(vint lal.fav vil bud pax.fav txt.fav)] fan]
?. =(lal.fav p.i.fan) ?. =(lal.fav p.i.fan)
[i.fan $(fan t.fan)] [i.fan $(fan t.fan)]
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)] ~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
[[p.i.fan ves:(ruck:(vent vil bud q.i.fan) pax.fav txt.fav)] t.fan] [[p.i.fan ves:(ruck:(vent lal.fav vil bud q.i.fan) pax.fav txt.fav)] t.fan]
== ==
:: ::
++ wish :: external compute ++ wish :: external compute