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

modern.out: Write literals better.

modern-harvey3-triple
Doug Coleman 2018-08-03 17:22:00 -04:00
parent 60f66bfb42
commit 73644eda85
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/out/out.factor
View File

@ -27,13 +27,12 @@ GENERIC: write-literal* ( last obj -- last' )
M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ; M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ;
M: array write-literal* [ write-literal* ] each ; M: array write-literal* [ write-literal* ] each ;
M: renamed write-literal* [ slice>> write-whitespace ] [ string>> write ] [ slice>> ] tri ; ! for refactoring M: renamed write-literal* [ slice>> write-whitespace ] [ string>> write ] [ slice>> ] tri ; ! for refactoring
M: string write-literal* write ;
DEFER: map-literals DEFER: map-literals
: (map-literals) ( obj quot: ( obj -- obj' ) -- seq ) : (map-literals) ( obj quot: ( obj -- obj' ) -- seq )
over [ array? ] any? [ over [ array? ] any? [
[ call drop ] [ map-literals ] 2bi [ call ] [ map-literals ] bi
] [ ] [
over array? [ map-literals ] [ call ] if over array? [ map-literals ] [ call ] if
] if ; inline recursive ] if ; inline recursive
@ -42,7 +41,6 @@ DEFER: map-literals
'[ _ (map-literals) ] map ; inline recursive '[ _ (map-literals) ] map ; inline recursive
! Start with no slice as ``last`` ! Start with no slice as ``last``
: write-literal ( obj -- ) f swap write-literal* drop ; : write-literal ( obj -- ) f swap write-literal* drop ;
@ -106,3 +104,15 @@ DEFER: map-literals
{ "<VOCAB-ROOT:" "factorcode-core" "https://factorcode.org/git/factor.git" "core/" } { "<VOCAB-ROOT:" "factorcode-core" "https://factorcode.org/git/factor.git" "core/" }
{ ";VOCAB-ROOT>" } surround "resource:core-parsed.factor" utf8 [ ... ] with-file-writer ; { ";VOCAB-ROOT>" } surround "resource:core-parsed.factor" utf8 [ ... ] with-file-writer ;
![[
: rewrite-core-paths-with-semis ( -- )
core-source-paths first [
dup { [ array? ] [ ?first upper-colon? ] } 1&& [
dup ?first >strings .
dup length 2 = [
first2 1 cut* { " " ";" } swap 3append 2array
] when
] when
] rewrite-path ;
]]