simple-flat-file: simplify expand-ranges.
parent
65e4c37a30
commit
dcc3bf64a6
|
@ -7,7 +7,6 @@ IN: simple-flat-file.tests
|
||||||
MEMO: <test1> ( -- code-table )
|
MEMO: <test1> ( -- code-table )
|
||||||
"vocab:simple-flat-file/test1.txt" flat-file>biassoc ;
|
"vocab:simple-flat-file/test1.txt" flat-file>biassoc ;
|
||||||
|
|
||||||
|
|
||||||
{ 0 } [ 0 <test1> at ] unit-test
|
{ 0 } [ 0 <test1> at ] unit-test
|
||||||
{ 0 } [ 0 <test1> value-at ] unit-test
|
{ 0 } [ 0 <test1> value-at ] unit-test
|
||||||
|
|
||||||
|
@ -19,3 +18,6 @@ MEMO: <test1> ( -- code-table )
|
||||||
|
|
||||||
{ 0xAD31 } [ 0x8258 <test1> at ] unit-test
|
{ 0xAD31 } [ 0x8258 <test1> at ] unit-test
|
||||||
{ 0x8258 } [ 0xAD31 <test1> value-at ] unit-test
|
{ 0x8258 } [ 0xAD31 <test1> value-at ] unit-test
|
||||||
|
|
||||||
|
{ 1 } [ "1" expand-range ] unit-test
|
||||||
|
{ { 1 31 } } [ "1..1F" expand-range ] unit-test
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg
|
! Copyright (C) 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: sequences splitting kernel math.parser io.files io.encodings.utf8
|
USING: arrays ascii assocs biassocs interval-maps
|
||||||
biassocs ascii namespaces arrays make assocs interval-maps sets ;
|
io.encodings.utf8 io.files kernel math.parser sequences
|
||||||
|
splitting ;
|
||||||
IN: simple-flat-file
|
IN: simple-flat-file
|
||||||
|
|
||||||
: drop-comments ( seq -- newseq )
|
: drop-comments ( seq -- newseq )
|
||||||
|
@ -31,24 +32,11 @@ IN: simple-flat-file
|
||||||
: data ( filename -- data )
|
: data ( filename -- data )
|
||||||
utf8 file-lines drop-comments [ split-; ] map! ;
|
utf8 file-lines drop-comments [ split-; ] map! ;
|
||||||
|
|
||||||
SYMBOL: interned
|
: expand-range ( range -- range' )
|
||||||
|
".." split1 [ hex> ] bi@ [ 2array ] when* ;
|
||||||
|
|
||||||
: range, ( value key -- )
|
: expand-ranges ( ranges -- table )
|
||||||
swap interned get
|
[ [ expand-range ] dip ] assoc-map <interval-map> ;
|
||||||
[ = ] with find nip 2array , ;
|
|
||||||
|
|
||||||
: expand-ranges ( assoc -- interval-map )
|
|
||||||
[
|
|
||||||
[
|
|
||||||
swap CHAR: . over member? [
|
|
||||||
".." split1 [ hex> ] bi@ 2array
|
|
||||||
] [ hex> ] if range,
|
|
||||||
] assoc-each
|
|
||||||
] { } make <interval-map> ;
|
|
||||||
|
|
||||||
: process-interval-file ( ranges -- table )
|
|
||||||
dup values members interned
|
|
||||||
[ expand-ranges ] with-variable ;
|
|
||||||
|
|
||||||
: load-interval-file ( filename -- table )
|
: load-interval-file ( filename -- table )
|
||||||
data process-interval-file ;
|
data expand-ranges ;
|
||||||
|
|
Loading…
Reference in New Issue