2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2007 Slava Pestov.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-18 14:48:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: parser-combinators parser-combinators.regexp lists sequences kernel
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-01 19:26:32 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								promises strings unicode.case ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: globs
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 03:14:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: 'char' ( -- parser )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ ",*?" member? not ] satisfy ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 03:14:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: 'string' ( -- parser )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'char' <+> [ >lower token ] <@ ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 03:14:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: 'escaped-char' ( -- parser )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "\\" token any-char-parser &> [ 1token ] <@ ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 03:14:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: 'escaped-string' ( -- parser )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'string' 'escaped-char' <|> ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								DEFER: 'term'
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: 'glob' ( -- parser )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'term' <*> [ <and-parser> ] <@ ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: 'union' ( -- parser )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'glob' "," token nonempty-list-of "{" "}" surrounded-by
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ <or-parser> ] <@ ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 03:14:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								LAZY: 'term' ( -- parser )
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'union'
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'character-class' <|>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "?" token [ drop any-char-parser ] <@ <|>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "*" token [ drop any-char-parser <*> ] <@ <|>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    'escaped-string' <|> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 03:14:14 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <glob> ( string -- glob ) 'glob' just parse-1 just ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-28 02:12:42 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: glob-matches? ( input glob -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-18 14:46:34 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ >lower ] [ <glob> ] bi* parse nil? not ;
							 |