diff --git a/basis/combinators/short-circuit/short-circuit-tests.factor b/basis/combinators/short-circuit/short-circuit-tests.factor index b2bcb2a60f..3495555062 100644 --- a/basis/combinators/short-circuit/short-circuit-tests.factor +++ b/basis/combinators/short-circuit/short-circuit-tests.factor @@ -1,4 +1,4 @@ -USING: kernel math tools.test combinators.short-circuit ; +USING: kernel math tools.test combinators.short-circuit accessors ; IN: combinators.short-circuit.tests [ 3 ] [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test @@ -22,4 +22,19 @@ IN: combinators.short-circuit.tests : compiled-|| ( a b -- ? ) { [ + odd? ] [ + 100 > ] [ + ] } 2|| ; [ 30 ] [ 10 20 compiled-|| ] unit-test -[ 2 ] [ 1 1 compiled-|| ] unit-test \ No newline at end of file +[ 2 ] [ 1 1 compiled-|| ] unit-test + +! && and || should be row-polymorphic both when compiled and when interpreted + +: row-&& ( -- ? ) + f t { [ drop dup ] } 1&& nip ; + +[ f ] [ row-&& ] unit-test +[ f ] [ \ row-&& def>> call ] unit-test + +: row-|| ( -- ? ) + f t { [ drop dup ] } 1|| nip ; + +[ f ] [ row-|| ] unit-test +[ f ] [ \ row-|| def>> call ] unit-test + diff --git a/basis/combinators/short-circuit/short-circuit.factor b/basis/combinators/short-circuit/short-circuit.factor index dabbe07afb..284e2a60d4 100644 --- a/basis/combinators/short-circuit/short-circuit.factor +++ b/basis/combinators/short-circuit/short-circuit.factor @@ -1,11 +1,19 @@ USING: kernel combinators quotations arrays sequences assocs -generalizations macros fry ; +generalizations macros fry math ; IN: combinators.short-circuit + + MACRO: n&& ( quots n -- quot ) [ [ [ f ] ] 2dip swap [ - [ '[ drop _ ndup @ dup not ] ] + [ '[ drop _ _ keeping dup not ] ] [ drop '[ drop _ ndrop f ] ] 2bi 2array ] with map @@ -27,7 +35,7 @@ PRIVATE> MACRO: n|| ( quots n -- quot ) [ [ [ f ] ] 2dip swap [ - [ '[ drop _ ndup @ dup ] ] + [ '[ drop _ _ keeping dup ] ] [ drop '[ _ nnip ] ] 2bi 2array ] with map diff --git a/basis/core-foundation/arrays/arrays.factor b/basis/core-foundation/arrays/arrays.factor index f0dfff9143..398192643e 100644 --- a/basis/core-foundation/arrays/arrays.factor +++ b/basis/core-foundation/arrays/arrays.factor @@ -15,7 +15,8 @@ FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* v FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ; : CF>array ( alien -- array ) - dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ; + dup CFArrayGetCount + [ CFArrayGetValueAtIndex ] with { } map-integers ; : ( seq -- alien ) f over length &: kCFTypeArrayCallBacks CFArrayCreateMutable diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 18b564b149..815304b21f 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -50,7 +50,7 @@ M: string error. print ; : restart. ( restart n -- ) [ - 1 + dup 3 <= [ ":" % # " " % ] [ # " :res " % ] if + 1 + dup 3 <= [ ":" % # " " % ] [ # " :res " % ] if name>> % ] "" make print ; diff --git a/basis/help/apropos/apropos.factor b/basis/help/apropos/apropos.factor index e77e7bccad..1fdbef3cb1 100644 --- a/basis/help/apropos/apropos.factor +++ b/basis/help/apropos/apropos.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs fry help.markup help.topics io kernel make math math.parser namespaces sequences sorting @@ -19,6 +19,8 @@ TUPLE: more-completions seq ; CONSTANT: max-completions 5 +M: more-completions valid-article? drop t ; + M: more-completions article-title seq>> length number>string " results" append ; @@ -60,6 +62,8 @@ TUPLE: apropos search ; C: apropos +M: apropos valid-article? drop t ; + M: apropos article-title search>> "Search results for “" "”" surround ; diff --git a/basis/help/help.factor b/basis/help/help.factor index 6fb87d7a33..27ce7a1435 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays io io.styles kernel namespaces make parser prettyprint sequences words words.symbol assocs @@ -48,6 +48,8 @@ M: predicate word-help* drop \ $predicate ; : all-errors ( -- seq ) all-words [ error? ] filter sort-articles ; +M: word valid-article? drop t ; + M: word article-name name>> ; M: word article-title diff --git a/basis/help/home/home.factor b/basis/help/home/home.factor index 9cb3c6f1bb..6ab8b0933d 100644 --- a/basis/help/home/home.factor +++ b/basis/help/home/home.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays compiler.units fry hashtables help.topics io kernel math namespaces sequences sets help.vocabs @@ -21,7 +21,8 @@ M: apropos add-recent-where recent-searches ; M: object add-recent-where f ; : $recent ( element -- ) - first get reverse [ nl ] [ 1array $pretty-link ] interleave ; + first get [ valid-article? ] filter + [ nl ] [ 1array $pretty-link ] interleave ; : $recent-searches ( element -- ) drop recent-searches get [ <$link> ] map $list ; diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor index a251849e8f..ea39818485 100644 --- a/basis/help/topics/topics.factor +++ b/basis/help/topics/topics.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license.x USING: accessors arrays definitions generic assocs io kernel namespaces make prettyprint prettyprint.sections @@ -38,6 +38,7 @@ SYMBOL: article-xref article-xref [ H{ } clone ] initialize +GENERIC: valid-article? ( topic -- ? ) GENERIC: article-name ( topic -- string ) GENERIC: article-title ( topic -- string ) GENERIC: article-content ( topic -- content ) @@ -49,6 +50,7 @@ TUPLE: article title content loc ; :
( title content -- article ) f \ article boa ; +M: article valid-article? drop t ; M: article article-name title>> ; M: article article-title title>> ; M: article article-content content>> ; @@ -61,12 +63,14 @@ M: no-article summary : article ( name -- article ) articles get ?at [ no-article ] unless ; +M: object valid-article? articles get key? ; M: object article-name article article-name ; M: object article-title article article-title ; M: object article-content article article-content ; M: object article-parent article-xref get at ; M: object set-article-parent article-xref get set-at ; +M: link valid-article? name>> valid-article? ; M: link article-name name>> article-name ; M: link article-title name>> article-title ; M: link article-content name>> article-content ; @@ -74,6 +78,7 @@ M: link article-parent name>> article-parent ; M: link set-article-parent name>> set-article-parent ; ! Special case: f help +M: f valid-article? drop t ; M: f article-name drop \ f article-name ; M: f article-title drop \ f article-title ; M: f article-content drop \ f article-content ; diff --git a/basis/help/vocabs/vocabs.factor b/basis/help/vocabs/vocabs.factor index 0aa17ef676..d92ca5d91e 100644 --- a/basis/help/vocabs/vocabs.factor +++ b/basis/help/vocabs/vocabs.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2009 Slava Pestov. +! Copyright (C) 2007, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs classes classes.builtin classes.intersection classes.mixin classes.predicate @@ -278,6 +278,8 @@ INSTANCE: vocab topic INSTANCE: vocab-link topic +M: vocab-spec valid-article? drop t ; + M: vocab-spec article-title vocab-name " vocabulary" append ; M: vocab-spec article-name vocab-name ; @@ -289,6 +291,8 @@ M: vocab-spec article-parent drop "vocab-index" ; M: vocab-tag >link ; +M: vocab-tag valid-article? drop t ; + M: vocab-tag article-title name>> "Vocabularies tagged “" "”" surround ; @@ -303,6 +307,8 @@ M: vocab-tag summary article-title ; M: vocab-author >link ; +M: vocab-author valid-article? drop t ; + M: vocab-author article-title name>> "Vocabularies by " prepend ; diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 4171abca09..8eca1995a2 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,18 +1,13 @@ ! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs combinators io io.streams.string json -kernel math math.floats.parser math.parser prettyprint sequences -strings vectors ; +kernel math math.parser prettyprint sequences strings vectors ; IN: json.reader float ] - [ [ "eE." index ] any? [ >integer ] unless ] bi - ] dip ; + [ append string>number ] dip ; DEFER: j-string diff --git a/basis/math/floats/parser/parser.factor b/basis/math/floats/parser/parser.factor deleted file mode 100644 index 2bff867056..0000000000 --- a/basis/math/floats/parser/parser.factor +++ /dev/null @@ -1,14 +0,0 @@ -! Copyright (C) 2010 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax ; -IN: math.floats.parser - - - -: string>float ( str -- n/f ) f strtod ; - diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index a1466dd22c..0a9b73fe0c 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel math.constants math.private math.bits -math.libm combinators math.order sequences ; +math.libm combinators fry math.order sequences ; IN: math.functions : >fraction ( a/b -- a b ) @@ -13,12 +13,13 @@ IN: math.functions GENERIC: sqrt ( x -- y ) foldable M: real sqrt - >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; inline + >float dup 0.0 < + [ neg fsqrt [ 0.0 ] dip rect> ] [ fsqrt ] if ; inline : factor-2s ( n -- r s ) #! factor an integer into 2^r * s dup 0 = [ 1 ] [ - 0 swap [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while + [ 0 ] dip [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while ] if ; inline fraction ] dip [ ^n ] curry bi@ / ; + [ >fraction ] dip '[ _ ^n ] bi@ / ; M: float ^n (^n) ; @@ -62,7 +63,7 @@ M: float exp fexp ; inline M: real exp >float exp ; inline -M: complex exp >rect swap exp swap polar> ; inline +M: complex exp >rect [ exp ] dip polar> ; inline rect swap exp swap polar> ; inline : 0^ ( x -- z ) [ 0/0. ] [ 0 < 1/0. 0 ? ] if-zero ; inline -: (^mod) ( n x y -- z ) - make-bits 1 [ - [ dupd * pick mod ] when [ sq over mod ] dip - ] reduce 2nip ; inline +: (^mod) ( x y n -- z ) + [ make-bits 1 ] dip dup + '[ [ over * _ mod ] when [ sq _ mod ] dip ] reduce nip ; inline : (gcd) ( b a x y -- a d ) over zero? [ @@ -125,11 +125,8 @@ ERROR: non-trivial-divisor n ; [ non-trivial-divisor ] if ; foldable : ^mod ( x y n -- z ) - over 0 < [ - [ [ neg ] dip ^mod ] keep mod-inv - ] [ - -rot (^mod) - ] if ; foldable + over 0 < + [ [ [ neg ] dip ^mod ] keep mod-inv ] [ (^mod) ] if ; foldable GENERIC: absq ( x -- y ) foldable diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor index 00c1ad3583..89fd8e7708 100644 --- a/basis/ui/backend/cocoa/tools/tools.factor +++ b/basis/ui/backend/cocoa/tools/tools.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2006, 2009 Slava Pestov. +! Copyright (C) 2006, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax cocoa cocoa.nibs cocoa.application cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.runtime cocoa.subclassing core-foundation core-foundation.strings help.topics kernel memory namespaces parser system ui ui.tools.browser ui.tools.listener ui.backend.cocoa eval -locals vocabs.refresh ; +locals listener vocabs.refresh ; FROM: alien.c-types => int void ; IN: ui.backend.cocoa.tools @@ -82,12 +82,20 @@ CLASS: { "evalInListener:userData:error:" void { id SEL id id id } - [ nip [ eval-listener f ] do-service 2drop ] + [ + nip + [ eval-listener f ] do-service + 2drop + ] } { "evalToString:userData:error:" void { id SEL id id id } - [ nip [ eval>string ] do-service 2drop ] + [ + nip + [ [ (eval>string) ] with-interactive-vocabs ] do-service + 2drop + ] } ; : register-services ( -- ) diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor index 0d720ac0b1..db8e43cde5 100644 --- a/basis/ui/text/core-text/core-text.factor +++ b/basis/ui/text/core-text/core-text.factor @@ -1,11 +1,10 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors alien core-graphics.types core-text -core-text.fonts kernel hashtables namespaces sequences -ui.gadgets.worlds ui.text ui.text.private opengl opengl.gl -opengl.textures destructors combinators core-foundation -core-foundation.strings math math.vectors init colors colors.constants -cache arrays images ; +core-text.fonts kernel hashtables namespaces sequences ui.text +ui.text.private destructors combinators core-foundation +core-foundation.strings math math.vectors init colors +colors.constants cache arrays images ; IN: ui.text.core-text SINGLETON: core-text-renderer @@ -18,13 +17,8 @@ M: core-text-renderer string-dim M: core-text-renderer flush-layout-cache cached-lines get purge-cache ; -: rendered-line ( font string -- texture ) - world get world-text-handle [ - cached-line [ image>> ] [ loc>> ] bi - ] 2cache ; - -M: core-text-renderer draw-string ( font string -- ) - rendered-line draw-texture ; +M: core-text-renderer string>image ( font string -- image loc ) + cached-line [ image>> ] [ loc>> ] bi ; M: core-text-renderer x>offset ( x font string -- n ) [ 2drop 0 ] [ diff --git a/basis/ui/text/pango/pango.factor b/basis/ui/text/pango/pango.factor index 92c4fe5c75..39a7b30348 100644 --- a/basis/ui/text/pango/pango.factor +++ b/basis/ui/text/pango/pango.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types assocs cache kernel math math.vectors -namespaces opengl.textures pango.cairo pango.layouts ui.gadgets.worlds -ui.text ui.text.private pango sequences ; +USING: accessors assocs cache kernel math math.vectors +namespaces pango.cairo pango.layouts ui.text ui.text.private +pango sequences ; IN: ui.text.pango SINGLETON: pango-renderer @@ -14,13 +14,8 @@ M: pango-renderer string-dim M: pango-renderer flush-layout-cache cached-layouts get purge-cache ; -: rendered-layout ( font string -- texture ) - world get world-text-handle [ - cached-layout [ image>> ] [ text-position vneg ] bi - ] 2cache ; - -M: pango-renderer draw-string ( font string -- ) - rendered-layout draw-texture ; +M: pango-renderer string>image ( font string -- image loc ) + cached-layout [ image>> ] [ text-position vneg ] bi ; M: pango-renderer x>offset ( x font string -- n ) cached-layout swap x>line-offset ; diff --git a/basis/ui/text/text-docs.factor b/basis/ui/text/text-docs.factor index 8b3b5ad24f..aef4b91b9a 100644 --- a/basis/ui/text/text-docs.factor +++ b/basis/ui/text/text-docs.factor @@ -1,5 +1,5 @@ IN: ui.text -USING: help.markup help.syntax kernel ui.text.private strings math fonts ; +USING: help.markup help.syntax kernel ui.text.private strings math fonts images ; HELP: string-width { $values { "font" font } { "string" string } { "w" "a positive integer" } } @@ -48,6 +48,10 @@ HELP: line-metrics { $values { "font" font } { "string" string } { "metrics" line-metrics } } { $contract "Outputs a " { $link metrics } " object with text measurements." } ; +HELP: string>image +{ $values { "font" font } { "string" string } { "image" image } { "loc" "a pair of real numbers" } } +{ $description "Renders a line of text into an image." } ; + ARTICLE: "text-rendering" "Rendering text" "The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X, Uniscribe on Windows and Pango on X11." { $subsections "fonts" } @@ -64,7 +68,7 @@ ARTICLE: "text-rendering" "Rendering text" offset>x } "Rendering text:" -{ $subsections draw-text } +{ $subsections draw-text string>image } "Low-level text protocol for UI backends:" { $subsections string-width diff --git a/basis/ui/text/text-tests.factor b/basis/ui/text/text-tests.factor index 7ee901dc80..d365168ba1 100644 --- a/basis/ui/text/text-tests.factor +++ b/basis/ui/text/text-tests.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test ui.text fonts math accessors kernel sequences ; +USING: tools.test ui.text images fonts math arrays accessors kernel +sequences ; IN: ui.text.tests [ t ] [ 0 sans-serif-font "aaa" offset>x zero? ] unit-test @@ -20,3 +21,5 @@ IN: ui.text.tests [ t ] [ sans-serif-font "" text-dim first zero? ] unit-test [ f ] [ sans-serif-font font-metrics height>> zero? ] unit-test + +[ t ] [ serif-font "Hello world" string>image [ image? ] [ pair? ] bi* and ] unit-test diff --git a/basis/ui/text/text.factor b/basis/ui/text/text.factor index 6d5c7e56a6..fa85b997e1 100644 --- a/basis/ui/text/text.factor +++ b/basis/ui/text/text.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel arrays sequences math math.order cache opengl -opengl.gl strings fonts colors accessors namespaces -ui.gadgets.worlds ; +USING: kernel arrays assocs sequences math math.order cache +opengl opengl.gl opengl.textures strings fonts colors accessors +namespaces ui.gadgets.worlds ; IN: ui.text image font-renderer ( font string -- image loc ) + +> ] when empty? ; + +: draw-string ( font string -- ) + dup string-empty? [ 2drop ] [ + world get world-text-handle + [ string>image ] 2cache + draw-texture + ] if ; + +PRIVATE> + GENERIC: draw-text ( font text -- ) M: string draw-text draw-string ; diff --git a/basis/ui/text/uniscribe/uniscribe.factor b/basis/ui/text/uniscribe/uniscribe.factor index d5e836044b..b9e5e1f694 100644 --- a/basis/ui/text/uniscribe/uniscribe.factor +++ b/basis/ui/text/uniscribe/uniscribe.factor @@ -1,8 +1,7 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs cache kernel math math.vectors sequences fonts -namespaces opengl.textures ui.text ui.text.private ui.gadgets.worlds -windows.uniscribe ; +USING: accessors assocs cache kernel math math.vectors sequences +fonts namespaces ui.text ui.text.private windows.uniscribe ; IN: ui.text.uniscribe SINGLETON: uniscribe-renderer @@ -14,14 +13,8 @@ M: uniscribe-renderer string-dim M: uniscribe-renderer flush-layout-cache cached-script-strings get purge-cache ; -: rendered-script-string ( font string -- texture ) - world get world-text-handle - [ cached-script-string image>> { 0 0 } ] - 2cache ; - -M: uniscribe-renderer draw-string ( font string -- ) - dup dup selection? [ string>> ] when empty? - [ 2drop ] [ rendered-script-string draw-texture ] if ; +M: uniscribe-renderer string>image ( font string -- image loc ) + cached-script-string image>> { 0 0 } ; M: uniscribe-renderer x>offset ( x font string -- n ) [ 2drop 0 ] [ diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor index c12861de9b..1086b9470b 100644 --- a/core/classes/algebra/algebra-tests.factor +++ b/core/classes/algebra/algebra-tests.factor @@ -211,12 +211,6 @@ MIXIN: empty-mixin [ f ] [ null class-not null class= ] unit-test -! class<=> - -[ +lt+ ] [ sequence object class<=> ] unit-test -[ +gt+ ] [ object sequence class<=> ] unit-test -[ +eq+ ] [ integer integer class<=> ] unit-test - ! smallest-class etc [ real ] [ { real sequence } smallest-class ] unit-test [ real ] [ { sequence real } smallest-class ] unit-test diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 543a2f7420..69289600e4 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -57,13 +57,6 @@ M: anonymous-complement classoid? class>> classoid? ; [ [ rank-class ] bi@ < ] } cond ; -: class<=> ( first second -- ? ) - { - { [ 2dup class<= not ] [ 2drop +gt+ ] } - { [ 2dup swap class<= not ] [ 2drop +lt+ ] } - [ [ rank-class ] bi@ <=> ] - } cond ; - : class= ( first second -- ? ) [ class<= ] [ swap class<= ] 2bi and ; diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor index 3f3ea7ba1b..6f57b06658 100644 --- a/core/math/integers/integers-tests.factor +++ b/core/math/integers/integers-tests.factor @@ -220,7 +220,7 @@ unit-test 1 random zero? [ >bignum ] when ; [ t ] [ - 1000 [ + 10000 [ drop random-integer random-integer diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index 5f461e22a3..4dd948021a 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -119,30 +119,26 @@ M: bignum (log2) bignum-log2 ; inline : scale-denonimator ( den -- scaled-den scale' ) dup twos neg [ shift ] keep ; inline -: pre-scale ( num den -- scale shifted-num scaled-den ) +: pre-scale ( num den -- mantissa den' scale ) 2dup [ log2 ] bi@ - - [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] bi-curry bi* - -rot ; inline + [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] bi-curry bi* ; inline ! Second step: loop -: shift-mantissa ( scale mantissa -- scale' mantissa' ) - [ 1 + ] [ 2/ ] bi* ; inline - -: /f-loop ( scale mantissa den -- scale' fraction-and-guard rem ) - [ 2dup /i log2 53 > ] - [ [ shift-mantissa ] dip ] - while /mod ; inline +: /f-loop ( mantissa den scale -- fraction-and-guard rem scale' ) + [ 2over /i log2 53 > ] + [ [ 2/ ] [ ] [ 1 + ] tri* ] while + [ /mod ] dip ; inline ! Third step: post-scaling : unscaled-float ( mantissa -- n ) 52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline -: scale-float ( scale mantissa -- float' ) - [ dup 0 < [ neg 2^ recip ] [ 2^ ] if ] dip * ; inline +: scale-float ( mantissa scale -- float' ) + dup 0 < [ neg 2^ recip ] [ 2^ ] if * ; inline -: post-scale ( scale mantissa -- n ) - 2/ dup log2 52 > [ shift-mantissa ] when - unscaled-float scale-float ; inline +: post-scale ( mantissa scale -- n ) + [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when + [ unscaled-float ] dip scale-float ; inline ! Main word : /f-abs ( m n -- f ) @@ -153,8 +149,8 @@ M: bignum (log2) bignum-log2 ; inline drop 1/0. ] [ pre-scale - /f-loop over odd? - [ zero? [ 1 + ] unless ] [ drop ] if + /f-loop + [ over odd? [ zero? [ 1 + ] unless ] [ drop ] if ] dip post-scale ] if-zero ] if ; inline diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 10be0454b9..be1111b826 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -1,4 +1,4 @@ -USING: arrays kernel math namespaces sequences kernel.private +USING: arrays kernel math math.order namespaces sequences kernel.private sequences.private strings sbufs tools.test vectors assocs generic vocabs.loader ; IN: sequences.tests @@ -300,3 +300,12 @@ USE: make [ t ] [ 0 array-capacity? ] unit-test [ f ] [ -1 array-capacity? ] unit-test + +[ +lt+ ] [ { 0 0 0 } { 1 1 1 } <=> ] unit-test +[ +lt+ ] [ { 0 0 0 } { 0 1 1 } <=> ] unit-test +[ +lt+ ] [ { 0 0 0 } { 0 0 0 0 } <=> ] unit-test +[ +gt+ ] [ { 1 1 1 } { 0 0 0 } <=> ] unit-test +[ +gt+ ] [ { 0 1 1 } { 0 0 0 } <=> ] unit-test +[ +gt+ ] [ { 0 0 0 0 } { 0 0 0 } <=> ] unit-test +[ +eq+ ] [ { } { } <=> ] unit-test +[ +eq+ ] [ { 1 2 3 } { 1 2 3 } <=> ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d3a7aba1c3..23ab4b5d84 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -91,6 +91,8 @@ M: sequence set-nth-unsafe set-nth ; inline : change-nth-unsafe ( i seq quot -- ) [ [ nth-unsafe ] dip call ] 3keep drop set-nth-unsafe ; inline +PRIVATE> + ! The f object supports the sequence protocol trivially M: f length drop 0 ; inline M: f nth-unsafe nip ; inline @@ -98,20 +100,18 @@ M: f like drop [ f ] when-empty ; inline INSTANCE: f immutable-sequence -PRIVATE> - -! In the future, this will replace integer sequences +! Integer sequences TUPLE: iota { n integer read-only } ; : iota ( n -- iota ) \ iota boa ; inline -> ; inline M: iota nth-unsafe drop ; inline INSTANCE: iota immutable-sequence + [ empty? not ] filter ; : mismatch ( seq1 seq2 -- i ) - [ min-length iota ] 2keep + [ min-length ] 2keep [ 2nth-unsafe = not ] 2curry - find drop ; inline + find-integer ; inline M: sequence <=> - 2dup mismatch - [ -rot 2nth-unsafe <=> ] [ [ length ] compare ] if* ; + [ mismatch ] 2keep pick + [ 2nth-unsafe <=> ] [ [ length ] compare nip ] if ; : sequence= ( seq1 seq2 -- ? ) 2dup [ length ] bi@ = diff --git a/extra/game/models/collada/collada.factor b/extra/game/models/collada/collada.factor index 953e420562..ef1c55049b 100644 --- a/extra/game/models/collada/collada.factor +++ b/extra/game/models/collada/collada.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Erik Charlebois ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs grouping hashtables kernel locals -math math.floats.parser math.parser sequences sequences.deep +math math.parser sequences sequences.deep specialized-arrays.instances.alien.c-types.float specialized-arrays.instances.alien.c-types.uint splitting xml xml.data xml.traversal math.order namespaces combinators images @@ -23,7 +23,7 @@ SYMBOLS: up-axis unit-ratio ; " \t\n" split harvest [ string>number ] map ; : string>floats ( string -- float-seq ) - " \t\n" split harvest [ string>float ] map ; + " \t\n" split harvest [ string>number ] map ; : x/ ( tag child-name -- child-tag ) [ tag-named ] diff --git a/extra/game/models/obj/obj-docs.factor b/extra/game/models/obj/obj-docs.factor index adea0ef34b..ceb61dbb17 100644 --- a/extra/game/models/obj/obj-docs.factor +++ b/extra/game/models/obj/obj-docs.factor @@ -22,9 +22,9 @@ HELP: md { $values { "material-dictionary" assoc } } { $description "Convenience word for accessing the material dictionary while parsing primitives. " } ; -HELP: strings>floats -{ $values { "strings" sequence } { "floats" sequence } } -{ $description "Convert a sequence of strings to a sequence of floats." } ; +HELP: strings>numbers +{ $values { "strings" sequence } { "numbers" sequence } } +{ $description "Convert a sequence of strings to a sequence of numbers." } ; HELP: strings>faces { $values { "strings" sequence } { "faces" sequence } } diff --git a/extra/game/models/obj/obj.factor b/extra/game/models/obj/obj.factor index e331c415e5..9ac59444db 100644 --- a/extra/game/models/obj/obj.factor +++ b/extra/game/models/obj/obj.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2010 Erik Charlebois ! See http://factorcode.org/license.txt for BSD license. -USING: io io.encodings.ascii math.parser math.floats.parser -sequences splitting kernel assocs io.files combinators -math.order math namespaces arrays sequences.deep accessors +USING: io io.encodings.ascii math.parser sequences splitting +kernel assocs io.files combinators math.order math namespaces +arrays sequences.deep accessors specialized-arrays.instances.alien.c-types.float specialized-arrays.instances.alien.c-types.uint game.models game.models.util gpu.shaders images game.models.loader @@ -36,8 +36,8 @@ TUPLE: material : cm ( -- current-material ) current-material get ; inline : md ( -- material-dictionary ) material-dictionary get ; inline -: strings>floats ( strings -- floats ) - [ string>float ] map ; +: strings>numbers ( strings -- numbers ) + [ string>number ] map ; : strings>faces ( strings -- faces ) [ "/" split [ string>number ] map ] map ; @@ -54,22 +54,22 @@ TUPLE: material [ material new swap >>name current-material set ] [ cm swap md set-at ] bi ] } - { "Ka" [ 3 head [ string>float ] map cm (>>ambient-reflectivity) ] } - { "Kd" [ 3 head [ string>float ] map cm (>>diffuse-reflectivity) ] } - { "Ks" [ 3 head [ string>float ] map cm (>>specular-reflectivity) ] } - { "Tf" [ 3 head [ string>float ] map cm (>>transmission-filter) ] } - { "d" [ first string>float cm (>>dissolve) ] } - { "Ns" [ first string>float cm (>>specular-exponent) ] } - { "Ni" [ first string>float cm (>>refraction-index) ] } - { "map_Ka" [ first cm (>>ambient-map) ] } - { "map_Kd" [ first cm (>>diffuse-map) ] } - { "map_Ks" [ first cm (>>specular-map) ] } - { "map_Ns" [ first cm (>>specular-exponent-map) ] } - { "map_d" [ first cm (>>dissolve-map) ] } - { "map_bump" [ first cm (>>bump-map) ] } - { "bump" [ first cm (>>bump-map) ] } - { "disp" [ first cm (>>displacement-map) ] } - { "refl" [ first cm (>>reflection-map) ] } + { "Ka" [ 3 head strings>numbers cm (>>ambient-reflectivity) ] } + { "Kd" [ 3 head strings>numbers cm (>>diffuse-reflectivity) ] } + { "Ks" [ 3 head strings>numbers cm (>>specular-reflectivity) ] } + { "Tf" [ 3 head strings>numbers cm (>>transmission-filter) ] } + { "d" [ first string>number cm (>>dissolve) ] } + { "Ns" [ first string>number cm (>>specular-exponent) ] } + { "Ni" [ first string>number cm (>>refraction-index) ] } + { "map_Ka" [ first cm (>>ambient-map) ] } + { "map_Kd" [ first cm (>>diffuse-map) ] } + { "map_Ks" [ first cm (>>specular-map) ] } + { "map_Ns" [ first cm (>>specular-exponent-map) ] } + { "map_d" [ first cm (>>dissolve-map) ] } + { "map_bump" [ first cm (>>bump-map) ] } + { "bump" [ first cm (>>bump-map) ] } + { "disp" [ first cm (>>displacement-map) ] } + { "refl" [ first cm (>>reflection-map) ] } [ 2drop ] } case ] unless-empty ; @@ -137,9 +137,9 @@ VERTEX-FORMAT: obj-vertex-format [ rest ] [ first ] bi { { "mtllib" [ first read-mtl material-dictionary set ] } - { "v" [ strings>floats 3 head vp [ push* ] change ] } - { "vt" [ strings>floats 2 head vt [ push* ] change ] } - { "vn" [ strings>floats 3 head vn [ push* ] change ] } + { "v" [ strings>numbers 3 head vp [ push* ] change ] } + { "vt" [ strings>numbers 2 head vt [ push* ] change ] } + { "vn" [ strings>numbers 3 head vn [ push* ] change ] } { "usemtl" [ push-current-model first md at current-material set ] } { "f" [ strings>faces face>aos [ [ current-model [ push* ] change ] each ] each ] } [ 2drop ] diff --git a/extra/mason/release/archive/archive.factor b/extra/mason/release/archive/archive.factor index 51534edccd..ceec84e475 100644 --- a/extra/mason/release/archive/archive.factor +++ b/extra/mason/release/archive/archive.factor @@ -9,14 +9,14 @@ IN: mason.release.archive : base-name ( -- string ) [ "factor-" % platform % "-" % stamp get % ] "" make ; -: extension ( -- extension ) - target-os get { +: extension ( os -- extension ) + { { "winnt" [ ".zip" ] } { "macosx" [ ".dmg" ] } [ drop ".tar.gz" ] } case ; -: archive-name ( -- string ) base-name extension append ; +: archive-name ( -- string ) base-name target-os get extension append ; :: make-windows-archive ( archive-name -- ) { "zip" "-r" archive-name "factor" } short-running-process ; diff --git a/basis/math/floats/parser/authors.txt b/extra/mason/server/authors.txt similarity index 100% rename from basis/math/floats/parser/authors.txt rename to extra/mason/server/authors.txt diff --git a/extra/mason/notify/server/authors.txt b/extra/mason/server/notify/authors.txt similarity index 100% rename from extra/mason/notify/server/authors.txt rename to extra/mason/server/notify/authors.txt diff --git a/extra/mason/notify/server/server.factor b/extra/mason/server/notify/notify.factor similarity index 57% rename from extra/mason/notify/server/server.factor rename to extra/mason/server/notify/notify.factor index 5e99b15df5..2c04a43016 100644 --- a/extra/mason/notify/server/server.factor +++ b/extra/mason/server/notify/notify.factor @@ -1,46 +1,9 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators combinators.smart command-line db -db.sqlite db.tuples db.types io io.encodings.utf8 io.files -present kernel namespaces sequences calendar ; -IN: mason.notify.server - -CONSTANT: +starting+ "starting" -CONSTANT: +make-vm+ "make-vm" -CONSTANT: +boot+ "boot" -CONSTANT: +test+ "test" -CONSTANT: +clean+ "status-clean" -CONSTANT: +dirty+ "status-dirty" -CONSTANT: +error+ "status-error" - -TUPLE: builder -host-name os cpu -clean-git-id clean-timestamp -last-release release-git-id -last-git-id last-timestamp last-report -current-git-id current-timestamp -status ; - -builder "BUILDERS" { - { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } - { "os" "OS" TEXT +user-assigned-id+ } - { "cpu" "CPU" TEXT +user-assigned-id+ } - - { "clean-git-id" "CLEAN_GIT_ID" TEXT } - { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP } - - { "last-release" "LAST_RELEASE" TEXT } - { "release-git-id" "RELEASE_GIT_ID" TEXT } - - { "last-git-id" "LAST_GIT_ID" TEXT } - { "last-timestamp" "LAST_TIMESTAMP" TIMESTAMP } - { "last-report" "LAST_REPORT" TEXT } - - { "current-git-id" "CURRENT_GIT_ID" TEXT } - ! Can't name it CURRENT_TIMESTAMP because of bug in db library - { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP } - { "status" "STATUS" TEXT } -} define-persistent +USING: accessors calendar combinators combinators.smart +command-line db.tuples io io.encodings.utf8 io.files kernel +mason.server namespaces present sequences ; +IN: mason.server.notify SYMBOLS: host-name target-os target-cpu message message-arg ; @@ -96,13 +59,11 @@ SYMBOLS: host-name target-os target-cpu message message-arg ; { "release" [ message-arg get release ] } } case ; -: mason-db ( -- db ) "resource:mason.db" ; - : handle-update ( command-line timestamp -- ) - mason-db [ + [ [ parse-args find-builder ] dip >>current-timestamp [ update-builder ] [ update-tuple ] bi - ] with-db ; + ] with-mason-db ; CONSTANT: log-file "resource:mason.log" diff --git a/extra/mason/server/release/authors.txt b/extra/mason/server/release/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/mason/server/release/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/mason/server/release/release.factor b/extra/mason/server/release/release.factor new file mode 100644 index 0000000000..2683d642de --- /dev/null +++ b/extra/mason/server/release/release.factor @@ -0,0 +1,81 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar db db.tuples grouping io +io.encodings.ascii io.launcher kernel locals make +mason.release.archive mason.server namespaces sequences ; +IN: mason.server.release + +! Host to upload binary package to. +SYMBOL: upload-host + +! Username to log in. +SYMBOL: upload-username + +! Directory with binary packages. +SYMBOL: upload-directory + +: platform ( builder -- string ) + [ os>> ] [ cpu>> ] bi "-" glue ; + +: package-name ( builder -- string ) + [ platform ] [ last-release>> ] bi "/" glue ; + +: release-name ( version builder -- string ) + [ + "releases/" % + [ platform % "/" % ] + [ "factor-" % platform % "-" % % ] + [ os>> extension % ] + tri + ] "" make ; + +: release-command ( version builder -- command ) + [ + "ln -s " % + [ nip package-name % " " % ] [ release-name % ] 2bi + ] { } make ; + +TUPLE: release +host-name os cpu +last-release release-git-id ; + +:: ( version builder -- release ) + release new + builder host-name>> >>host-name + builder os>> >>os + builder cpu>> >>cpu + builder release-git-id>> >>release-git-id + version builder release-name >>last-release ; + +: execute-on-server ( string -- ) + [ "ssh" , upload-host get , "-l" , upload-username get , ] { } make + + swap >>command + 30 seconds >>timeout + ascii [ write ] with-process-writer ; + +: release-script ( version builders -- string ) + upload-directory get "cd " "\n" surround prepend + [ release-command ] with map "\n" join ; + +: create-releases ( version builders -- ) + release-script execute-on-server ; + +: update-releases ( version builders -- ) + [ + release new delete-tuples + [ insert-tuple ] with each + ] with-transaction ; + +: check-releases ( builders -- ) + [ release-git-id>> ] map all-equal? + [ "Not all builders are up to date" throw ] unless ; + +: do-release ( version -- ) + [ + builder new select-tuples + [ nip check-releases ] + [ create-releases ] + [ update-releases ] + 2tri + ] with-mason-db ; diff --git a/extra/mason/server/server.factor b/extra/mason/server/server.factor new file mode 100644 index 0000000000..d0fe29b917 --- /dev/null +++ b/extra/mason/server/server.factor @@ -0,0 +1,46 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: db db.sqlite db.tuples db.types kernel ; +IN: mason.server + +CONSTANT: +starting+ "starting" +CONSTANT: +make-vm+ "make-vm" +CONSTANT: +boot+ "boot" +CONSTANT: +test+ "test" +CONSTANT: +clean+ "status-clean" +CONSTANT: +dirty+ "status-dirty" +CONSTANT: +error+ "status-error" + +TUPLE: builder +host-name os cpu +clean-git-id clean-timestamp +last-release release-git-id +last-git-id last-timestamp last-report +current-git-id current-timestamp +status ; + +builder "BUILDERS" { + { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } + { "os" "OS" TEXT +user-assigned-id+ } + { "cpu" "CPU" TEXT +user-assigned-id+ } + + { "clean-git-id" "CLEAN_GIT_ID" TEXT } + { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP } + + { "last-release" "LAST_RELEASE" TEXT } + { "release-git-id" "RELEASE_GIT_ID" TEXT } + + { "last-git-id" "LAST_GIT_ID" TEXT } + { "last-timestamp" "LAST_TIMESTAMP" TIMESTAMP } + { "last-report" "LAST_REPORT" TEXT } + + { "current-git-id" "CURRENT_GIT_ID" TEXT } + ! Can't name it CURRENT_TIMESTAMP because of bug in db library + { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP } + { "status" "STATUS" TEXT } +} define-persistent + +: mason-db ( -- db ) "resource:mason.db" ; + +: with-mason-db ( quot -- ) + [ mason-db ] dip with-db ; inline diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 42f15d2873..1c2d9e0d8c 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators db db.tuples furnace.actions http.server.responses http.server.dispatchers kernel mason.platform -mason.notify.server mason.report math.order sequences sorting +mason.server mason.report math.order sequences sorting splitting xml.syntax xml.writer io.pathnames io.encodings.utf8 io.files present validators html.forms furnace.db urls ; FROM: assocs => at keys values ; @@ -181,4 +181,3 @@ CONSTANT: cpus "download" add-responder "grid" add-responder mason-db ; - diff --git a/misc/fuel/README b/misc/fuel/README index 0411e0709b..ccaa7a676a 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -99,6 +99,7 @@ beast. |-----------------+------------------------------------------------------------| | C-cz | switch to listener (run-factor) | | C-co | cycle between code, tests and docs files | + | C-ct | run the unit tests for a vocabulary | | C-cr | switch to listener and refresh all loaded vocabs | | C-cs | switch to other factor buffer (fuel-switch-to-buffer) | | C-x4s | switch to other factor buffer in other window | diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el index c21d25901f..8d78225273 100644 --- a/misc/fuel/fuel-completion.el +++ b/misc/fuel/fuel-completion.el @@ -190,13 +190,13 @@ terminates a current completion." (defvar fuel-completion--vocab-history nil) -(defun fuel-completion--read-vocab (refresh) +(defun fuel-completion--read-vocab (refresh &optional init-input) (let ((minibuffer-local-completion-map fuel-completion--minibuffer-map) (vocabs (fuel-completion--vocabs refresh)) (prompt "Vocabulary name: ")) (if vocabs - (completing-read prompt vocabs nil nil nil fuel-completion--vocab-history) - (read-string prompt nil fuel-completion--vocab-history)))) + (completing-read prompt vocabs nil nil init-input fuel-completion--vocab-history) + (read-string prompt init-input fuel-completion--vocab-history)))) (defun fuel-completion--complete-symbol () "Complete the symbol at point. diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index 1d23571a0a..d5fec4bf5f 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -192,6 +192,13 @@ With prefix, you're teletransported to the listener's buffer." (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush") (comint-send-string nil " refresh-all \"Done!\" write nl flush\n"))) +(defun fuel-test-vocab (vocab) + "Run the unit tests for the specified vocabulary." + (interactive (list (fuel-completion--read-vocab nil (fuel-syntax--current-vocab)))) + (comint-send-string (fuel-listener--process) + (concat "\"" vocab "\" reload nl flush\n" + "\"" vocab "\" test nl flush\n"))) + ;;; Completion support diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 282ef3240f..6f42b4efc4 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -191,6 +191,7 @@ interacting with a factor listener is at your disposal. (fuel-mode--key-1 ?k 'fuel-run-file) (fuel-mode--key-1 ?l 'fuel-run-file) (fuel-mode--key-1 ?r 'fuel-refresh-all) +(fuel-mode--key-1 ?t 'fuel-test-vocab) (fuel-mode--key-1 ?z 'run-factor) (fuel-mode--key-1 ?s 'fuel-switch-to-buffer) (define-key fuel-mode-map "\C-x4s" 'fuel-switch-to-buffer-other-window) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 635bf0ea82..c22d03bdc5 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -50,7 +50,8 @@ "DEFER:" "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" "f" "FORGET:" "FROM:" "FUNCTION:" - "GENERIC#" "GENERIC:" + "GAME:" "GENERIC#" "GENERIC:" + "GLSL-SHADER:" "GLSL-PROGRAM:" "HELP:" "HEX:" "HOOK:" "IN:" "initial:" "INSTANCE:" "INTERSECTION:" "LIBRARY:" @@ -60,10 +61,10 @@ "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" "QUALIFIED-WITH:" "QUALIFIED:" "read-only" "RENAME:" "REQUIRE:" "REQUIRES:" - "SINGLETON:" "SINGLETONS:" "SLOT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:" - "TUPLE:" "t" "t?" "TYPEDEF:" - "UNION:" "USE:" "USING:" - "VARS:")) + "SINGLETON:" "SINGLETONS:" "SLOT:" "STRING:" "SYMBOL:" "SYMBOLS:" "SYNTAX:" + "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::" + "UNIFORM-TUPLE:" "UNION:" "USE:" "USING:" + "VARS:" "VERTEX-FORMAT:")) (defconst fuel-syntax--parsing-words-regex (regexp-opt fuel-syntax--parsing-words 'words)) @@ -110,7 +111,7 @@ (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>" (regexp-opt '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE" - "SYMBOL" "SYNTAX" "RENAME")))) + "SYMBOL" "SYNTAX" "TYPED" "RENAME")))) (defconst fuel-syntax--alias-definition-regex "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)") @@ -159,8 +160,11 @@ "MEMO" "MEMO:" "METHOD" "SYNTAX" "PREDICATE" "PRIMITIVE" - "STRUCT" "TAG" "TUPLE" "UNION-STRUCT" - "UNION")) + "STRUCT" "TAG" "TUPLE" + "TYPED" "TYPED:" + "UNIFORM-TUPLE" + "UNION-STRUCT" "UNION" + "VERTEX-FORMAT")) (defconst fuel-syntax--no-indent-def-starts '("ARTICLE" "HELP" @@ -185,7 +189,7 @@ "CONSTANT:" "C:" "DEFER:" "FORGET:" - "GENERIC:" "GENERIC#" + "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:" "HEX:" "HOOK:" "IN:" "INSTANCE:" "LIBRARY:"