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

54
arvo/hoon.hoon
View File

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