From ec186a23dc654ca8fae3c4ad783b132d7cb87777 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Mar 2009 13:32:07 -0600 Subject: [PATCH 1/6] Make watch and other annotations work on method-specs. { world graft* } watch --- .../annotations/annotations-tests.factor | 8 +++ basis/tools/annotations/annotations.factor | 49 +++++++++++++++---- core/generic/generic.factor | 3 ++ 3 files changed, 51 insertions(+), 9 deletions(-) diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor index 1e766e3dec..2a65ea5236 100644 --- a/basis/tools/annotations/annotations-tests.factor +++ b/basis/tools/annotations/annotations-tests.factor @@ -38,3 +38,11 @@ M: object another-generic ; [ ] [ \ another-generic reset ] unit-test [ "" ] [ [ 3 another-generic drop ] with-string-writer ] unit-test + +GENERIC: blah-generic ( a -- b ) + +M: string blah-generic ; + +{ string blah-generic } watch + +[ ] [ "hi" blah-generic ] unit-test \ No newline at end of file diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index b436be5163..7bb4711b90 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel math sorting words parser io summary quotations sequences prettyprint continuations effects @@ -20,16 +20,34 @@ M: word reset f "unannotated-def" set-word-prop ] [ drop ] if ; +M: method-spec reset + first2 method reset ; + ERROR: cannot-annotate-twice word ; +word ( obj -- word ) + dup method-spec? [ first2 method ] when ; + +: save-unannotated-def ( word -- ) + dup def>> "unannotated-def" set-word-prop ; + +: (annotate) ( word quot -- ) + [ dup def>> ] dip call define ; inline + +PRIVATE> + : annotate ( word quot -- ) - over "unannotated-def" word-prop [ - over cannot-annotate-twice - ] when - [ - over dup def>> "unannotated-def" set-word-prop - [ dup def>> ] dip call define - ] with-compilation-unit ; inline + [ method-spec>word check-annotate-twice ] dip + [ over save-unannotated-def (annotate) ] with-compilation-unit ; inline + + + : watch ( word -- ) - dup [ (watch) ] annotate ; + dup '[ [ _ ] dip (watch) ] annotate ; + + + GENERIC# annotate-methods 1 ( word quot -- ) M: generic annotate-methods @@ -79,6 +103,9 @@ M: generic annotate-methods M: word annotate-methods annotate ; +M: method-spec annotate-methods + annotate ; + : breakpoint ( word -- ) [ add-breakpoint ] annotate-methods ; @@ -92,9 +119,13 @@ word-timing [ H{ } clone ] initialize : reset-word-timing ( -- ) word-timing get clear-assoc ; + + : add-timing ( word -- ) dup '[ _ (add-timing) ] annotate ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index c16b6a52a1..c520b4aaac 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -83,6 +83,9 @@ TUPLE: check-method class generic ; PREDICATE: method-body < word "method-generic" word-prop >boolean ; +M: method-spec stack-effect + first2 method stack-effect ; + M: method-body stack-effect "method-generic" word-prop stack-effect ; From 5c88b18a9a6c385ad6ad8eb1cd1ecc39a2b7b9b1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Mar 2009 13:32:41 -0600 Subject: [PATCH 2/6] Oops, forgot to call prepare-last-line --- basis/ui/gadgets/panes/panes-tests.factor | 6 ++++++ basis/ui/gadgets/panes/panes.factor | 4 +++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor index 766e395ef2..680b6fe57f 100644 --- a/basis/ui/gadgets/panes/panes-tests.factor +++ b/basis/ui/gadgets/panes/panes-tests.factor @@ -106,3 +106,9 @@ ARTICLE: "test-article-2" "This is a test article" [ ] [ \ = [ see ] [ ] with-grafted-gadget ] unit-test + +: ( -- foo ) + pane new-pane ; + +[ t ] [ dup input>> child? ] unit-test +[ t ] [ dup last-line>> child? ] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 5b3290d64a..aef8fda066 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -63,7 +63,9 @@ M: pane gadget-selection ( pane -- string/f ) selection-color >>selection-color ; inline : init-last-line ( pane -- pane ) - horizontal [ >>last-line ] [ 1 track-add ] bi ; inline + horizontal + [ >>last-line ] [ 1 track-add ] bi + dup prepare-last-line ; inline : new-pane ( input class -- pane ) [ vertical ] dip new-track From bfaedc8d0aacc6c5ce868446dc12dd62aec98bb6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Mar 2009 13:50:55 -0600 Subject: [PATCH 3/6] Don't spam console with so much output in help.html --- basis/help/html/html.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index f8d06064f0..cbeb8b362e 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -64,7 +64,6 @@ M: topic url-of topic>filename ; tri simple-page ; : generate-help-file ( topic -- ) - dup . dup topic>filename utf8 [ help>html write-xml ] with-file-writer ; : all-vocabs-really ( -- seq ) From 696ac8f835e5faa9a11347d7677c5254754daada Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Mar 2009 14:10:53 -0600 Subject: [PATCH 4/6] base64 now deals with byte arrays instead of strings --- basis/base64/base64-tests.factor | 19 ++++++++++--------- basis/base64/base64.factor | 8 ++++---- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/basis/base64/base64-tests.factor b/basis/base64/base64-tests.factor index dcc4aa5240..ddefff35bb 100644 --- a/basis/base64/base64-tests.factor +++ b/basis/base64/base64-tests.factor @@ -1,25 +1,26 @@ -USING: kernel tools.test base64 strings sequences ; +USING: kernel tools.test base64 strings sequences +io.encodings.string io.encodings.ascii ; IN: base64.tests -[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" >base64 base64> >string +[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode ] unit-test -[ "" ] [ "" >base64 base64> >string ] unit-test -[ "a" ] [ "a" >base64 base64> >string ] unit-test -[ "ab" ] [ "ab" >base64 base64> >string ] unit-test -[ "abc" ] [ "abc" >base64 base64> >string ] unit-test -[ "abcde" ] [ "abcde" >base64 3 cut "\r\n" swap 3append base64> >string ] unit-test +[ f ] [ "" ascii encode >base64 base64> ascii decode ] unit-test +[ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test +[ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test +[ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test +[ "abcde" ] [ "abcde" ascii encode >base64 3 cut "\r\n" swap 3append base64> ascii decode ] unit-test ! From http://en.wikipedia.org/wiki/Base64 [ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ] [ "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure." - >base64 >string + ascii encode >base64 >string ] unit-test [ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz\r\nIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg\r\ndGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu\r\ndWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo\r\nZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ] [ "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure." - >base64-lines >string + ascii encode >base64-lines >string ] unit-test \ >base64 must-infer diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index 7f96e19430..c51d871bb5 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: combinators io io.binary io.encodings.binary -io.streams.byte-array io.streams.string kernel math namespaces +io.streams.byte-array kernel math namespaces sequences strings io.crlf ; IN: base64 @@ -75,10 +75,10 @@ PRIVATE> } case ; : >base64 ( seq -- base64 ) - binary [ [ encode-base64 ] with-string-reader ] with-byte-writer ; + binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ; : base64> ( base64 -- seq ) - [ binary [ decode-base64 ] with-byte-reader ] with-string-writer ; + binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ; : >base64-lines ( seq -- base64 ) - binary [ [ encode-base64-lines ] with-string-reader ] with-byte-writer ; + binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ; From 4749d86e70efd24226e768021356fad2190b9e85 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Mar 2009 14:58:52 -0600 Subject: [PATCH 5/6] Fix bootstrap --- basis/tools/annotations/annotations-docs.factor | 16 ---------------- basis/tools/annotations/annotations.factor | 4 ++-- 2 files changed, 2 insertions(+), 18 deletions(-) diff --git a/basis/tools/annotations/annotations-docs.factor b/basis/tools/annotations/annotations-docs.factor index c88e959b8e..005f5f7af8 100644 --- a/basis/tools/annotations/annotations-docs.factor +++ b/basis/tools/annotations/annotations-docs.factor @@ -44,16 +44,6 @@ HELP: annotate-methods { "word" word } { "quot" quotation } } { $description "Annotates the word -- for generic words, all its methods -- with the quotation." } ; -HELP: entering -{ $values - { "str" string } } -{ $description "Prints a message and the inputs to the word before the word has been called." } ; - -HELP: leaving -{ $values - { "str" string } } -{ $description "Prints a message and the outputs from a word after a word has been called." } ; - HELP: reset { $values { "word" word } } @@ -65,12 +55,6 @@ HELP: watch-vars { "word" word } { "vars" "a sequence of symbols" } } { $description "Annotates a word definition to print the " { $snippet "vars" } " upon entering the word. This word is useful for debugging." } ; -HELP: word-inputs -{ $values - { "word" word } - { "seq" sequence } } -{ $description "Makes a sequence of the inputs to a word by counting the number of inputs in the stack effect and saving that many items from the datastack." } ; - HELP: add-timing { $values { "word" word } } { $description "Adds timing code to a word, which records its total running time, including that of words it calls, on every invocation." } diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index 7bb4711b90..293a22d2bb 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -90,11 +90,11 @@ PRIVATE> @ ] ; +PRIVATE> + : watch-vars ( word vars -- ) dupd '[ [ _ _ ] dip (watch-vars) ] annotate ; -PRIVATE> - GENERIC# annotate-methods 1 ( word quot -- ) M: generic annotate-methods From 68ad822cc50ecc25ba419d8cf077888e739e13e6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Mar 2009 15:02:28 -0600 Subject: [PATCH 6/6] Remove obsolete DLL from windows.nt --- basis/windows/nt/nt.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/basis/windows/nt/nt.factor b/basis/windows/nt/nt.factor index 1dc997b38a..85aa991857 100644 --- a/basis/windows/nt/nt.factor +++ b/basis/windows/nt/nt.factor @@ -11,6 +11,5 @@ USING: alien sequences ; { "libm" "msvcrt.dll" "cdecl" } { "gl" "opengl32.dll" "stdcall" } { "glu" "glu32.dll" "stdcall" } - { "freetype" "freetype6.dll" "cdecl" } { "ole32" "ole32.dll" "stdcall" } } [ first3 add-library ] each