2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2009 Daniel Ehrenberg
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-24 17:50:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: arrays ascii assocs biassocs interval-maps
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-24 23:04:20 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								io.encodings.utf8 io.files kernel math.parser sequences sets
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-24 17:50:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								splitting ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: simple-flat-file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-02-02 19:39:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: drop-comment ( line -- line' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup [ "#@" member? ] find drop [ head ] when* ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: drop-comments ( seq -- newseq )
							 | 
						
					
						
							
								
									
										
										
										
											2017-02-02 19:39:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ drop-comment ] map harvest ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: split-column ( line -- columns )
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-07 21:55:55 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    " \t" split harvest 2 short head 2 f pad-tail ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-hex ( s -- n )
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-07 21:55:55 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "0x" ?head [ "U+" ?head [ "Missing 0x or U+" throw ] unless ] unless
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        hex>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] when ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-line ( line -- code-unicode )
							 | 
						
					
						
							
								
									
										
										
										
											2012-07-17 18:29:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    split-column [ parse-hex ] map! ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: process-codetable-lines ( lines -- assoc )
							 | 
						
					
						
							
								
									
										
										
										
											2012-07-17 18:29:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    drop-comments [ parse-line ] map! ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-02-03 14:47:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: load-codetable-file ( filename -- biassoc )
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 23:55:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    utf8 file-lines process-codetable-lines >biassoc ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-03 00:19:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 23:49:06 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: split-; ( line -- array )
							 | 
						
					
						
							
								
									
										
										
										
											2012-07-17 18:29:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ";" split [ [ blank? ] trim ] map! ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 23:49:06 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-02-02 19:21:06 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: load-data-file ( filename -- data )
							 | 
						
					
						
							
								
									
										
										
										
											2012-07-17 18:29:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    utf8 file-lines drop-comments [ split-; ] map! ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-20 20:53:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-24 17:50:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: expand-range ( range -- range' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ".." split1 [ hex> ] bi@ [ 2array ] when* ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-20 20:53:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-24 17:50:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: expand-ranges ( ranges -- table )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ [ expand-range ] dip ] assoc-map <interval-map> ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-20 20:53:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-01-24 23:04:20 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: intern ( value values -- value' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ = ] with find nip ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: intern-values ( assoc -- assoc' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup values members [ intern ] curry assoc-map ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-20 20:53:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: load-interval-file ( filename -- table )
							 | 
						
					
						
							
								
									
										
										
										
											2017-02-02 19:21:06 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    load-data-file intern-values expand-ranges ;
							 |