urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2025-01-06 04:07:23 +03:00
Code Issues Packages Projects Releases Wiki Activity

neo: add ford combinators

Browse Source
This commit is contained in:
Liam Fitzgerald 2024-03-13 14:34:17 -04:00
parent 12fdb3a980
commit 66599ebbe4
5 changed files with 241 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
pkg/arvo/lib/ford-face.hoon Normal file
View File

@ -0,0 +1,70 @@
/- neo
=>
|%
++ card card:neo
++ get-face
|= =bowl:neo
^- @tas
!<(@tas q:(~(got by deps.bowl) %face))
++ get-sut
|= =bowl:neo
^- (unit vase)
=+ !<([cac=(unit vase) *] q:(~(got by deps.bowl) %sut))
cac
++ build
|= =bowl:neo
^- (unit vase)
?~ sut=(get-sut bowl)
~
`u.sut(p [%face (get-face bowl) p.u.sut])
--
^- firm:neo
|%
+$ state [cache=(unit vase) ~]
+$ poke
$% [%dep ~]
==
++ kids ~
++ deps
=< apex
|%
++ apex
%- ~(gas by *deps:neo)
:~ sut/sut
==
++ sut
[& ,[cache=(unit vase) *] ,*]
--
++ form
^- form:neo
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(state state-vase)
++ call
|= [old-state=vase act=*]
*(list card)
++ reduce
|= pok=*
^- vase
=+ ;;(=poke pok)
=/ sta sta
=. cache.sta (build bowl)
!>(sta)
++ init
|= vax=(unit vase)
!>(*state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
++ take
|= =sign:neo
^- (list card:neo)
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
--
--

54
pkg/arvo/lib/ford-parser.hoon
View File

@ -1,34 +1,66 @@
/- neo
|%
++ run
|= txt=@t
(scan (trip txt) apex:rein)
+$ dep
[face=(unit term) =pith]
+$ lib
[face=(unit term) =name:neo]
+$ pro
[face=term =stud:neo]
+$ file
$: deps=(list dep)
$: pro=(list pro)
lib=(list lib)
=hoon
==
++ rein
|%
++ dep
^- $-(nail (like ^dep))
++ nam
:: ^- $-(nail (like name:neo))
;~(plug ;~(pfix fas sig fed:ag) stip)
++ std
;~ pose
(rune hep (stag ~ stip))
(rune lus ;~(plug (stag ~ sym) ;~(pfix gap stip)))
sym
;~(plug sym ;~(pfix col sig fed:ag) ;~(pfix fas sym))
==
++ pro
:: ^- $-(nail (like ^pro))
%+ rune pat
;~ pose
%+ cook
|= =stud:neo
?@ stud [stud stud]
[mark.stud stud]
std
;~(plug sym ;~(pfix gap std))
==
++ lib
:: ^- $-(nail (like ^lib))
%+ rune cen
;~ pose
(stag ~ nam)
;~(plug (stag ~ sym) ;~(pfix gap nam))
==
++ rune
|* [car=rule rul=rule]
(ifix [;~(plug fas car gap) gay] rul)
++ deps
(star dep)
++ libs
:: ^- $-(nail (like (list ^lib)))
(star lib)
++ pros
:: ^- $-(nail (like (list ^pro)))
(star pro)
++ hone
:: ^- $-(nail (like hoon))
=+ vaz=vast
(ifix [gay gay] tall:vaz)
++ apex
^- $-(nail (like file))
:: ^- rule
;~(plug deps hone)
;~ plug
pros
libs
hone
==
--
--

4
pkg/arvo/lib/ford-reef.hoon
View File

@ -2,7 +2,6 @@
=>
|%
++ card card:neo
++ reef ^~(!>(..zuse))
--
^- firm:neo
|%
@ -23,7 +22,8 @@
state-vase
++ init
|= old=(unit vase)
!>(`state`[`reef ~])
=+ !<(ref=vase (need old))
!>(`state`[`ref ~])
++ born *(list card:neo)
++ echo
|= [=pith val=*]

57
pkg/arvo/lib/ford-same.hoon Normal file
View File

@ -0,0 +1,57 @@
/- neo
=>
|%
++ card card:neo
++ get-src
|= =bowl:neo
^- (unit vase)
=+ !<([cac=(unit vase) *] q:(~(got by deps.bowl) %src))
cac
--
^- firm:neo
|%
+$ state [cache=(unit vase) ~]
+$ poke [%dep ~]
++ kids ~
++ deps
=< apex
|%
++ apex
%- ~(gas by *deps:neo)
:~ src/src
==
++ src
[& ,[cache=(unit vase) *] ,*]
--
++ form
^- form:neo
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(state state-vase)
++ call
|= [old-state=vase act=*]
*(list card)
++ reduce
|= pok=*
^- vase
=+ ;;(=poke pok)
=/ sta sta
=. cache.sta (get-src bowl)
!>(sta)
++ init
|= vax=(unit vase)
!>(*state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
++ take
|= =sign:neo
^- (list card:neo)
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
--
--

69
pkg/arvo/lib/ford-slop.hoon Normal file
View File

@ -0,0 +1,69 @@
/- neo
=>
|%
++ card card:neo
++ get-sut
|= [sid=?(%a %b) =bowl:neo]
^- (unit vase)
=+ !<([cac=(unit vase) *] q:(~(got by deps.bowl) sid))
cac
++ build
|= =bowl:neo
^- (unit vase)
?~ a=(get-sut %a bowl)
~
?~ b=(get-sut %b bowl)
~
`(slop u.a u.b)
--
^- firm:neo
|%
+$ state [cache=(unit vase) ~]
+$ poke
$% [%dep ~]
==
++ kids ~
++ deps
=< apex
|%
++ apex
%- ~(gas by *deps:neo)
:~ a/sut
b/sut
==
++ sut
[& ,[cache=(unit vase) *] ,*]
--
++ form
^- form:neo
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(state state-vase)
++ call
|= [old-state=vase act=*]
*(list card)
++ reduce
|= pok=*
^- vase
=+ ;;(=poke pok)
=/ sta sta
=. cache.sta (build bowl)
!>(sta)
++ init
|= vax=(unit vase)
!>(*state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
++ take
|= =sign:neo
^- (list card:neo)
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
--
--