diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index 71c57ef68c..30eb745314 100755 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -30,15 +30,12 @@ IN: io.encodings.8-bit } ; : encoding-file ( file-name -- stream ) - "resource:extra/io/encodings/8-bit/" ".TXT" - swapd 3append ascii ; - -: tail-if ( seq n -- newseq ) - 2dup swap length <= [ tail ] [ drop ] if ; + "resource:extra/io/encodings/8-bit/" swap ".TXT" + 3append ascii ; : process-contents ( lines -- assoc ) [ "#" split1 drop ] map harvest - [ "\t" split 2 head [ 2 tail-if hex> ] map ] map ; + [ "\t" split 2 head [ 2 short tail hex> ] map ] map ; : byte>ch ( assoc -- array ) 256 replacement-char @@ -51,39 +48,40 @@ IN: io.encodings.8-bit lines process-contents [ byte>ch ] [ ch>byte ] bi ; -TUPLE: 8-bit name decode encode ; +SYMBOL: 8-bit-encodings + +TUPLE: 8-bit decode encode ; : encode-8-bit ( char stream assoc -- ) - swapd at* [ encode-error ] unless swap stream-write1 ; + swap >r at* + [ r> stream-write1 ] [ r> drop encode-error ] if ; inline -M: 8-bit encode-char - encode>> encode-8-bit ; +M: 8-bit encode-char encode>> encode-8-bit ; : decode-8-bit ( stream array -- char/f ) - swap stream-read1 dup - [ swap nth [ replacement-char ] unless* ] - [ nip ] if ; + >r stream-read1 dup + [ r> nth [ replacement-char ] unless* ] [ r> 2drop f ] if ; inline -M: 8-bit decode-char - decode>> decode-8-bit ; - -: make-8-bit ( word byte>ch ch>byte -- ) - [ 2drop ] [ 8-bit boa ] 3bi [ ] curry define ; - -: define-8-bit-encoding ( name stream -- ) - >r in get create r> parse-file make-8-bit ; +M: 8-bit decode-char decode>> decode-8-bit ; PREDICATE: 8-bit-encoding < word - word-def dup length 1 = [ first 8-bit? ] [ drop f ] if ; + 8-bit-encodings get-global key? ; -M: 8-bit-encoding word-def first ; +M: 8-bit-encoding + 8-bit-encodings get-global at ; -M: 8-bit-encoding word-def first ; +M: 8-bit-encoding + 8-bit-encodings get-global at ; PRIVATE> [ - "io.encodings.8-bit" in [ - mappings [ encoding-file define-8-bit-encoding ] assoc-each - ] with-variable + mappings [ + [ "io.encodings.8-bit" create ] + [ encoding-file parse-file 8-bit boa ] + bi* + ] assoc-map + [ 8-bit-encodings set-global ] + [ [ [ ] curry define ] assoc-each ] + bi ] with-compilation-unit diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index db0f478709..3df5485f4e 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -66,6 +66,7 @@ IN: tools.deploy.shaker : strip-word-defs ( words -- ) "Stripping symbolic word definitions" show + [ "no-def-strip" word-prop not ] filter [ [ ] swap set-word-def ] each ; : strip-word-props ( retain-props words -- ) diff --git a/extra/tools/deploy/test/4/4.factor b/extra/tools/deploy/test/4/4.factor index 6831eae5d3..a9ee71131c 100644 --- a/extra/tools/deploy/test/4/4.factor +++ b/extra/tools/deploy/test/4/4.factor @@ -2,6 +2,6 @@ IN: tools.deploy.test.4 USING: io.encodings.8-bit io.encodings.string kernel ; : deploy-test-4 ( -- ) - "xyzthg" latin7 encode drop ; + "xyzthg" \ latin7 encode drop ; MAIN: deploy-test-4