Merge branch 'master' of git://factorcode.org/git/factor
						commit
						bf884ebce8
					
				| 
						 | 
				
			
			@ -1,12 +1,11 @@
 | 
			
		|||
! Copyright (C) 2005, 2007 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2005, 2008 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: arrays definitions generic assocs kernel math
 | 
			
		||||
namespaces prettyprint sequences strings vectors words
 | 
			
		||||
quotations inspector io.styles io combinators sorting
 | 
			
		||||
splitting math.parser effects continuations debugger 
 | 
			
		||||
io.files io.streams.string io.streams.lines vocabs
 | 
			
		||||
source-files classes hashtables compiler.errors compiler.units
 | 
			
		||||
ascii ;
 | 
			
		||||
source-files classes hashtables compiler.errors compiler.units ;
 | 
			
		||||
IN: parser
 | 
			
		||||
 | 
			
		||||
TUPLE: lexer text line column ;
 | 
			
		||||
| 
						 | 
				
			
			@ -55,8 +54,9 @@ t parser-notes set-global
 | 
			
		|||
    0 over set-lexer-column
 | 
			
		||||
    dup lexer-line 1+ swap set-lexer-line ;
 | 
			
		||||
 | 
			
		||||
: skip ( i seq quot -- n )
 | 
			
		||||
    over >r find* drop
 | 
			
		||||
: skip ( i seq ? -- n )
 | 
			
		||||
    over >r
 | 
			
		||||
    [ swap CHAR: \s eq? xor ] curry find* drop
 | 
			
		||||
    [ r> drop ] [ r> length ] if* ; inline
 | 
			
		||||
 | 
			
		||||
: change-column ( lexer quot -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -67,14 +67,13 @@ t parser-notes set-global
 | 
			
		|||
GENERIC: skip-blank ( lexer -- )
 | 
			
		||||
 | 
			
		||||
M: lexer skip-blank ( lexer -- )
 | 
			
		||||
    [ [ blank? not ] skip ] change-column ;
 | 
			
		||||
    [ t skip ] change-column ;
 | 
			
		||||
 | 
			
		||||
GENERIC: skip-word ( lexer -- )
 | 
			
		||||
 | 
			
		||||
M: lexer skip-word ( lexer -- )
 | 
			
		||||
    [
 | 
			
		||||
        2dup nth CHAR: " =
 | 
			
		||||
        [ drop 1+ ] [ [ blank? ] skip ] if
 | 
			
		||||
        2dup nth CHAR: " = [ drop 1+ ] [ f skip ] if
 | 
			
		||||
    ] change-column ;
 | 
			
		||||
 | 
			
		||||
: still-parsing? ( lexer -- ? )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,7 +4,7 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors
 | 
			
		|||
generic hashtables io assocs kernel math namespaces sequences
 | 
			
		||||
strings sbufs io.styles vectors words prettyprint.config
 | 
			
		||||
prettyprint.sections quotations io io.files math.parser effects
 | 
			
		||||
tuples classes float-arrays float-vectors ascii ;
 | 
			
		||||
tuples classes float-arrays float-vectors ;
 | 
			
		||||
IN: prettyprint.backend
 | 
			
		||||
 | 
			
		||||
GENERIC: pprint* ( obj -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -58,24 +58,17 @@ M: f pprint* drop \ f pprint-word ;
 | 
			
		|||
! Strings
 | 
			
		||||
: ch>ascii-escape ( ch -- str )
 | 
			
		||||
    H{
 | 
			
		||||
        { CHAR: \e "\\e"  }
 | 
			
		||||
        { CHAR: \n "\\n"  }
 | 
			
		||||
        { CHAR: \r "\\r"  }
 | 
			
		||||
        { CHAR: \t "\\t"  }
 | 
			
		||||
        { CHAR: \0 "\\0"  }
 | 
			
		||||
        { CHAR: \\ "\\\\" }
 | 
			
		||||
        { CHAR: \" "\\\"" }
 | 
			
		||||
        { CHAR: \e CHAR: \\e  }
 | 
			
		||||
        { CHAR: \n CHAR: \\n  }
 | 
			
		||||
        { CHAR: \r CHAR: \\r  }
 | 
			
		||||
        { CHAR: \t CHAR: \\t  }
 | 
			
		||||
        { CHAR: \0 CHAR: \\0  }
 | 
			
		||||
        { CHAR: \\ CHAR: \\\\ }
 | 
			
		||||
        { CHAR: \" CHAR: \\\" }
 | 
			
		||||
    } at ;
 | 
			
		||||
 | 
			
		||||
: ch>unicode-escape ( ch -- str )
 | 
			
		||||
    >hex 6 CHAR: 0 pad-left "\\u" swap append ;
 | 
			
		||||
 | 
			
		||||
: unparse-ch ( ch -- )
 | 
			
		||||
    dup quotable? [
 | 
			
		||||
        ,
 | 
			
		||||
    ] [
 | 
			
		||||
        dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?if %
 | 
			
		||||
    ] if ;
 | 
			
		||||
    dup ch>ascii-escape [ ] [ ] ?if , ;
 | 
			
		||||
 | 
			
		||||
: do-string-limit ( str -- trimmed )
 | 
			
		||||
    string-limit get [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -24,5 +24,3 @@ IN: ascii
 | 
			
		|||
 | 
			
		||||
: alpha? ( ch -- ? )
 | 
			
		||||
    dup Letter? [ drop t ] [ digit? ] if ; inline
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue