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

View File

@ -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 ;