Merge branch 'master' of git://factorcode.org/git/factor

basis/compiler/tree/propagation/simple/simple.factor

@@ -72,7 +72,7 @@ M: #declare propagate-before
 
 : foldable-call? ( #call word -- ? )
     {
-        [ nip "foldable" word-prop ]
+        [ nip foldable? ]
         [ drop literal-inputs? ]
         [ input-classes-match? ]
     } 2&& ;

basis/formatting/formatting-docs.factor

@@ -36,7 +36,7 @@ HELP: printf
     "For example:\n"
     { $list
         "\"%5s\" formats a string padding with spaces up to 5 characters wide."
-        "\"%08d\" formats an integer padding with zeros up to 3 characters wide."
+        "\"%03d\" formats an integer padding with zeros up to 3 characters wide."
         "\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
         "\"%-10d\" formats an integer to 10 characters wide and left-aligns." 
     }

basis/macros/macros.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser kernel sequences words effects combinators assocs
+USING: parser effects.parser kernel sequences words effects
-definitions quotations namespaces memoize accessors fry
+combinators assocs definitions quotations namespaces memoize
-compiler.units ;
+accessors fry compiler.units ;
 IN: macros
 
 <PRIVATE

basis/memoize/memoize.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2010 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel hashtables sequences sequences.private arrays
-words namespaces make parser math assocs effects definitions
+words namespaces make parser effects.parser math assocs effects
-quotations summary accessors fry ;
+definitions quotations summary accessors fry ;
 IN: memoize
 
 <PRIVATE

basis/peg/peg.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2007, 2008 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings fry namespaces make math assocs
-io vectors arrays math.parser math.order combinators
+io vectors arrays math.parser math.order combinators classes
-classes sets unicode.categories compiler.units parser words
+sets unicode.categories compiler.units parser effects.parser
-quotations memoize accessors locals splitting
+words quotations memoize accessors locals splitting
 combinators.short-circuit generalizations ;
 IN: peg
 

basis/promises/promises.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays effects fry generalizations kernel math
-namespaces parser sequences words ;
+namespaces parser effects.parser sequences words ;
 IN: promises
 
 TUPLE: promise quot forced? value ;

basis/typed/typed-tests.factor

@@ -1,5 +1,6 @@
 USING: accessors effects eval kernel layouts math namespaces
-quotations tools.test typed words ;
+quotations tools.test typed words words.symbol
+compiler.tree.debugger prettyprint ;
 IN: typed.tests
 
 TYPED: f+ ( a: float b: float -- c: float )
@@ -122,3 +123,29 @@ TYPED: recompile-fail ( a: subclass -- ? ) buh get eq? ;
 [ ] [ "IN: typed.tests TUPLE: subclass < superclass { y read-only } ;" eval( -- ) ] unit-test
 
 [ t ] [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
+
+! Make sure that foldable and flushable work on typed words
+TYPED: add ( a: integer b: integer -- c: integer ) + ; foldable
+
+[ [ 3 ] ] [ [ 1 2 add ] cleaned-up-tree nodes>quot ] unit-test
+
+TYPED: flush-test ( s: symbol -- ? ) on t ; flushable
+
+: flush-print-1 ( symbol -- ) flush-test drop ;
+: flush-print-2 ( symbol -- ) flush-test . ;
+
+SYMBOL: a-symbol
+
+[ f ] [
+    f a-symbol [
+        a-symbol flush-print-1
+        a-symbol get
+    ] with-variable
+] unit-test
+
+[ t ] [
+    f a-symbol [
+        a-symbol flush-print-2
+        a-symbol get
+    ] with-variable
+] unit-test

basis/typed/typed.factor

@@ -2,7 +2,7 @@
 USING: accessors arrays classes classes.tuple combinators
 combinators.short-circuit definitions effects fry hints
 math kernel kernel.private namespaces parser quotations
-sequences slots words locals 
+sequences slots words locals effects.parser
 locals.parser macros stack-checker.dependencies ;
 FROM: classes.tuple.private => tuple-layout ;
 IN: typed
@@ -11,8 +11,8 @@ ERROR: type-mismatch-error word expected-types ;
 ERROR: input-mismatch-error < type-mismatch-error ;
 ERROR: output-mismatch-error < type-mismatch-error ;
 
-PREDICATE: typed-gensym < word "typed-gensym" word-prop ;
+PREDICATE: typed-gensym < word "typed-gensym" word-prop >boolean ;
-PREDICATE: typed-word < word "typed-word" word-prop ;
+PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
 
 <PRIVATE
 
@@ -120,10 +120,10 @@ MACRO: (typed) ( word def effect -- quot )
     [ effect-in-types unboxed-types [ "in" swap 2array ] map ]
     [ effect-out-types unboxed-types [ "out" swap 2array ] map ] bi <effect> ;
 
-M: typed-gensym stack-effect
+M: typed-gensym stack-effect call-next-method unboxed-effect ;
-    call-next-method unboxed-effect ;
+M: typed-gensym parent-word "typed-gensym" word-prop ;
-M: typed-gensym crossref? 
+M: typed-gensym crossref? parent-word crossref? ;
-    "typed-gensym" word-prop crossref? ;
+M: typed-gensym where parent-word where ;
 
 : define-typed-gensym ( word def effect -- gensym )
     [ 2drop <typed-gensym> dup ]

core/effects/effects.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.parser math.order namespaces make sequences strings
+USING: kernel math math.parser math.order namespaces make
-words assocs combinators accessors arrays quotations ;
+sequences strings words assocs combinators accessors arrays
+quotations ;
 IN: effects
 
 TUPLE: effect
@@ -64,7 +65,9 @@ M: pair effect>type second effect>type ;
 
 GENERIC: stack-effect ( word -- effect/f )
 
-M: word stack-effect "declared-effect" word-prop ;
+M: word stack-effect
+    [ "declared-effect" word-prop ]
+    [ parent-word dup [ stack-effect ] when ] bi or ;
 
 M: deferred stack-effect call-next-method (( -- * )) or ;
 

core/effects/parser/parser.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lexer sets sequences kernel splitting effects
-combinators arrays vocabs.parser classes ;
+combinators arrays vocabs.parser classes parser ;
 IN: effects.parser
 
 DEFER: parse-effect
@@ -14,9 +14,8 @@ ERROR: bad-effect ;
             ":" ?tail [
                 scan {
                     { [ dup "(" = ] [ drop ")" parse-effect ] }
-                    { [ dup search class? ] [ search ] }
                     { [ dup f = ] [ ")" unexpected-eof ] }
-                    [ bad-effect ]
+                    [ parse-word dup class? [ bad-effect ] unless ]
                 } cond 2array
             ] when
         ] if
@@ -36,3 +35,8 @@ ERROR: stack-effect-omits-dashes tokens ;
 
 : parse-call( ( accum word -- accum )
     [ ")" parse-effect ] dip 2array append! ;
+
+: (:) ( -- word def effect )
+    CREATE-WORD
+    complete-effect
+    parse-definition swap ;

core/generic/generic-tests.factor

@@ -212,3 +212,16 @@ M: integer forget-test 3 + ;
 ] unit-test
 
 [ 10 forget-test ] [ no-method? ] must-fail-with
+
+! Declarations on methods
+GENERIC: flushable-generic ( a -- b ) flushable
+M: integer flushable-generic ;
+
+[ t ] [ \ flushable-generic flushable? ] unit-test
+[ t ] [ M\ integer flushable-generic flushable? ] unit-test
+
+GENERIC: non-flushable-generic ( a -- b )
+M: integer non-flushable-generic ; flushable
+
+[ f ] [ \ non-flushable-generic flushable? ] unit-test
+[ t ] [ M\ integer non-flushable-generic flushable? ] unit-test

core/generic/generic.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors words kernel sequences namespaces make assocs
 hashtables definitions kernel.private classes classes.private
@@ -104,11 +104,8 @@ GENERIC: update-generic ( class generic -- )
 : method-word-name ( class generic -- string )
     [ name>> ] bi@ "=>" glue ;
 
-M: method flushable?
+M: method parent-word
-    "method-generic" word-prop flushable? ;
+    "method-generic" word-prop ;
-
-M: method stack-effect
-    "method-generic" word-prop stack-effect ;
 
 M: method crossref?
     "forgotten" word-prop not ;
@@ -196,8 +193,5 @@ M: generic subwords
         tri
     ] { } make ;
 
-M: generic forget*
-    [ subwords forget-all ] [ call-next-method ] bi ;
-
 M: class forget-methods
     [ implementors ] [ [ swap method ] curry ] bi map forget-all ;

core/parser/parser.factor

@@ -5,7 +5,7 @@ sequences strings vectors words words.symbol quotations io
 combinators sorting splitting math.parser effects continuations
 io.files vocabs io.encodings.utf8 source-files classes
 hashtables compiler.units accessors sets lexer vocabs.parser
-effects.parser slots parser.notes ;
+ slots parser.notes ;
 IN: parser
 
 : location ( -- loc )
@@ -102,11 +102,6 @@ M: f parse-quotation \ ] parse-until >quotation ;
 : parse-definition ( -- quot )
     \ ; parse-until >quotation ;
 
-: (:) ( -- word def effect )
-    CREATE-WORD
-    complete-effect
-    parse-definition swap ;
-
 ERROR: bad-number ;
 
 : scan-base ( base -- n )

core/words/words.factor

@@ -73,12 +73,14 @@ GENERIC: crossref? ( word -- ? )
 M: word crossref?
     dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
 
-: inline? ( word -- ? ) "inline" word-prop ; inline
-
 GENERIC: subwords ( word -- seq )
 
 M: word subwords drop f ;
 
+GENERIC: parent-word ( word -- word/f )
+
+M: word parent-word drop f ;
+
 : define ( word def -- )
     over changed-definition [ ] like >>def drop ;
 
@@ -100,6 +102,8 @@ M: word subwords drop f ;
 : make-deprecated ( word -- )
     t "deprecated" set-word-prop ;
 
+: inline? ( word -- ? ) "inline" word-prop ; inline
+
 ERROR: cannot-be-inline word ;
 
 GENERIC: make-inline ( word -- )
@@ -111,22 +115,30 @@ M: word make-inline
         bi
     ] if ;
 
+: define-inline ( word def effect -- )
+    [ define-declared ] [ 2drop make-inline ] 3bi ;
+
 : make-recursive ( word -- )
     t "recursive" set-word-prop ;
 
+GENERIC: flushable? ( word -- ? )
+
+M: word flushable?
+    [ "flushable" word-prop ]
+    [ parent-word dup [ flushable? ] when ] bi or ;
+
 : make-flushable ( word -- )
     t "flushable" set-word-prop ;
 
+GENERIC: foldable? ( word -- ? )
+
+M: word foldable?
+    [ "foldable" word-prop ]
+    [ parent-word dup [ foldable? ] when ] bi or ;
+
 : make-foldable ( word -- )
     dup make-flushable t "foldable" set-word-prop ;
 
-: define-inline ( word def effect -- )
-    [ define-declared ] [ 2drop make-inline ] 3bi ;
-
-GENERIC: flushable? ( word -- ? )
-
-M: word flushable? "flushable" word-prop ;
-
 GENERIC: reset-word ( word -- )
 
 M: word reset-word
@@ -208,9 +220,10 @@ M: word set-where swap "loc" set-word-prop ;
 
 M: word forget*
     dup "forgotten" word-prop [ drop ] [
+        [ subwords forget-all ]
         [ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
         [ t "forgotten" set-word-prop ]
-        bi
+        tri
     ] if ;
 
 M: word hashcode*

extra/freetype/freetype.factor

@@ -166,7 +166,7 @@ STRUCT: FT_Bitmap
     { palette_mode char }
     { palette void* } ;
 
-TYPEDEF: void* FT_Face*
+C-TYPE: FT_Face
 
 FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;