basis/simple-flat-file/simple-flat-file.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays ascii assocs biassocs interval-maps
   4 io.encodings.utf8 io.files kernel math.parser sequences sets
   5 splitting ;
   6 IN: simple-flat-file
   7
   8 : drop-comment ( line -- line' )
   9     dup [ "#@" member? ] find drop [ head ] when* ;
  10
  11 : drop-comments ( seq -- newseq )
  12     [ drop-comment ] map harvest ;
  13
  14 : split-column ( line -- columns )
  15     " \t" split harvest 2 cramp head 2 f pad-tail ;
  16
  17 : parse-hex ( s -- n )
  18     dup [
  19         "0x" ?head [ "U+" ?head [ "Missing 0x or U+" throw ] unless ] unless
  20         hex>
  21     ] when ;
  22
  23 : parse-line ( line -- code-unicode )
  24     split-column [ parse-hex ] map! ;
  25
  26 : process-codetable-lines ( lines -- assoc )
  27     drop-comments [ parse-line ] map! ;
  28
  29 : load-codetable-file ( filename -- biassoc )
  30     utf8 file-lines process-codetable-lines >biassoc ;
  31
  32 : split-; ( line -- array )
  33     ";" split [ [ blank? ] trim ] map! ; inline
  34
  35 : load-data-file ( filename -- data )
  36     utf8 file-lines drop-comments [ split-; ] map! ;
  37
  38 : expand-range ( range -- range' )
  39     ".." split1 [ hex> ] bi@ [ 2array ] when* ;
  40
  41 : expand-ranges ( ranges -- table )
  42     [ [ expand-range ] dip ] assoc-map <interval-map> ;
  43
  44 : intern ( value values -- value' )
  45     [ = ] with find nip ;
  46
  47 : intern-values ( assoc -- assoc' )
  48     dup values members [ intern ] curry assoc-map ;
  49
  50 : load-interval-file ( filename -- table )
  51     load-data-file intern-values expand-ranges ;