diff --git a/basis/help/tips/tips-docs.factor b/basis/help/tips/tips-docs.factor index 750eff7a52..48ed65b318 100644 --- a/basis/help/tips/tips-docs.factor +++ b/basis/help/tips/tips-docs.factor @@ -20,6 +20,8 @@ TIP: "Power tools: " { $links see edit help about apropos time infer. } ; TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link POSTPONE: TIP: } " parsing word." ; +TIP: "Try some simple demo applications, then look at the source code in " { $snippet "extra/" } ": " { $code "\"demos\" run" } ; + HELP: TIP: { $syntax "TIP: content ;" } { $values { "content" "a markup element" } } diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index adcfdfb00d..bc07006d62 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -11,6 +11,7 @@ CONSTANT: horizontal { 1 0 } CONSTANT: vertical { 0 1 } TUPLE: gadget < rect +id pref-dim parent children @@ -28,7 +29,7 @@ model ; M: gadget equal? 2drop f ; -M: gadget hashcode* drop gadget hashcode* ; +M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ; M: gadget model-changed 2drop ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 41e983eb28..6f6e7ee95f 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -49,13 +49,13 @@ M: pane-stream stream-element-type drop +character+ ; : pane-caret&mark ( pane -- caret mark ) [ caret>> ] [ mark>> ] bi ; inline -: selected-children ( pane -- seq ) +: selected-subtree ( pane -- seq ) [ pane-caret&mark sort-pair ] keep gadget-subtree ; M: pane gadget-selection? pane-caret&mark and ; M: pane gadget-selection ( pane -- string/f ) - selected-children gadget-text ; + selected-subtree gadget-text ; : init-prototype ( pane -- pane ) +baseline+ >>align >>prototype ; inline @@ -72,32 +72,12 @@ M: pane gadget-selection ( pane -- string/f ) [ >>last-line ] [ 1 track-add ] bi dup prepare-last-line ; inline -GENERIC: draw-selection ( loc obj -- ) - -: if-fits ( rect quot -- ) - [ clip get origin get vneg offset-rect over contains-rect? ] dip - [ drop ] if ; inline - -M: gadget draw-selection ( loc gadget -- ) - swap offset-rect [ - rect-bounds gl-fill-rect - ] if-fits ; - -M: node draw-selection ( loc node -- ) - 2dup value>> swap offset-rect [ - drop 2dup - [ value>> loc>> v+ ] keep - children>> [ draw-selection ] with each - ] if-fits 2drop ; - -M: pane draw-gadget* +M: pane selected-children dup gadget-selection? [ - [ selection-color>> gl-color ] - [ - [ loc>> vneg ] keep selected-children - [ draw-selection ] with each - ] bi - ] [ drop ] if ; + [ selected-subtree leaves ] + [ selection-color>> ] + bi + ] [ drop f f ] if ; : scroll-pane ( pane -- ) dup scrolls?>> [ scroll>bottom ] [ drop ] if ; diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 4c8f7c24e5..09c26fd271 100755 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math.rectangles math.vectors namespaces kernel accessors -combinators sequences opengl opengl.gl opengl.glu colors +assocs combinators sequences opengl opengl.gl opengl.glu colors colors.constants ui.gadgets ui.pens ; IN: ui.render @@ -55,21 +55,57 @@ SYMBOL: origin GENERIC: draw-children ( gadget -- ) +! For gadget selection +SYMBOL: selected-gadgets + +SYMBOL: selection-background + +GENERIC: selected-children ( gadget -- assoc/f selection-background ) + +M: gadget selected-children drop f f ; + +! For text rendering +SYMBOL: background + +SYMBOL: foreground + +GENERIC: gadget-background ( gadget -- color ) + +M: gadget gadget-background dup interior>> pen-background ; + +GENERIC: gadget-foreground ( gadget -- color ) + +M: gadget gadget-foreground dup interior>> pen-foreground ; + +> gl-fill-rect ; + +: draw-standard-background ( object -- ) + dup interior>> dup [ draw-interior ] [ 2drop ] if ; + +: draw-background ( gadget -- ) + origin get [ + [ + dup selected-gadgets get key? + [ draw-selection-background ] + [ draw-standard-background ] if + ] [ draw-gadget* ] bi + ] with-translation ; + +: draw-border ( object -- ) + dup boundary>> dup [ + origin get [ draw-boundary ] with-translation + ] [ 2drop ] if ; + +PRIVATE> + : (draw-gadget) ( gadget -- ) dup loc>> origin get v+ origin [ - [ - origin get [ - [ dup interior>> dup [ draw-interior ] [ 2drop ] if ] - [ draw-gadget* ] - bi - ] with-translation - ] - [ draw-children ] - [ - dup boundary>> dup [ - origin get [ draw-boundary ] with-translation - ] [ 2drop ] if - ] tri + [ draw-background ] [ draw-children ] [ draw-border ] tri ] with-variable ; : >absolute ( rect -- rect ) @@ -88,27 +124,24 @@ GENERIC: draw-children ( gadget -- ) [ [ (draw-gadget) ] with-clipping ] } cond ; -! For text rendering -SYMBOL: background - -SYMBOL: foreground - -GENERIC: gadget-background ( gadget -- color ) - -M: gadget gadget-background dup interior>> pen-background ; - -GENERIC: gadget-foreground ( gadget -- color ) - -M: gadget gadget-foreground dup interior>> pen-foreground ; - M: gadget draw-children - [ visible-children ] - [ gadget-background ] - [ gadget-foreground ] tri [ - [ foreground set ] when* - [ background set ] when* - [ draw-gadget ] each - ] with-scope ; + dup children>> [ + { + [ visible-children ] + [ selected-children ] + [ gadget-background ] + [ gadget-foreground ] + } cleave [ + + { + [ [ selected-gadgets set ] when* ] + [ [ selection-background set ] when* ] + [ [ background set ] when* ] + [ [ foreground set ] when* ] + } spread + [ draw-gadget ] each + ] with-scope + ] [ drop ] if ; CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 } diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor index 63c656205c..9df084210d 100644 --- a/basis/ui/traverse/traverse.factor +++ b/basis/ui/traverse/traverse.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors namespaces make sequences kernel math arrays io -ui.gadgets generic combinators ; +ui.gadgets generic combinators fry sets ; IN: ui.traverse TUPLE: node value children ; @@ -85,3 +85,13 @@ M: node gadget-text* : gadget-at-path ( parent path -- gadget ) [ swap nth-gadget ] each ; + +GENERIC# leaves* 1 ( tree assoc -- ) + +M: node leaves* [ children>> ] dip leaves* ; + +M: array leaves* '[ _ leaves* ] each ; + +M: gadget leaves* conjoin ; + +: leaves ( tree -- assoc ) H{ } clone [ leaves* ] keep ; \ No newline at end of file diff --git a/basis/unicode/categories/categories-tests.factor b/basis/unicode/categories/categories-tests.factor index 1e718cf9b7..0970df7ad8 100644 --- a/basis/unicode/categories/categories-tests.factor +++ b/basis/unicode/categories/categories-tests.factor @@ -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 diff --git a/basis/unicode/categories/categories.factor b/basis/unicode/categories/categories.factor index 126c03c869..4ca5c9a90e 100644 --- a/basis/unicode/categories/categories.factor +++ b/basis/unicode/categories/categories.factor @@ -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 ; diff --git a/extra/c/preprocessor/authors.txt b/extra/c/preprocessor/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/c/preprocessor/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/c/preprocessor/preprocessor-tests.factor b/extra/c/preprocessor/preprocessor-tests.factor new file mode 100644 index 0000000000..ba0531dfe7 --- /dev/null +++ b/extra/c/preprocessor/preprocessor-tests.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test c.preprocessor kernel accessors multiline ; +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 + + +/* +f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1); +f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1); +int i[] = { 1, 23, 4, 5, }; +char c[2][6] = { "hello", "" }; +*/ diff --git a/extra/c/preprocessor/preprocessor.factor b/extra/c/preprocessor/preprocessor.factor new file mode 100644 index 0000000000..f7cd10a0e9 --- /dev/null +++ b/extra/c/preprocessor/preprocessor.factor @@ -0,0 +1,193 @@ +! 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 unicode.categories +combinators.short-circuit ; +IN: c.preprocessor + +: initial-library-paths ( -- seq ) + V{ "/usr/include" } clone ; + +: initial-symbol-table ( -- hashtable ) + H{ + { "__APPLE__" "" } + { "__amd64__" "" } + { "__x86_64__" "" } + } clone ; + +TUPLE: preprocessor-state library-paths symbol-table +include-nesting include-nesting-max processing-disabled? +ifdef-nesting warnings errors +pragmas +include-nexts +ifs elifs elses ; + +: ( -- preprocessor-state ) + preprocessor-state new + initial-library-paths >>library-paths + initial-symbol-table >>symbol-table + 0 >>include-nesting + 200 >>include-nesting-max + 0 >>ifdef-nesting + V{ } clone >>warnings + V{ } clone >>errors + V{ } clone >>pragmas + V{ } clone >>include-nexts + V{ } clone >>ifs + V{ } clone >>elifs + V{ } clone >>elses ; + +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 ; + +: take-define-identifier ( state-parser -- string ) + skip-whitespace + [ current { [ blank? ] [ CHAR: ( = ] } 1|| ] take-until ; + +: handle-define ( preprocessor-state state-parser -- ) + [ take-define-identifier ] + [ skip-whitespace 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-if ( preprocessor-state state-parser -- ) + [ [ 1 + ] change-ifdef-nesting ] dip + skip-whitespace take-rest swap ifs>> push ; + +: handle-elif ( preprocessor-state state-parser -- ) + skip-whitespace take-rest swap elifs>> push ; + +: handle-else ( preprocessor-state state-parser -- ) + skip-whitespace take-rest swap elses>> push ; + +: handle-pragma ( preprocessor-state state-parser -- ) + skip-whitespace take-rest swap pragmas>> push ; + +: handle-include-next ( preprocessor-state state-parser -- ) + skip-whitespace take-rest swap include-nexts>> push ; + +: handle-error ( preprocessor-state state-parser -- ) + skip-whitespace take-rest swap errors>> push ; + ! 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" [ handle-if ] } + { "elif" [ handle-elif ] } + { "else" [ handle-else ] } + { "pragma" [ handle-pragma ] } + { "include_next" [ handle-include-next ] } + [ 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 + [ [ 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 [ + [ + [ dup ] dip preprocess-file + ] with-string-writer + ] with-directory ; diff --git a/extra/c/tests/test1/README b/extra/c/tests/test1/README new file mode 100644 index 0000000000..99873133b2 --- /dev/null +++ b/extra/c/tests/test1/README @@ -0,0 +1 @@ +Tests if the preprocessor bails on an infinite loop caused by mutually recursive #include lines. diff --git a/extra/c/tests/test1/hi.h b/extra/c/tests/test1/hi.h new file mode 100644 index 0000000000..c9f337c47a --- /dev/null +++ b/extra/c/tests/test1/hi.h @@ -0,0 +1 @@ +#include "lo.h" diff --git a/extra/c/tests/test1/lo.h b/extra/c/tests/test1/lo.h new file mode 100644 index 0000000000..d59fdd272e --- /dev/null +++ b/extra/c/tests/test1/lo.h @@ -0,0 +1 @@ +#include "hi.h" diff --git a/extra/c/tests/test1/test1.c b/extra/c/tests/test1/test1.c new file mode 100644 index 0000000000..d59fdd272e --- /dev/null +++ b/extra/c/tests/test1/test1.c @@ -0,0 +1 @@ +#include "hi.h" diff --git a/extra/c/tests/test10/test10.c b/extra/c/tests/test10/test10.c new file mode 100644 index 0000000000..7f38e70d73 --- /dev/null +++ b/extra/c/tests/test10/test10.c @@ -0,0 +1,3 @@ +/* +# lol +*/ diff --git a/extra/c/tests/test11/foo.h b/extra/c/tests/test11/foo.h new file mode 100644 index 0000000000..381b7535a0 --- /dev/null +++ b/extra/c/tests/test11/foo.h @@ -0,0 +1 @@ +foo.h ftw diff --git a/extra/c/tests/test11/test11.c b/extra/c/tests/test11/test11.c new file mode 100644 index 0000000000..1b05118b01 --- /dev/null +++ b/extra/c/tests/test11/test11.c @@ -0,0 +1,2 @@ +#define FOO_H "foo.h" +#include FOO_H diff --git a/extra/c/tests/test12/test12.c b/extra/c/tests/test12/test12.c new file mode 100644 index 0000000000..2da127bce0 --- /dev/null +++ b/extra/c/tests/test12/test12.c @@ -0,0 +1,3 @@ +#if 4 > (5 - 4++) +#error "Umm" +#endif diff --git a/extra/c/tests/test13/test13.c b/extra/c/tests/test13/test13.c new file mode 100644 index 0000000000..13c48ff6d0 --- /dev/null +++ b/extra/c/tests/test13/test13.c @@ -0,0 +1,2 @@ +#if 10 +#error "Umm" diff --git a/extra/c/tests/test14/test14.c b/extra/c/tests/test14/test14.c new file mode 100644 index 0000000000..1697ea1697 --- /dev/null +++ b/extra/c/tests/test14/test14.c @@ -0,0 +1,15 @@ +#if 4 > (1 + 2) +good +#endif + +#if 4 > 1 + 2 +good +#endif + +#if (4 > 1) - 1 +bad +#endif + +#if (4 > 1) - 2 +good +#endif diff --git a/extra/c/tests/test2/README b/extra/c/tests/test2/README new file mode 100644 index 0000000000..4244828197 --- /dev/null +++ b/extra/c/tests/test2/README @@ -0,0 +1 @@ +Tests whether #define and #ifdef/#endif work in the positive case. diff --git a/extra/c/tests/test2/test2.c b/extra/c/tests/test2/test2.c new file mode 100644 index 0000000000..4cc4191db1 --- /dev/null +++ b/extra/c/tests/test2/test2.c @@ -0,0 +1,17 @@ +#define YO +#ifdef YO +yo +#endif + +#define YO2 +#ifndef YO2 +yo2 +#endif + +#ifdef YO3 +yo3 +#endif + +#ifndef YO4 +yo4 +#endif diff --git a/extra/c/tests/test3/README b/extra/c/tests/test3/README new file mode 100644 index 0000000000..4244828197 --- /dev/null +++ b/extra/c/tests/test3/README @@ -0,0 +1 @@ +Tests whether #define and #ifdef/#endif work in the positive case. diff --git a/extra/c/tests/test3/test3.c b/extra/c/tests/test3/test3.c new file mode 100644 index 0000000000..8d08e836b2 --- /dev/null +++ b/extra/c/tests/test3/test3.c @@ -0,0 +1 @@ +#error "BOO" diff --git a/extra/c/tests/test4/test4.c b/extra/c/tests/test4/test4.c new file mode 100644 index 0000000000..5acd20da67 --- /dev/null +++ b/extra/c/tests/test4/test4.c @@ -0,0 +1,2 @@ +#warning "omg" +#warning "lol" diff --git a/extra/c/tests/test5/test5.c b/extra/c/tests/test5/test5.c new file mode 100644 index 0000000000..4c169640ef --- /dev/null +++ b/extra/c/tests/test5/test5.c @@ -0,0 +1,3 @@ +#define TABSIZE 100 + +int table[TABSIZE]; diff --git a/extra/c/tests/test6/test6.c b/extra/c/tests/test6/test6.c new file mode 100644 index 0000000000..3b0353a518 --- /dev/null +++ b/extra/c/tests/test6/test6.c @@ -0,0 +1 @@ +#define max(a, b) ((a) > (b) ? (a) : (b)) diff --git a/extra/c/tests/test7/test7.c b/extra/c/tests/test7/test7.c new file mode 100644 index 0000000000..4d5e66ba24 --- /dev/null +++ b/extra/c/tests/test7/test7.c @@ -0,0 +1,19 @@ +#define x 3 +#define f(a) f(x * (a)) +#undef x +#define x 2 +#define g f +#define z z[0] +#define h g(~ +#define m(a) a(w) +#define w 0,1 +#define t(a) a +#define p() int +#define q(x) x +#define r(x,y) x ## y +#define str(x) # x +f(y+1) + f(f(z)) % t(t(g)(0) + t)(1); +g(x+(3,4)-w) | h 5) & m +(f)^m(m); +p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) }; +char c[2][6] = { str(hello), str() }; diff --git a/extra/c/tests/test8/test8.c b/extra/c/tests/test8/test8.c new file mode 100644 index 0000000000..bc1e27348d --- /dev/null +++ b/extra/c/tests/test8/test8.c @@ -0,0 +1,15 @@ +#define str(s) #s +#define xstr(s) str(s) +#define debug(s, t) printf("x" # s "= %d, x" # t "= %s", \ +x ## s, x ## t) +#define INCFILE(n) vers ## n +#define glue(a, b) a## b +#define xglue(a, b) glue(a, b) +#define HIGHLOW "hello" +#define LOW LOW ", world" +debug(1, 2); +fputs(str(strncmp("abc\0d", "abc", '\4') //this goes away +== 0) str(: @\n), s); +#include xstr(INCFILE(2).h) +glue(HIGH, LOW); +xglue(HIGH, LOW) diff --git a/extra/c/tests/test9/test9.c b/extra/c/tests/test9/test9.c new file mode 100644 index 0000000000..86940cfbea --- /dev/null +++ b/extra/c/tests/test9/test9.c @@ -0,0 +1,4 @@ +#define t(x,y,z) x ## y ## z +int j[] = { t(1,2,3), t(,4,5), t(6,,7), t(8,9,), +t(10,,), t(,11,), t(,,12), t(,,) }; + diff --git a/extra/demos/demos.factor b/extra/demos/demos.factor index 8c55945105..dfd73f1236 100644 --- a/extra/demos/demos.factor +++ b/extra/demos/demos.factor @@ -1,22 +1,16 @@ - -USING: kernel fry sequences - vocabs.loader help.vocabs - ui ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers - ui.tools.listener - accessors ; - +USING: kernel fry sequences vocabs.loader help.vocabs ui +ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.borders +ui.gadgets.scrollers ui.tools.listener accessors ; IN: demos : demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ; : ( vocab-name -- button ) - dup '[ drop [ _ run ] call-listener ] ; + dup '[ drop [ _ run ] \ run call-listener ] ; : ( -- gadget ) - 1 >>fill demo-vocabs [ add-gadget ] each ; + 1 >>fill { 2 2 } >>gap demo-vocabs [ add-gadget ] each ; -: demos ( -- ) [ "Demos" open-window ] with-ui ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: demos ( -- ) [ { 2 2 } "Demos" open-window ] with-ui ; MAIN: demos \ No newline at end of file diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index ba3438e37d..ceadc9fe6e 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -1,13 +1,16 @@ USING: words kernel sequences locals locals.parser locals.definitions accessors parser namespaces continuations -summary definitions generalizations arrays ; +summary definitions generalizations arrays prettyprint debugger io ; IN: descriptive ERROR: descriptive-error args underlying word ; -M: descriptive-error summary - word>> "The " swap name>> " word encountered an error." - 3append ; +M: descriptive-error error. + "The word " write dup word>> pprint " encountered an error." print + "Arguments:" print + dup args>> stack. + "Error:" print + underlying>> error. ; CHAR: \ CHAR: " take-token* ] unit-test + +[ "" ] +[ "" take-rest ] unit-test + +[ "" ] +[ "abc" dup "abc" take-sequence drop take-rest ] unit-test diff --git a/extra/html/parser/state/state.factor b/extra/html/parser/state/state.factor index 86adb0f914..5f845ce810 100644 --- a/extra/html/parser/state/state.factor +++ b/extra/html/parser/state/state.factor @@ -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 ; diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor index eff923dc01..179e03f1cf 100644 --- a/extra/peg/pl0/pl0.factor +++ b/extra/peg/pl0/pl0.factor @@ -6,20 +6,20 @@ IN: peg.pl0 #! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0 -EBNF: pl0 +EBNF: pl0 -block = { "CONST" ident "=" number { "," ident "=" number }* ";" }? - { "VAR" ident { "," ident }* ";" }? - { "PROCEDURE" ident ";" { block ";" }? }* statement -statement = { ident ":=" expression - | "CALL" ident - | "BEGIN" statement { ";" statement }* "END" - | "IF" condition "THEN" statement - | "WHILE" condition "DO" statement }? +block = { "CONST" ident "=" number { "," ident "=" number }* ";" }? + { "VAR" ident { "," ident }* ";" }? + { "PROCEDURE" ident ";" { block ";" }? }* statement +statement = { ident ":=" expression + | "CALL" ident + | "BEGIN" statement { ";" statement }* "END" + | "IF" condition "THEN" statement + | "WHILE" condition "DO" statement }? condition = { "ODD" expression } | { expression ("=" | "#" | "<=" | "<" | ">=" | ">") expression } -expression = {"+" | "-"}? term { {"+" | "-"} term }* -term = factor { {"*" | "/"} factor }* +expression = {"+" | "-"}? term { {"+" | "-"} term }* +term = factor { {"*" | "/"} factor }* factor = ident | number | "(" expression ")" ident = (([a-zA-Z])+) => [[ >string ]] digit = ([0-9]) => [[ digit> ]] diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 5961d9e86f..bc1bb900ce 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -58,6 +58,7 @@ (number constant "integers and floats") (ratio constant "ratios") (declaration keyword "declaration words") + (ebnf-form constant "EBNF: ... ;EBNF form") (parsing-word keyword "parsing words") (setter-word function-name "setter words (>>foo)") (getter-word function-name "getter words (foo>>)") @@ -75,7 +76,9 @@ (defun fuel-font-lock--syntactic-face (state) (if (nth 3 state) 'factor-font-lock-string (let ((c (char-after (nth 8 state)))) - (cond ((or (char-equal c ?\ ) (char-equal c ?\n)) + (cond ((or (char-equal c ?\ ) + (char-equal c ?\n) + (char-equal c ?E)) (save-excursion (goto-char (nth 8 state)) (beginning-of-line) @@ -85,6 +88,8 @@ 'factor-font-lock-symbol) ((looking-at-p "C-ENUM:\\( \\|\n\\)") 'factor-font-lock-constant) + ((looking-at-p "E") + 'factor-font-lock-ebnf-form) (t 'default)))) ((or (char-equal c ?U) (char-equal c ?C)) 'factor-font-lock-parsing-word) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 4cff58ae3b..7aba6282d6 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -48,7 +48,7 @@ "B" "BIN:" "C:" "C-ENUM:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method" "DEFER:" - "ERROR:" "EXCLUDE:" + "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" "f" "FORGET:" "FROM:" "FUNCTION:" "GENERIC#" "GENERIC:" "HELP:" "HEX:" "HOOK:" @@ -254,6 +254,8 @@ ("\\_<<\\(\"\\)\\_>" (1 "\\_>" (1 ">b")) ;; Multiline constructs + ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "" (1 ">b")) ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) ("\\_b")) diff --git a/vm/platform.h b/vm/platform.h index 21336e88bb..70804542b4 100644 --- a/vm/platform.h +++ b/vm/platform.h @@ -96,7 +96,7 @@ #if defined(FACTOR_X86) #include "os-solaris-x86.32.h" #elif defined(FACTOR_AMD64) - #incluide "os-solaris-x86.64.h" + #include "os-solaris-x86.64.h" #else #error "Unsupported Solaris flavor" #endif