modern: pass section path to map-forms
parent
bf79c1abd1
commit
7cd98c796f
|
@ -194,22 +194,29 @@ ERROR: key-exists val key assoc existing-value ;
|
|||
: 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
|
||||
[
|
||||
{
|
||||
! { [ dup slice? ] [ quot call ] }
|
||||
! { [ dup slice? ] [ namespace quot call ] }
|
||||
{ [
|
||||
dup { [ array? ] [ first section-open? ] } 1&&
|
||||
] [
|
||||
first3 ! pick .
|
||||
[ quot map-forms ] dip 3array
|
||||
[ namespace pick [ char: < = ] trim-head "." "" ?glue-as dup . quot map-forms* ] dip 3array
|
||||
! dup last .
|
||||
] }
|
||||
{ [
|
||||
dup { [ array? ] [ first upper-colon? ] } 1&&
|
||||
] [
|
||||
dup first2 first 2array .
|
||||
dup first2 first namespace -rot 3array .
|
||||
] }
|
||||
[
|
||||
! "oops" throw
|
||||
|
@ -217,6 +224,9 @@ ERROR: key-exists val key assoc existing-value ;
|
|||
} cond
|
||||
] map ; inline recursive
|
||||
|
||||
: map-forms ( seq quot: ( namespace obj -- obj' ) -- seq' )
|
||||
f swap map-forms* ; inline
|
||||
|
||||
|
||||
: apply-decorators ( seq forms -- seq' )
|
||||
'[ nip dup slice? [ >string _ rdecorators>> at ] [ drop f ] if ] monotonic-split ;
|
||||
|
|
Loading…
Reference in New Issue