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

modern: writing out files again. i had this code years ago..

modern-harvey3
Doug Coleman 2019-10-28 19:05:21 -05:00
parent 6c5e1e3910
commit ce06202d1a
2 changed files with 7 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -143,9 +143,9 @@ ERROR: key-exists val key assoc existing-value ;
"let" "let" add-brackets-form
"binder-quotation" "|" add-brackets-form
"call-paren" "" add-parens-form ! ( )
"stack-effect" "" add-parens-form ! ( )
"call-paren" "call" add-parens-form ! call( )
"execute-paren" "execute" add-parens-form
"execute-paren" "execute" add-parens-form ! execute( )
"string" "" add-containers-form ! "" [[ ]] [=[ ]=] ...
"interpolate" "I" add-containers-form

17
extra/modern/out/out.factor
View File

@ -7,9 +7,6 @@ prettyprint sequences sequences.extras splitting strings
syntax.modern vocabs.loader ;
IN: modern.out
: token? ( obj -- ? )
{ [ slice? ] [ seq>> string? ] } 1&& ;
TUPLE: renamed slice string ;
CONSTRUCTOR: <renamed> renamed ( slice string -- obj ) ;
@ -21,13 +18,13 @@ CONSTRUCTOR: <renamed> renamed ( slice string -- obj ) ;
: write-whitespace ( last obj -- )
swap
[ swap slice-between ] [ slice-before ] if*
trim-before-newline io:write ;
trim-before-newline >string io:write ;
GENERIC: write-literal* ( last obj -- last' )
M: slice write-literal* write ; ! [ write-whitespace ] [ write ] [ ] tri ;
M: slice write-literal* [ write-whitespace ] [ >string write ] [ ] tri ;
M: array write-literal* [ write-literal* ] each ;
! M: renamed write-literal* [ slice>> write-whitespace ] [ string>> write ] [ slice>> ] tri ; ! for refactoring
M: string write-literal* write ;
M: renamed write-literal* [ slice>> write-whitespace ] [ string>> write ] [ slice>> ] tri ; ! for refactoring
: write-literal ( obj -- ) f swap write-literal* drop ;
DEFER: map-literals
: (map-literals) ( obj quot: ( obj -- obj' ) -- seq )
@ -40,15 +37,11 @@ DEFER: map-literals
: map-literals ( obj quot: ( obj -- obj' ) -- seq )
'[ _ (map-literals) ] map ; inline recursive
! Start with no slice as ``last``
: write-literal ( obj -- ) f swap write-literal* drop ;
: write-modern-string ( seq -- string )
[ write-literal ] with-string-writer ; inline
: write-modern-path ( seq path -- )
utf8 [ write-literal ] with-file-writer ; inline
utf8 [ write-literal "\n" write ] with-file-writer ; inline
: write-modern-vocab ( seq vocab -- )
vocab-source-path write-modern-path ; inline