Ready to move to typed cards.

This commit is contained in:
C. Guy Yarvin 2014-05-25 13:35:07 -07:00
parent 41e4005ee7
commit 0182cc896a
7 changed files with 143 additions and 61 deletions

View File

@ -1503,10 +1503,10 @@
?- -.bon ?- -.bon
%beer %beer
:_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~ ~ ~])) :_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~ ~ ~]))
:* [hen [%punt %c %init p.bon]] :* [hen [%slip %c %init p.bon]]
[hen [%give %init p.bon]] [hen [%give %init p.bon]]
[hen [%punt %a %kick now]] [hen [%slip %a %kick now]]
[hen [%punt %e %init p.bon]] [hen [%slip %e %init p.bon]]
~ ~
== ==
:: ::
@ -1550,7 +1550,7 @@
:: ::
?(%pr %pc) :: %pr, %pc ?(%pr %pc) :: %pr, %pc
:_ fox :_ fox
:~ [hen [%punt %e %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]] :~ [hen [%slip %e %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]]
== ==
:: ::
%ta %ta
@ -1564,7 +1564,7 @@
== ==
%re :: %re %re :: %re
:_ fox :_ fox
:~ [hen [%punt %c %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]] :~ [hen [%slip %c %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]]
== ==
:: ::
%ye :: %ye %ye :: %ye
@ -1590,7 +1590,7 @@
=+ nym=(temp p.p.bon q.p.bon /name) =+ nym=(temp p.p.bon q.p.bon /name)
=+ fom=~(rend co %$ %p q.p.bon) =+ fom=~(rend co %$ %p q.p.bon)
:~ :- hen :~ :- hen
:+ %punt %d :+ %slip %d
:+ %flog %text :+ %flog %text
;: weld ;: weld
"; " "; "
@ -1605,7 +1605,7 @@
|= [wru=(unit writ) tea=wire hen=duct fav=card] |= [wru=(unit writ) tea=wire hen=duct fav=card]
^- [(list move) _+>] ^- [(list move) _+>]
?: ?=([%crud *] fav) ?: ?=([%crud *] fav)
[[[hen [%punt %d %flog fav]] ~] +>] [[[hen [%slip %d %flog fav]] ~] +>]
=+ ^= fuy ^- [p=(list boon) q=furt] =+ ^= fuy ^- [p=(list boon) q=furt]
?+ -.fav ?+ -.fav
[~ fox] [~ fox]

View File

@ -158,7 +158,7 @@
|= [tea=wire hen=duct fav=card] :: handle event |= [tea=wire hen=duct fav=card] :: handle event
^- [p=(list move) q=brat] ^- [p=(list move) q=brat]
?: ?=([%crud *] fav) ?: ?=([%crud *] fav)
[[[hen [%punt %d %flog fav]] ~] +<.^^$] [[[hen [%slip %d %flog fav]] ~] +<.^^$]
?+ -.fav ?+ -.fav
[[[hen %give fav] ~] +<.^^$] [[[hen %give fav] ~] +<.^^$]
%hail [[[hen [%give %helo prot]] ~] +<.^^$] %hail [[[hen [%give %helo prot]] ~] +<.^^$]
@ -205,7 +205,7 @@
=+ fom=(trip ((hard ,@) val)) =+ fom=(trip ((hard ,@) val))
^- (list move) ^- (list move)
:~ :- hen :~ :- hen
:+ %punt %d :+ %slip %d
:+ %flog %text :+ %flog %text
;: weld ;: weld
pre pre
@ -1157,7 +1157,7 @@
:: ~& [%batz-beat -.fav [%tea tea] [%hen hen]] :: ~& [%batz-beat -.fav [%tea tea] [%hen hen]]
=+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) =+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a]))))
?: ?=([%crud *] fav) ?: ?=([%crud *] fav)
[[[hen [%punt %d %flog fav]] ~] ..^$] [[[hen [%slip %d %flog fav]] ~] ..^$]
?: ?=(%wake -.fav) ?: ?=(%wake -.fav)
=+ ^= fiy =+ ^= fiy
=| fiy=(list ,[p=duct q=ship r=[p=@ud q=@ud r=wire]]) =| fiy=(list ,[p=duct q=ship r=[p=@ud q=@ud r=wire]])
@ -1217,7 +1217,7 @@
:- :- [hen [%give fav]] :- :- [hen [%give fav]]
?: =(bos p.fav) ~ ?: =(bos p.fav) ~
:_ ~ :_ ~
[hen [%punt %b %line (rap 3 ":{(scow %p bos)}/main=/bin/update")]] [hen [%slip %b %line (rap 3 ":{(scow %p bos)}/main=/bin/update")]]
..^^$(dez (~(put by dez) hen [[p.fav (bard p.fav)] ~])) ..^^$(dez (~(put by dez) hen [[p.fav (bard p.fav)] ~]))
:: ::
?(%loin %make %sith) ?(%loin %make %sith)

View File

@ -370,7 +370,7 @@
^- [p=(list move) q=vane] ^- [p=(list move) q=vane]
?+ -.fav [[[hen %give fav] ~] ..^$] ?+ -.fav [[[hen %give fav] ~] ..^$]
%crud %crud
[[[hen %punt %d %flog fav] ~] ..^$] [[[hen %slip %d %flog fav] ~] ..^$]
:: ::
%init %init
[~ ..^$(fat.ruf (~(put by fat.ruf) p.fav [hen ~ ~ ~]))] [~ ..^$(fat.ruf (~(put by fat.ruf) p.fav [hen ~ ~ ~]))]

View File

@ -14,7 +14,7 @@
?: ?=(%flog -.fav) ?: ?=(%flog -.fav)
:_ ..^$ :_ ..^$
%+ turn (~(tap by dug) *(list ,[p=duct q=yard])) %+ turn (~(tap by dug) *(list ,[p=duct q=yard]))
|=([a=duct b=yard] [a %punt %d p.fav]) |=([a=duct b=yard] [a %slip %d p.fav])
=+ ^= yar ^- yard =+ ^= yar ^- yard
=+ yar=(~(get by dug) hen) =+ yar=(~(get by dug) hen)
?^ yar u.yar ?^ yar u.yar

View File

@ -1819,7 +1819,7 @@
=+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) =+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a]))))
=. ney (shax :(mix (shax now) +(eny) ney)) :: XX!! shd not need =. ney (shax :(mix (shax now) +(eny) ney)) :: XX!! shd not need
?: ?=(%crud -.fav) ?: ?=(%crud -.fav)
[[[hen %punt %d %flog fav] ~] ..^$] [[[hen %slip %d %flog fav] ~] ..^$]
^- [p=(list move) q=vane] ^- [p=(list move) q=vane]
=. gub ?.(=(0 gub) gub (cat 3 (rsh 3 1 (scot %p (end 6 1 eny))) '-')) =. gub ?.(=(0 gub) gub (cat 3 (rsh 3 1 (scot %p (end 6 1 eny))) '-'))
=^ mos bol =^ mos bol

View File

@ -106,6 +106,7 @@
$|(~ [n=a l=(tree a) r=(tree a)]) :: $|(~ [n=a l=(tree a) r=(tree a)]) ::
++ nail ,[p=hair q=tape] :: parsing input ++ nail ,[p=hair q=tape] :: parsing input
++ numb ,@ :: just a number ++ numb ,@ :: just a number
++ pair |*([a=$+(* *) b=$+(* *)] [p=a q=b]) :: just a pair
++ pass ,@ :: public key ++ pass ,@ :: public key
++ path (list span) :: filesys location ++ path (list span) :: filesys location
++ pint ,[p=[p=@ q=@] q=[p=@ q=@]] :: line/column range ++ pint ,[p=[p=@ q=@] q=[p=@ q=@]] :: line/column range
@ -126,6 +127,8 @@
$= q :: $= q ::
[p=?(~ axis) q=(list ,[p=type q=foot])] :: [p=?(~ axis) q=(list ,[p=type q=foot])] ::
== :: == ::
++ qual |* [a=$+(* *) b=$+(* *) c=$+(* *) d=$+(* *)] :: just a quadruple
[p=a q=b r=c s=d] ::
++ rege $| ?(%dote %ende %sart %empt %boun %bout) :: parsed regex ++ rege $| ?(%dote %ende %sart %empt %boun %bout) :: parsed regex
$% [%lite p=char] :: literal $% [%lite p=char] :: literal
[%pair p=rege q=rege] :: ordering [%pair p=rege q=rege] :: ordering
@ -173,6 +176,8 @@
[1 p=term q=toga] :: deep toga [1 p=term q=toga] :: deep toga
[2 p=toga q=toga] :: cell toga [2 p=toga q=toga] :: cell toga
== :: == ::
++ trel |* [a=$+(* *) b=$+(* *) c=$+(* *)] :: just a triple
[p=a q=b r=c] ::
++ tuna :: tagflow ++ tuna :: tagflow
$% [%a p=twig] :: plain text $% [%a p=twig] :: plain text
[%b p=twig] :: single tag [%b p=twig] :: single tag
@ -5437,6 +5442,20 @@
~(duck ut typ) ~(duck ut typ)
:: ::
++ spat |=(pax=path (rap 3 (spud pax))) ++ spat |=(pax=path (rap 3 (spud pax)))
++ spec !:
|= vax=vase
^- vase
=. vax
%+ slap vax
:+ %wtgr
[%wtts [%axil ?^(q.vax %cell [%atom %$])] [%$ 1]~]
[%$ 1]
?@ q.vax vax
%+ slap vax
:+ %wtgr
[%wtts ?^(-.q.vax [%axil %cell] [%leaf %$ -.q.vax]) [%$ 2]~]
[%$ 1]
::
++ spud |=(pax=path ~(ram re (dish:ut [~ %path] pax))) ++ spud |=(pax=path ~(ram re (dish:ut [~ %path] pax)))
++ slot ++ slot
|= [axe=@ vax=vase] ^- vase |= [axe=@ vax=vase] ^- vase
@ -8764,6 +8783,10 @@
:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
!: !:
|% |%
++ chop :: permissions
$: say=(set monk) :: data authorizers
use=(set monk) :: data users
== ::
++ curd ,[p=@tas q=*] :: typeless card ++ curd ,[p=@tas q=*] :: typeless card
++ duct (list wire) :: causal history ++ duct (list wire) :: causal history
++ helm :: privilege ++ helm :: privilege
@ -8772,21 +8795,18 @@
== :: == ::
++ hilt ?(0 1 2) :: lead iron gold ++ hilt ?(0 1 2) :: lead iron gold
++ khan ,[p=@tas q=path] :: foreign identity ++ khan ,[p=@tas q=path] :: foreign identity
++ mill (each vase milt) :: vase/metavase
++ milt ,[p=* q=*] :: metavase
++ monk (each ship khan) :: general identity ++ monk (each ship khan) :: general identity
++ muve ,[p=duct q=curd] :: typeless (old) move
++ muvi ,[p=duct q=(mold curd)] :: new move
++ mold :: general action ++ mold :: general action
|* a=$+(* *) :: new move |* a=$+(* *) :: new move
$% [%call p=term q=path r=a] :: advance $% [%call p=term q=path r=a] :: advance
[%punt p=term q=a] :: send across [%slip p=term q=a] :: send across
[%sick p=a] :: lame refactoring [%sick p=a] :: lame refactoring
[%give p=a] :: retreat [%give p=a] :: retreat
== :: == ::
++ muvu ,[p=@tas q=duct r=(mold curd)] :: sourced move ++ muse ,[p=@tas q=duct r=(mold curd)] :: sourced move
++ nave :: ++ move ,[p=duct q=(mold curd)] ::
$: say=(set monk) :: data authorizers
use=(set monk) :: data users
== ::
++ ovum ,[p=wire q=curd] :: typeless ovum ++ ovum ,[p=wire q=curd] :: typeless ovum
++ pane (list ,[p=@tas q=vase]) :: kernel modules ++ pane (list ,[p=@tas q=vase]) :: kernel modules
++ pone (list ,[p=@tas q=vise]) :: kernel modules, old ++ pone (list ,[p=@tas q=vise]) :: kernel modules, old
@ -8796,23 +8816,7 @@
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 3bE, Arvo core :: :: section 3bE, Arvo core ::
:: ::
:: ++ vent !: :: vane core
:: ++ able :: simplify privilege
:: |= hem=helm ^- hilt
:: ?-(hem %gold 2, %iron 1, [%lead *] 0)
::
++ adit :: duct privilege
|= hen=duct
^- ?(%gold %iron %lead)
?~ hen
%lead
?~ t.hen
?: ?=([%gold *] i.hen) %gold
?: ?=([%iron *] i.hen) %iron
%lead
$(hen t.hen)
::
++ vent :: vane core
|= [bud=vase ves=vase] |= [bud=vase ves=vase]
|% |%
++ ruck :: update vase ++ ruck :: update vase
@ -8837,13 +8841,91 @@
:: ::
++ wink :: deploy ++ wink :: deploy
|= [now=@da eny=@ sky=$+(* (unit (unit)))] |= [now=@da eny=@ sky=$+(* (unit (unit)))]
=+ rig=(slym ves +<) =+ rig=(slym ves +<) :: activate vane
|% |%
++ doze ++ doze
|= [now=@da hen=duct] |= [now=@da hen=duct]
^- (unit ,@da) ^- (unit ,@da)
((hard (unit ,@da)) q:(slym (slap rig [%cnzy %doze]) +<)) ((hard (unit ,@da)) q:(slym (slap rig [%cnzy %doze]) +<))
:: ::
++ sike :: check metatype
|= [sub=type ref=*]
^- ?
=+ gat=|=([a=type b=type] (~(nest ut a) | b))
(,? .*(gat(+< [sub ref]) -.gat))
::
++ souk :: check type
|=([sub=type ref=type] (~(nest ut sub) | ref))
::
++ sunk :: type is cell
|=(ref=type (souk [%cell %noun %noun] ref))
::
++ song :: reduce metacard
|= mex=vase :: mex: vase of card
^- mill ::
?. (sunk p.mex) !! :: a card is a cell
?. ?=(%meta -.q.mex) [%& mex] :: ordinary card
=+ tiv=(slot 3 mex) :: tiv: vase of vase
?. (sunk p.tiv) !! :: a vase is a cell
?. (souk -:!>(*type) p:(slot 2 tiv)) !! :: vase head is type
=+ mut=(,[p=* q=*] q.tiv) :: card type, value
:- %| :: metacard
|- ^- [p=* q=*] ::
?. ?=([%meta p=* q=[p=* q=*]] q.mut) mut :: ordinary metacard
?. (sike -:!>([%meta vase]) p.mut) !! :: meta-metacard
$(mut q.mut) :: descend into meta
::
++ sump
|= wec=vase
^- move
:- ((hard duct) -.q.wec)
=+ caq=(slot 3 wec)
:: =+ caq=(spec (slot 3 wec))
?+ -.q.caq ~&(%sump-bad !!)
%call
:^ %call
(need ((sand %tas) ((hard ,@) +<.q.caq)))
((hard path) +>-.q.caq)
((hard curd) +>+.q.caq)
:: (song (slot 15 caq))
::
%give
[%give ((hard curd) +.q.caq)]
::
%sick
[%sick ((hard curd) +.q.caq)]
::
%slip
:+ %slip
(need ((sand %tas) ((hard ,@) +<.q.caq)))
((hard curd) +>.q.caq)
==
:: XX pattern matching crashes!!!!
:: ?+ q.caq ~&(%sump-bad !!)
:: ::
:: [%call p=@tas q=* r=[p=@tas q=*]]
:: :^ %call (need ((sand %tas) ((hard ,@) p.q.caq)))
:: ((hard path) q.q.caq)
:: r.q.caq
:: :: (song (slot 15 caq))
:: ::
:: [%give p=[p=@tas q=*]]
:: [%give p.q.caq]
:: ::
:: [%sick p=[p=@tas q=*]]
:: [%sick p.q.caq]
:: ::
:: [%slip p=@tas q=[p=@tas q=*]]
:: [%slip (need ((sand %tas) ((hard ,@) p.q.caq))) q.q.caq]
:: ==
::
++ said
|= vud=vase
?. (~(nest ut -:!>(*(list move))) | p.vud) !!
|- ^- (list move)
?: =(~ q.vud) ~
[(sump (slot 2 vud)) $(vud (slot 3 vud))]
::
++ scry ++ scry
|= $: our=ship |= $: our=ship
ren=@tas ren=@tas
@ -8856,24 +8938,25 @@
=+ pro=(slym (slap rig [%cnzy %scry]) +<) =+ pro=(slym (slap rig [%cnzy %scry]) +<)
((hard (unit (unit))) q.pro) ((hard (unit (unit))) q.pro)
:: ::
++ soar :: postprocess vane
|= sev=vase
^- vase
?: &(=(-.q.ves -.q.sev) =(+>.q.ves +>.q.sev))
ves
sev(+<.q [_@da _@ =>(~ |+(* ~))]) :: cure memory leak
::
++ swim ++ swim
|= $: pux=(unit wire) |= $: pux=(unit wire)
hen=duct hen=duct
fav=curd fav=curd
== ==
^- [p=(list muvi) q=_+>.^$] ^- [p=(list move) q=vase]
=+ ^= pro =+ ^= pro
?~ pux ?~ pux
(slym (slap rig [%cnzy %call]) [hen fav]) (slym (slap rig [%cnzy %call]) [hen fav])
(slym (slap rig [%cnzy %beat]) [u.pux hen fav]) (slym (slap rig [%cnzy %beat]) [u.pux hen fav])
:- ((list muvi) q:(slap pro [%cnzy %p])) :- (said (slap pro [%cnzy %p]))
=+ sev=(slap pro [%cnzy %q]) (soar (slap pro [%cnzy %q]))
%= +>.^$
ves
?: &(=(-.q.ves -.q.sev) =(+>.q.ves +>.q.sev))
ves
sev(+<.q [_@da _@ =>(~ |+(* ~))]) :: cure memory leak
==
-- --
-- --
:: ::
@ -8914,7 +8997,7 @@
|= din=@tas ^- vase |= din=@tas ^- vase
?~(fan !! ?:(=(din p.i.fan) q.i.fan $(fan t.fan))) ?~(fan !! ?:(=(din p.i.fan) q.i.fan $(fan t.fan)))
:: ::
++ dint :: input to vane ++ dint :: input routing
|= hap=path ^- @tas |= hap=path ^- @tas
?+ hap !! ?+ hap !!
[@ %ames *] %a [@ %ames *] %a
@ -8937,28 +9020,27 @@
:: ::
++ race :: beat ++ race :: beat
|= [pux=(unit wire) hen=duct fav=curd ves=vase] |= [pux=(unit wire) hen=duct fav=curd ves=vase]
^- [p=(list muvi) q=vase] ^- [p=(list move) q=vase]
=+ ven=(vent bud ves) =+ ven=(vent bud ves)
=+ win=(wink:ven now (shax now) (beck ~)) =+ win=(wink:ven now (shax now) (beck ~))
=+ yub=(swim:win pux hen fav) (swim:win pux hen fav)
[p.yub ves:q.yub]
:: ::
++ fire :: execute ++ fire :: execute
|= [lal=term pux=(unit wire) hen=duct fav=curd] |= [lal=term pux=(unit wire) hen=duct fav=curd]
?: &(?=(^ pux) ?=(~ hen)) ?: &(?=(^ pux) ?=(~ hen))
[[[[lal u.pux] fav]~ ~] fan] [[[[lal u.pux] fav]~ ~] fan]
=+ naf=fan =+ naf=fan
|- ^- [[p=(list ovum) q=(list muvu)] _fan] |- ^- [[p=(list ovum) q=(list muse)] _fan]
?~ naf [[~ ~] ~] ?~ naf [[~ ~] ~]
?. =(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 fav q.i.naf) =+ fiq=(race pux hen fav q.i.naf)
[[~ (turn p.fiq |=(a=muvi [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
|= gum=muvu |= gum=muse
^- [[p=(list ovum) q=(list muvu)] _fan] ^- [[p=(list ovum) q=(list muse)] _fan]
%- fire %- fire
?- -.r.gum ?- -.r.gum
%call %call
@ -8969,7 +9051,7 @@
?> ?=(^ i.q.gum) ?> ?=(^ i.q.gum)
[i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum] [i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum]
:: ::
%punt %slip
[p.r.gum ~ q.gum q.r.gum] [p.r.gum ~ q.gum q.r.gum]
:: ::
%sick %sick
@ -8979,12 +9061,12 @@
== ==
:: ::
++ kick :: new main loop ++ kick :: new main loop
|= mor=(list muvu) |= mor=(list muse)
=| ova=(list ovum) =| ova=(list ovum)
|- ^- [p=(list ovum) q=(list ,[p=@tas q=vase])] |- ^- [p=(list ovum) q=(list ,[p=@tas q=vase])]
?~ mor [(flop ova) fan] ?~ mor [(flop ova) fan]
=^ nyx fan (jack i.mor) =^ nyx fan (jack i.mor)
$(ova (weld p.nyx ova), mor (weld `(list muvu)`q.nyx `(list muvu)`t.mor)) $(ova (weld p.nyx ova), mor (weld q.nyx t.mor))
-- --
-- --
:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::

View File

@ -2022,7 +2022,7 @@
[%logo p=@] :: logout [%logo p=@] :: logout
[%loot p=@tas q=path] :: request directory [%loot p=@tas q=path] :: request directory
[%make p=(unit ,@t) q=@ud r=@] :: wild license [%make p=(unit ,@t) q=@ud r=@] :: wild license
[%mean p=ship q=term r=nave s=vase] :: application event [%mean p=ship q=term r=chop s=vase] :: application event
[%meta p=ship q=vase] :: abstract app action [%meta p=ship q=vase] :: abstract app action
[%meat p=ship q=card] :: concrete app action [%meat p=ship q=card] :: concrete app action
[%mine p=@ud q=@t] :: query matched line [%mine p=@ud q=@t] :: query matched line