Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
de357bacdb
basis/unicode/categories
extra
c
html/parser/state
|
|
@ -12,3 +12,8 @@ IN: unicode.categories.tests
|
|||
[ "Lo" ] [ HEX: 3450 category ] unit-test
|
||||
[ "Lo" ] [ HEX: 4DB5 category ] unit-test
|
||||
[ "Cs" ] [ HEX: DD00 category ] unit-test
|
||||
[ t ] [ CHAR: \t blank? ] unit-test
|
||||
[ t ] [ CHAR: \s blank? ] unit-test
|
||||
[ t ] [ CHAR: \r blank? ] unit-test
|
||||
[ t ] [ CHAR: \n blank? ] unit-test
|
||||
[ f ] [ CHAR: a blank? ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: unicode.categories.syntax sequences unicode.data ;
|
||||
IN: unicode.categories
|
||||
|
||||
CATEGORY: blank Zs Zl Zp | "\r\n" member? ;
|
||||
CATEGORY: blank Zs Zl Zp | "\r\n\t" member? ;
|
||||
CATEGORY: letter Ll | "Other_Lowercase" property? ;
|
||||
CATEGORY: LETTER Lu | "Other_Uppercase" property? ;
|
||||
CATEGORY: Letter Lu Ll Lt Lm Lo Nl ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test c.preprocessor kernel accessors ;
|
||||
IN: c.preprocessor.tests
|
||||
|
||||
[ "vocab:c/tests/test1/test1.c" start-preprocess-file ]
|
||||
[ include-nested-too-deeply? ] must-fail-with
|
||||
|
||||
[ "yo\n\n\n\nyo4\n" ]
|
||||
[ "vocab:c/tests/test2/test2.c" start-preprocess-file nip ] unit-test
|
||||
|
||||
[ "vocab:c/tests/test3/test3.c" start-preprocess-file ]
|
||||
[ "\"BOO\"" = ] must-fail-with
|
||||
|
||||
[ V{ "\"omg\"" "\"lol\"" } ]
|
||||
[ "vocab:c/tests/test4/test4.c" start-preprocess-file drop warnings>> ] unit-test
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: html.parser.state io io.encodings.utf8 io.files
|
||||
io.streams.string kernel combinators accessors io.pathnames
|
||||
fry sequences arrays locals namespaces io.directories
|
||||
assocs math splitting make ;
|
||||
IN: c.preprocessor
|
||||
|
||||
: initial-library-paths ( -- seq )
|
||||
V{ "/usr/include" } clone ;
|
||||
|
||||
TUPLE: preprocessor-state library-paths symbol-table
|
||||
include-nesting include-nesting-max processing-disabled?
|
||||
ifdef-nesting warnings ;
|
||||
|
||||
: <preprocessor-state> ( -- preprocessor-state )
|
||||
preprocessor-state new
|
||||
initial-library-paths >>library-paths
|
||||
H{ } clone >>symbol-table
|
||||
0 >>include-nesting
|
||||
200 >>include-nesting-max
|
||||
0 >>ifdef-nesting
|
||||
V{ } clone >>warnings ;
|
||||
|
||||
DEFER: preprocess-file
|
||||
|
||||
ERROR: unknown-c-preprocessor state-parser name ;
|
||||
|
||||
ERROR: bad-include-line line ;
|
||||
|
||||
ERROR: header-file-missing path ;
|
||||
|
||||
:: read-standard-include ( preprocessor-state path -- )
|
||||
preprocessor-state dup library-paths>>
|
||||
[ path append-path exists? ] find nip
|
||||
[
|
||||
dup [
|
||||
path append-path
|
||||
preprocess-file
|
||||
] with-directory
|
||||
] [
|
||||
! path header-file-missing
|
||||
drop
|
||||
] if* ;
|
||||
|
||||
:: read-local-include ( preprocessor-state path -- )
|
||||
current-directory get path append-path dup :> full-path
|
||||
dup exists? [
|
||||
[ preprocessor-state ] dip preprocess-file
|
||||
] [
|
||||
! full-path header-file-missing
|
||||
drop
|
||||
] if ;
|
||||
|
||||
: handle-include ( preprocessor-state state-parser -- )
|
||||
skip-whitespace advance dup previous {
|
||||
{ CHAR: < [ CHAR: > take-until-object read-standard-include ] }
|
||||
{ CHAR: " [ CHAR: " take-until-object read-local-include ] }
|
||||
[ bad-include-line ]
|
||||
} case ;
|
||||
|
||||
: (readlns) ( -- )
|
||||
readln "\\" ?tail [ , ] dip [ (readlns) ] when ;
|
||||
|
||||
: readlns ( -- string ) [ (readlns) ] { } make concat ;
|
||||
|
||||
: handle-define ( preprocessor-state state-parser -- )
|
||||
[ take-token ] [ take-rest ] bi
|
||||
"\\" ?tail [ readlns append ] when
|
||||
spin symbol-table>> set-at ;
|
||||
|
||||
: handle-undef ( preprocessor-state state-parser -- )
|
||||
take-token swap symbol-table>> delete-at ;
|
||||
|
||||
: handle-ifdef ( preprocessor-state state-parser -- )
|
||||
[ [ 1 + ] change-ifdef-nesting ] dip
|
||||
take-token over symbol-table>> key?
|
||||
[ drop ] [ t >>processing-disabled? drop ] if ;
|
||||
|
||||
: handle-ifndef ( preprocessor-state state-parser -- )
|
||||
[ [ 1 + ] change-ifdef-nesting ] dip
|
||||
take-token over symbol-table>> key?
|
||||
[ t >>processing-disabled? drop ]
|
||||
[ drop ] if ;
|
||||
|
||||
: handle-endif ( preprocessor-state state-parser -- )
|
||||
drop [ 1 - ] change-ifdef-nesting drop ;
|
||||
|
||||
: handle-error ( preprocessor-state state-parser -- )
|
||||
skip-whitespace
|
||||
nip take-rest throw ;
|
||||
|
||||
: handle-warning ( preprocessor-state state-parser -- )
|
||||
skip-whitespace
|
||||
take-rest swap warnings>> push ;
|
||||
|
||||
: parse-directive ( preprocessor-state state-parser string -- )
|
||||
{
|
||||
{ "warning" [ handle-warning ] }
|
||||
{ "error" [ handle-error ] }
|
||||
{ "include" [ handle-include ] }
|
||||
{ "define" [ handle-define ] }
|
||||
{ "undef" [ handle-undef ] }
|
||||
{ "ifdef" [ handle-ifdef ] }
|
||||
{ "ifndef" [ handle-ifndef ] }
|
||||
{ "endif" [ handle-endif ] }
|
||||
{ "if" [ 2drop ] }
|
||||
{ "elif" [ 2drop ] }
|
||||
{ "else" [ 2drop ] }
|
||||
{ "pragma" [ 2drop ] }
|
||||
{ "include_next" [ 2drop ] }
|
||||
[ unknown-c-preprocessor ]
|
||||
} case ;
|
||||
|
||||
: parse-directive-line ( preprocessor-state state-parser -- )
|
||||
advance dup take-token
|
||||
pick processing-disabled?>> [
|
||||
"endif" = [
|
||||
drop f >>processing-disabled?
|
||||
[ 1 - ] change-ifdef-nesting
|
||||
drop
|
||||
] [ 2drop ] if
|
||||
] [
|
||||
parse-directive
|
||||
] if ;
|
||||
|
||||
: preprocess-line ( preprocessor-state state-parser -- )
|
||||
skip-whitespace dup current CHAR: # =
|
||||
[ parse-directive-line ]
|
||||
[ swap processing-disabled?>> [ drop ] [ write-full nl ] if ] if ;
|
||||
|
||||
: preprocess-lines ( preprocessor-state -- )
|
||||
readln
|
||||
[ <state-parser> [ preprocess-line ] [ drop preprocess-lines ] 2bi ]
|
||||
[ drop ] if* ;
|
||||
|
||||
ERROR: include-nested-too-deeply ;
|
||||
|
||||
: check-nesting ( preprocessor-state -- preprocessor-state )
|
||||
[ 1 + ] change-include-nesting
|
||||
dup [ include-nesting>> ] [ include-nesting-max>> ] bi > [
|
||||
include-nested-too-deeply
|
||||
] when ;
|
||||
|
||||
: preprocess-file ( preprocessor-state path -- )
|
||||
[ check-nesting ] dip
|
||||
[ utf8 [ preprocess-lines ] with-file-reader ]
|
||||
[ drop [ 1 - ] change-include-nesting drop ] 2bi ;
|
||||
|
||||
: start-preprocess-file ( path -- preprocessor-state string )
|
||||
dup parent-directory [
|
||||
[
|
||||
[ <preprocessor-state> dup ] dip preprocess-file
|
||||
] with-string-writer
|
||||
] with-directory ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Tests if the preprocessor bails on an infinite loop caused by mutually recursive #include lines.
|
||||
|
|
@ -0,0 +1 @@
|
|||
#include "lo.h"
|
||||
|
|
@ -0,0 +1 @@
|
|||
#include "hi.h"
|
||||
|
|
@ -0,0 +1 @@
|
|||
#include "hi.h"
|
||||
|
|
@ -0,0 +1 @@
|
|||
Tests whether #define and #ifdef/#endif work in the positive case.
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
#define YO
|
||||
#ifdef YO
|
||||
yo
|
||||
#endif
|
||||
|
||||
#define YO2
|
||||
#ifndef YO2
|
||||
yo2
|
||||
#endif
|
||||
|
||||
#ifdef YO3
|
||||
yo3
|
||||
#endif
|
||||
|
||||
#ifndef YO4
|
||||
yo4
|
||||
#endif
|
||||
|
|
@ -0,0 +1 @@
|
|||
Tests whether #define and #ifdef/#endif work in the positive case.
|
||||
|
|
@ -0,0 +1 @@
|
|||
#error "BOO"
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#warning "omg"
|
||||
#warning "lol"
|
||||
|
|
@ -93,3 +93,9 @@ IN: html.parser.state.tests
|
|||
|
||||
[ "abcd e \\\"f g" ]
|
||||
[ "\"abcd e \\\"f g\"" <state-parser> CHAR: \ CHAR: " take-token* ] unit-test
|
||||
|
||||
[ "" ]
|
||||
[ "" <state-parser> take-rest ] unit-test
|
||||
|
||||
[ "" ]
|
||||
[ "abc" <state-parser> dup "abc" take-sequence drop take-rest ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces math kernel sequences accessors fry circular
|
||||
unicode.case unicode.categories locals combinators.short-circuit
|
||||
make combinators ;
|
||||
make combinators io splitting ;
|
||||
|
||||
IN: html.parser.state
|
||||
|
||||
|
|
@ -74,8 +74,12 @@ TUPLE: state-parser sequence n ;
|
|||
: skip-whitespace ( state-parser -- state-parser )
|
||||
[ [ current blank? not ] take-until drop ] keep ;
|
||||
|
||||
: take-rest-slice ( state-parser -- sequence/f )
|
||||
[ sequence>> ] [ n>> ] bi
|
||||
2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline
|
||||
|
||||
: take-rest ( state-parser -- sequence )
|
||||
[ drop f ] take-until ; inline
|
||||
[ take-rest-slice ] [ sequence>> like ] bi ;
|
||||
|
||||
: take-until-object ( state-parser obj -- sequence )
|
||||
'[ current _ = ] take-until ;
|
||||
|
|
@ -111,3 +115,6 @@ TUPLE: state-parser sequence n ;
|
|||
|
||||
: take-token ( state-parser -- string/f )
|
||||
CHAR: \ CHAR: " take-token* ;
|
||||
|
||||
: write-full ( state-parser -- ) sequence>> write ;
|
||||
: write-rest ( state-parser -- ) take-rest write ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue