1 ! Copyright (C) 2008 Daniel Ehrenberg, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs biassocs kernel io.encodings math.parser
4 sequences hashtables io.encodings.ascii generic parser
5 classes.tuple words words.symbol io io.files splitting
6 namespaces math compiler.units accessors classes.singleton
7 classes.mixin io.encodings.iana fry simple-flat-file lexer ;
12 : encoding-file ( file-name -- stream )
13 "vocab:io/encodings/8-bit/" ".TXT" surround ;
15 SYMBOL: 8-bit-encodings
16 8-bit-encodings [ H{ } clone ] initialize
18 TUPLE: 8-bit { biassoc biassoc read-only } ;
20 : 8-bit-encode ( char 8-bit -- byte )
21 biassoc>> value-at [ throw-encode-error ] unless* ; inline
24 swap [ 8-bit-encode ] dip stream-write1 ;
26 M: 8-bit encode-string
27 swap [ '[ _ 8-bit-encode ] B{ } map-as ] dip stream-write ;
31 [ swap biassoc>> at [ replacement-char ] unless* ]
37 M: 8-bit-encoding <encoder>
38 8-bit-encodings get-global at <encoder> ;
40 M: 8-bit-encoding <decoder>
41 8-bit-encodings get-global at <decoder> ;
43 : create-encoding ( name -- word )
45 [ define-singleton-class ]
46 [ 8-bit-encoding add-mixin-instance ]
49 : load-encoding ( name iana-name file-name -- )
50 [ create-encoding dup ]
52 [ encoding-file flat-file>biassoc 8-bit boa ] tri*
53 swap 8-bit-encodings get-global set-at ;
57 SYNTAX: 8-BIT: scan-token scan-token scan-token load-encoding ;