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

modern.out: fix load error..

elevate-erg
Doug Coleman 2018-07-04 20:19:54 -05:00
parent 76e50c3479
commit d35df269d8
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,10 +1,10 @@
! Copyright (C) 2017 Doug Coleman. ! Copyright (C) 2017 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators.short-circuit USING: accessors arrays assocs combinators.short-circuit
constructors continuations io io.encodings.utf8 io.files constructors continuations fry io io.encodings.utf8 io.files
io.streams.string kernel modern modern.paths modern.slices io.streams.string kernel modern modern.paths modern.slices
prettyprint sequences sequences.extras splitting strings multiline prettyprint sequences sequences.extras splitting
vocabs.loader ; strings vocabs.loader ;
IN: modern.out IN: modern.out
: token? ( obj -- ? ) : token? ( obj -- ? )
@ -14,14 +14,14 @@ TUPLE: renamed slice string ;
CONSTRUCTOR: <renamed> renamed ( slice string -- obj ) ; CONSTRUCTOR: <renamed> renamed ( slice string -- obj ) ;
: trim-before-newline ( seq -- seq' ) : trim-before-newline ( seq -- seq' )
dup [ char: \s = not ] find dup [ CHAR: \s = not ] find
{ char: \r char: \n } member? { CHAR: \r CHAR: \n } member?
[ tail-slice ] [ drop ] if ; [ tail-slice ] [ drop ] if ;
: write-whitespace ( last obj -- ) : write-whitespace ( last obj -- )
swap swap
[ swap slice-between ] [ slice-before ] if* [ swap slice-between ] [ slice-before ] if*
trim-before-newline io::write ; trim-before-newline io:write ;
GENERIC: write-literal* ( last obj -- last' ) GENERIC: write-literal* ( last obj -- last' )
M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ; M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ;
@ -84,7 +84,7 @@ DEFER: map-literals
]] ]]
: strings-core-to-file ( -- ) : strings-core-to-file ( -- )
core-bootstrap-vocabs core-vocabs
[ ".private" ?tail drop vocab-source-path utf8 file-contents ] map-zip [ ".private" ?tail drop vocab-source-path utf8 file-contents ] map-zip
[ "[========[" dup matching-delimiter-string surround ] assoc-map [ "[========[" dup matching-delimiter-string surround ] assoc-map
[ [
@ -95,7 +95,7 @@ DEFER: map-literals
"\n;VOCAB-ROOT>" surround "resource:core-strings.factor" utf8 set-file-contents ; "\n;VOCAB-ROOT>" surround "resource:core-strings.factor" utf8 set-file-contents ;
: parsed-core-to-file ( -- ) : parsed-core-to-file ( -- )
core-bootstrap-vocabs core-vocabs
[ vocab>literals ] map-zip [ vocab>literals ] map-zip
[ [
first2 [ "<VOCAB: " prepend ] dip first2 [ "<VOCAB: " prepend ] dip