steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modern: pass section path to map-forms

modern-harvey3
Doug Coleman 2019-10-24 21:47:41 -05:00
parent bf79c1abd1
commit 7cd98c796f
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/modern/manifest/manifest.factor
View File

@ -194,22 +194,29 @@ ERROR: key-exists val key assoc existing-value ;
: lookup-syntax ( string -- form ) : lookup-syntax ( string -- form )
; ;
:: map-forms ( seq quot: ( obj -- obj' ) -- seq' ) : ?glue-as ( seq1 seq2 glue exemplar -- seq )
reach [
glue-as
] [
nip like nip
] if ; inline
:: map-forms* ( seq namespace quot: ( namespace obj -- obj' ) -- seq' )
seq seq
[ [
{ {
! { [ dup slice? ] [ quot call ] } ! { [ dup slice? ] [ namespace quot call ] }
{ [ { [
dup { [ array? ] [ first section-open? ] } 1&& dup { [ array? ] [ first section-open? ] } 1&&
] [ ] [
first3 ! pick . first3 ! pick .
[ quot map-forms ] dip 3array [ namespace pick [ char: < = ] trim-head "." "" ?glue-as dup . quot map-forms* ] dip 3array
! dup last . ! dup last .
] } ] }
{ [ { [
dup { [ array? ] [ first upper-colon? ] } 1&& dup { [ array? ] [ first upper-colon? ] } 1&&
] [ ] [
dup first2 first 2array . dup first2 first namespace -rot 3array .
] } ] }
[ [
! "oops" throw ! "oops" throw
@ -217,6 +224,9 @@ ERROR: key-exists val key assoc existing-value ;
} cond } cond
] map ; inline recursive ] map ; inline recursive
: map-forms ( seq quot: ( namespace obj -- obj' ) -- seq' )
f swap map-forms* ; inline
: apply-decorators ( seq forms -- seq' ) : apply-decorators ( seq forms -- seq' )
'[ nip dup slice? [ >string _ rdecorators>> at ] [ drop f ] if ] monotonic-split ; '[ nip dup slice? [ >string _ rdecorators>> at ] [ drop f ] if ] monotonic-split ;