From c2a35ecf339f79d0290b4ee14e8279da4f6c9310 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Fri, 17 Apr 2009 19:07:45 +1000 Subject: [PATCH 01/29] Fix an example in syntax docs --- core/syntax/syntax-docs.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 33a0096ff9..f869cff506 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -526,10 +526,10 @@ HELP: (( { $notes "Useful for meta-programming with " { $link define-declared } "." } { $examples { $code - "SYMBOL: my-dynamic-word" + "<< SYMBOL: my-dynamic-word" "USING: math random words ;" - "3 { [ + ] [ - ] [ * ] [ / ] } random curry" - "(( x -- y )) define-declared" + "my-dynamic-word 3 { [ + ] [ - ] [ * ] [ / ] } random curry" + "(( x -- y )) define-declared >>" } } ; @@ -789,4 +789,4 @@ HELP: execute( { $syntax "execute( stack -- effect )" } { $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ; -{ POSTPONE: call( POSTPONE: execute( } related-words \ No newline at end of file +{ POSTPONE: call( POSTPONE: execute( } related-words From 425be6a414306d6f6b1bb95ce3ae2cd40995c2ac Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 19 Apr 2009 20:35:54 +0200 Subject: [PATCH 02/29] FUEL: modify directly use/in to set up evaluation context --- extra/fuel/eval/eval.factor | 8 ++++---- misc/fuel/fuel-connection.el | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/fuel/eval/eval.factor b/extra/fuel/eval/eval.factor index ae1c5863a8..26d3999380 100644 --- a/extra/fuel/eval/eval.factor +++ b/extra/fuel/eval/eval.factor @@ -63,13 +63,13 @@ t fuel-eval-res-flag set-global [ (fuel-eval) ] each ; : (fuel-eval-usings) ( usings -- ) - [ "USE: " prepend ] map - (fuel-eval-each) fuel-forget-error fuel-forget-output ; + [ [ use+ ] curry [ drop ] recover ] each + fuel-forget-error fuel-forget-output ; : (fuel-eval-in) ( in -- ) - [ dup "IN: " prepend (fuel-eval) in set ] when* ; + [ in set ] when* ; : (fuel-eval-in-context) ( lines in usings -- ) (fuel-begin-eval) - [ (fuel-eval-usings) (fuel-eval-in) "\n" join (fuel-eval) ] with-string-writer + [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer (fuel-end-eval) ; diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index f180d0f2b4..ef39b7af65 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -164,7 +164,7 @@ (fuel-con--send-string/wait buffer fuel-con--init-stanza 'fuel-con--establish-connection-cont - 60000) + 3000000) conn)) (defun fuel-con--establish-connection-cont (ignore) From d039f9a946dfc414213e7dd297f5dc47708cfa95 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 19 Apr 2009 17:38:20 -0500 Subject: [PATCH 03/29] help.handbook: fix typos reported by Jon Kleiser --- basis/help/handbook/handbook.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index ebce042e06..1aac99defe 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -13,13 +13,13 @@ ARTICLE: "conventions" "Conventions" { $heading "Documentation conventions" } "Factor documentation consists of two distinct bodies of text. There is a hierarchy of articles, much like this one, and there is word documentation. Help articles reference word documentation, and vice versa, but not every documented word is referenced from some help article." $nl -"Every article has links to parent articles at the top. These can be persued if the article is too specific." +"Every article has links to parent articles at the top. Explore these if the article you are reading is too specific." $nl "Some generic words have " { $strong "Description" } " headings, and others have " { $strong "Contract" } " headings. A distinction is made between words which are not intended to be extended with user-defined methods, and those that are." { $heading "Vocabulary naming conventions" } "A vocabulary name ending in " { $snippet ".private" } " contains words which are either implementation detail, unsafe, or both. For example, the " { $snippet "sequence.private" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } ")." $nl -"You should should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason." +"You should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason." { $heading "Word naming conventions" } "These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:" { $table From d3d131d1bda39f6405d806dcfd6278d8e16fb697 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 19 Apr 2009 17:38:48 -0500 Subject: [PATCH 04/29] Strip out error-list related global variables; webkit-demo 14kb smaller --- basis/tools/deploy/shaker/shaker.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 37eec5eae2..ba0daf6056 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -15,6 +15,7 @@ QUALIFIED: definitions QUALIFIED: init QUALIFIED: layouts QUALIFIED: source-files +QUALIFIED: source-files.errors QUALIFIED: vocabs IN: tools.deploy.shaker @@ -264,6 +265,7 @@ IN: tools.deploy.shaker compiled-crossref compiled-generic-crossref compiler-impl + compiler.errors:compiler-errors definition-observers definitions:crossref interactive-vocabs @@ -275,6 +277,7 @@ IN: tools.deploy.shaker lexer-factory print-use-hook root-cache + source-files.errors:error-types vocabs:dictionary vocabs:load-vocab-hook word From 27928f5f8f9b45e40a9d111212e9f2251f32cfce Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 19 Apr 2009 17:39:26 -0500 Subject: [PATCH 05/29] Make couchdb unportable for now --- extra/couchdb/tags.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 extra/couchdb/tags.txt diff --git a/extra/couchdb/tags.txt b/extra/couchdb/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/couchdb/tags.txt @@ -0,0 +1 @@ +unportable From 57d718113e8661c509151336ddb8747eb02d3305 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 19 Apr 2009 18:21:25 -0500 Subject: [PATCH 06/29] tools.test: more robust must-fail --- basis/tools/test/test-tests.factor | 16 +++++++++++++++- basis/tools/test/test.factor | 12 ++++++------ 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/basis/tools/test/test-tests.factor b/basis/tools/test/test-tests.factor index 473335645f..03f7f006c9 100644 --- a/basis/tools/test/test-tests.factor +++ b/basis/tools/test/test-tests.factor @@ -1,4 +1,18 @@ IN: tools.test.tests -USING: tools.test ; +USING: tools.test tools.test.private namespaces kernel sequences ; \ test-all must-infer + +: fake-unit-test ( quot -- ) + [ + "fake" file set + V{ } clone test-failures set + call + test-failures get + ] with-scope ; inline + +[ 1 ] [ + [ + [ "OOPS" ] must-fail + ] fake-unit-test length +] unit-test \ No newline at end of file diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index b98f58b143..1ff47e3d7f 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -48,17 +48,17 @@ SYMBOL: file f file get f failure ; :: (unit-test) ( output input -- error ? ) - [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; inline + [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; : short-effect ( effect -- pair ) [ in>> length ] [ out>> length ] bi 2array ; :: (must-infer-as) ( effect quot -- error ? ) - [ quot infer short-effect effect assert= f f ] [ t ] recover ; inline + [ quot infer short-effect effect assert= f f ] [ t ] recover ; :: (must-infer) ( word/quot -- error ? ) word/quot dup word? [ '[ _ execute ] ] when :> quot - [ quot infer drop f f ] [ t ] recover ; inline + [ quot infer drop f f ] [ t ] recover ; TUPLE: did-not-fail ; CONSTANT: did-not-fail T{ did-not-fail } @@ -66,11 +66,11 @@ CONSTANT: did-not-fail T{ did-not-fail } M: did-not-fail summary drop "Did not fail" ; :: (must-fail-with) ( quot pred -- error ? ) - [ quot call did-not-fail t ] - [ dup pred call [ drop f f ] [ t ] if ] recover ; inline + [ { } quot with-datastack drop did-not-fail t ] + [ dup pred call( error -- ? ) [ drop f f ] [ t ] if ] recover ; :: (must-fail) ( quot -- error ? ) - [ quot call did-not-fail t ] [ drop f f ] recover ; inline + [ { } quot with-datastack drop did-not-fail t ] [ drop f f ] recover ; : experiment-title ( word -- string ) "(" ?head drop ")" ?tail drop { { CHAR: - CHAR: \s } } substitute >title ; From 0719d8365337981d4ee2cc9c5f26be2fe023084d Mon Sep 17 00:00:00 2001 From: Elliott Hird Date: Mon, 20 Apr 2009 01:28:41 +0100 Subject: [PATCH 07/29] Show the signal name next to the number in parentheses on Unices. --- basis/debugger/debugger.factor | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 49ec534e8f..64bac3ecee 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -88,8 +88,27 @@ M: string error. print ; : divide-by-zero-error. ( obj -- ) "Division by zero" print drop ; +CONSTANT: signal-names +{ + "SIGHUP" "SIGINT" "SIGQUIT" "SIGILL" "SIGTRAP" "SIGABRT" + "SIGEMT" "SIGFPE" "SIGKILL" "SIGBUS" "SIGSEGV" "SIGSYS" + "SIGPIPE" "SIGALRM" "SIGTERM" "SIGURG" "SIGSTOP" "SIGTSIP" + "SIGCONT" "SIGCHLD" "SIGTTIN" "SIGTTOU" "SIGIO" "SIGXCPU" + "SIGXFSZ" "SIGVTALRM" "SIGPROF" "SIGWINCH" "SIGINFO" + "SIGUSR1" "SIGUSR2" +} + +: signal-name ( n -- str ) + 1- signal-names nth; + +: signal-name. ( n -- ) + dup signal-names length <= + os unix? and + [ " (" write signal-name write ")" write ] [ drop ] if ; + : signal-error. ( obj -- ) - "Operating system signal " write third . ; + "Operating system signal " write + third [ pprint ] [ signal-name. ] bi nl ; : array-size-error. ( obj -- ) "Invalid array size: " write dup third . From 0f82f4af8709cf85329863f31712c72963db8a5d Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Mon, 20 Apr 2009 11:00:38 +1000 Subject: [PATCH 08/29] Merging Diego Martinelli's improvements and simplifications of morse --- extra/morse/authors.txt | 1 + extra/morse/morse-docs.factor | 4 +- extra/morse/morse-tests.factor | 34 +++++- extra/morse/morse.factor | 208 ++++++++++++++++----------------- 4 files changed, 134 insertions(+), 113 deletions(-) diff --git a/extra/morse/authors.txt b/extra/morse/authors.txt index e9c193bac7..409f0443a6 100644 --- a/extra/morse/authors.txt +++ b/extra/morse/authors.txt @@ -1 +1,2 @@ Alex Chapman +Diego Martinelli diff --git a/extra/morse/morse-docs.factor b/extra/morse/morse-docs.factor index e35967d3e9..93350ad02d 100644 --- a/extra/morse/morse-docs.factor +++ b/extra/morse/morse-docs.factor @@ -6,12 +6,12 @@ IN: morse HELP: ch>morse { $values { "ch" "A character that has a morse code translation" } { "str" "A string consisting of zero or more dots and dashes" } } -{ $description "If the given character has a morse code translation, then return that translation, otherwise return an empty string." } ; +{ $description "If the given character has a morse code translation, then return that translation, otherwise return a ? character." } ; HELP: morse>ch { $values { "str" "A string of dots and dashes that represents a single character in morse code" } { "ch" "The translated character" } } -{ $description "If the given string represents a morse code character, then return that character, otherwise return f" } ; +{ $description "If the given string represents a morse code character, then return that character, otherwise return a space character." } ; HELP: >morse { $values diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor index 144448917f..fd52df1c4d 100644 --- a/extra/morse/morse-tests.factor +++ b/extra/morse/morse-tests.factor @@ -1,13 +1,43 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. USING: arrays morse strings tools.test ; +IN: morse.tests -[ "" ] [ CHAR: \\ ch>morse ] unit-test +[ CHAR: ? ] [ CHAR: \\ ch>morse ] unit-test [ "..." ] [ CHAR: s ch>morse ] unit-test [ CHAR: s ] [ "..." morse>ch ] unit-test -[ f ] [ "..--..--.." morse>ch ] unit-test +[ CHAR: \s ] [ "..--..--.." morse>ch ] unit-test [ "-- --- .-. ... . / -.-. --- -.. ." ] [ "morse code" >morse ] unit-test [ "morse code" ] [ "-- --- .-. ... . / -.-. --- -.. ." morse> ] unit-test [ "hello, world!" ] [ "Hello, World!" >morse morse> ] unit-test +[ ".- -... -.-." ] [ "abc" >morse ] unit-test + +[ "abc" ] [ ".- -... -.-." morse> ] unit-test + +[ "morse code" ] [ + [MORSE + -- --- .-. ... . / + -.-. --- -.. . + MORSE] >morse morse> ] unit-test + +[ "morse code 123" ] [ + [MORSE + __ ___ ._. ... . / + _._. ___ _.. . / + .____ ..___ ...__ + MORSE] ] unit-test + +[ [MORSE + -- --- .-. ... . / + -.-. --- -.. . + MORSE] ] [ + "morse code" >morse morse> +] unit-test + +[ "factor rocks!" ] [ + [MORSE + ..-. .- -.-. - --- .-. / + .-. --- -.-. -.- ... -.-.-- + MORSE] ] unit-test ! [ ] [ "sos" 0.075 play-as-morse* ] unit-test ! [ ] [ "Factor rocks!" play-as-morse ] unit-test diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor index 54abce9395..49e6ae39f5 100644 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -1,130 +1,120 @@ -! Copyright (C) 2007, 2008 Alex Chapman +! Copyright (C) 2007, 2008, 2009 Alex Chapman, 2009 Diego Martinelli ! See http://factorcode.org/license.txt for BSD license. -USING: accessors ascii assocs combinators hashtables kernel lists math -namespaces make openal parser-combinators promises sequences -strings synth synth.buffers unicode.case ; +USING: accessors ascii assocs biassocs combinators hashtables kernel lists math +namespaces make multiline openal parser sequences splitting strings synth synth.buffers ; IN: morse morse-assoc ( -- assoc ) - morse-codes >hashtable ; - -: morse>ch-assoc ( -- assoc ) - morse-codes [ reverse ] map >hashtable ; +CONSTANT: dot-char CHAR: . +CONSTANT: dash-char CHAR: - +CONSTANT: char-gap-char CHAR: \s +CONSTANT: word-gap-char CHAR: / +CONSTANT: unknown-char CHAR: ? PRIVATE> -: ch>morse ( ch -- str ) - ch>lower ch>morse-assoc at* swap "" ? ; +DEFER: morse-code-table + +H{ + { CHAR: a ".-" } + { CHAR: b "-..." } + { CHAR: c "-.-." } + { CHAR: d "-.." } + { CHAR: e "." } + { CHAR: f "..-." } + { CHAR: g "--." } + { CHAR: h "...." } + { CHAR: i ".." } + { CHAR: j ".---" } + { CHAR: k "-.-" } + { CHAR: l ".-.." } + { CHAR: m "--" } + { CHAR: n "-." } + { CHAR: o "---" } + { CHAR: p ".--." } + { CHAR: q "--.-" } + { CHAR: r ".-." } + { CHAR: s "..." } + { CHAR: t "-" } + { CHAR: u "..-" } + { CHAR: v "...-" } + { CHAR: w ".--" } + { CHAR: x "-..-" } + { CHAR: y "-.--" } + { CHAR: z "--.." } + { CHAR: 1 ".----" } + { CHAR: 2 "..---" } + { CHAR: 3 "...--" } + { CHAR: 4 "....-" } + { CHAR: 5 "....." } + { CHAR: 6 "-...." } + { CHAR: 7 "--..." } + { CHAR: 8 "---.." } + { CHAR: 9 "----." } + { CHAR: 0 "-----" } + { CHAR: . ".-.-.-" } + { CHAR: , "--..--" } + { CHAR: ? "..--.." } + { CHAR: ' ".----." } + { CHAR: ! "-.-.--" } + { CHAR: / "-..-." } + { CHAR: ( "-.--." } + { CHAR: ) "-.--.-" } + { CHAR: & ".-..." } + { CHAR: : "---..." } + { CHAR: ; "-.-.-." } + { CHAR: = "-...- " } + { CHAR: + ".-.-." } + { CHAR: - "-....-" } + { CHAR: _ "..--.-" } + { CHAR: " ".-..-." } + { CHAR: $ "...-..-" } + { CHAR: @ ".--.-." } + { CHAR: \s "/" } +} >biassoc \ morse-code-table set-global + +: morse-code-table ( -- biassoc ) + \ morse-code-table get-global ; + +: ch>morse ( ch -- morse ) + ch>lower morse-code-table at [ unknown-char ] unless* ; : morse>ch ( str -- ch ) - morse>ch-assoc at* swap f ? ; - -: >morse ( str -- str ) - [ - [ CHAR: \s , ] [ ch>morse % ] interleave - ] "" make ; - + morse-code-table value-at [ char-gap-char ] unless* ; + morse ( str -- morse ) + [ ch>morse ] { } map-as " " join ; -: dot-char ( -- ch ) CHAR: . ; -: dash-char ( -- ch ) CHAR: - ; -: char-gap-char ( -- ch ) CHAR: \s ; -: word-gap-char ( -- ch ) CHAR: / ; +: sentence>morse ( str -- morse ) + " " split [ word>morse ] map " / " join ; + +: trim-blanks ( str -- newstr ) + [ blank? ] trim ; inline -: =parser ( obj -- parser ) - [ = ] curry satisfy ; +: morse>word ( morse -- str ) + " " split [ morse>ch ] "" map-as ; -LAZY: 'dot' ( -- parser ) - dot-char =parser ; +: morse>sentence ( morse -- sentence ) + "/" split [ trim-blanks morse>word ] map " " join ; -LAZY: 'dash' ( -- parser ) - dash-char =parser ; - -LAZY: 'char-gap' ( -- parser ) - char-gap-char =parser ; - -LAZY: 'word-gap' ( -- parser ) - word-gap-char =parser ; - -LAZY: 'morse-char' ( -- parser ) - 'dot' 'dash' <|> <+> ; - -LAZY: 'morse-word' ( -- parser ) - 'morse-char' 'char-gap' list-of ; - -LAZY: 'morse-words' ( -- parser ) - 'morse-word' 'word-gap' list-of ; +: replace-underscores ( str -- str' ) + [ dup CHAR: _ = [ drop CHAR: - ] when ] map ; PRIVATE> + +: >morse ( str -- newstr ) + trim-blanks sentence>morse ; + +: morse> ( morse -- plain ) + replace-underscores morse>sentence ; -: morse> ( str -- str ) - 'morse-words' parse car parsed>> [ - [ - >string morse>ch - ] map >string - ] map [ [ CHAR: \s , ] [ % ] interleave ] "" make ; - +SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> parsed ; + ( -- buffer ) half-sample-freq <8bit-mono-buffer> ; From 616996ab6a77b614538b0ccd09dd179306e09d6c Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Mon, 20 Apr 2009 12:20:03 +1000 Subject: [PATCH 09/29] Updating code to use CONSTANT: --- extra/jamshred/game/game.factor | 2 +- extra/jamshred/gl/gl.factor | 15 +++++++-------- extra/jamshred/jamshred.factor | 4 ++-- extra/jamshred/player/player.factor | 4 ++-- extra/jamshred/tunnel/tunnel.factor | 12 +++++++----- extra/synth/buffers/buffers.factor | 10 +++++----- 6 files changed, 24 insertions(+), 23 deletions(-) diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index 9cb5bc7c3a..14bf18a9c1 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -29,7 +29,7 @@ TUPLE: jamshred sounds tunnel players running quit ; : mouse-moved ( x-radians y-radians jamshred -- ) jamshred-player -rot turn-player ; -: units-per-full-roll ( -- n ) 50 ; +CONSTANT: units-per-full-roll 50 : jamshred-roll ( jamshred n -- ) [ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ; diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index bae275e96a..a1d22c48dc 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -6,18 +6,17 @@ math.functions math.vectors opengl opengl.gl opengl.glu opengl.demo-support sequences specialized-arrays.float ; IN: jamshred.gl -: min-vertices ( -- n ) 6 ; inline -: max-vertices ( -- n ) 32 ; inline +CONSTANT: min-vertices 6 +CONSTANT: max-vertices 32 -: n-vertices ( -- n ) 32 ; inline +CONSTANT: n-vertices 32 ! render enough of the tunnel that it looks continuous -: n-segments-ahead ( -- n ) 60 ; inline -: n-segments-behind ( -- n ) 40 ; inline +CONSTANT: n-segments-ahead 60 +CONSTANT: n-segments-behind 40 -: wall-drawing-offset ( -- n ) - #! so that we can't see through the wall, we draw it a bit further away - 0.15 ; +! so that we can't see through the wall, we draw it a bit further away +CONSTANT: wall-drawing-offset 0.15 : wall-drawing-radius ( segment -- r ) radius>> wall-drawing-offset + ; diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index 49624e2947..fd683e3bc4 100644 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -8,8 +8,8 @@ TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ; : ( jamshred -- gadget ) jamshred-gadget new swap >>jamshred ; -: default-width ( -- x ) 800 ; -: default-height ( -- y ) 600 ; +CONSTANT: default-width 800 +CONSTANT: default-height 600 M: jamshred-gadget pref-dim* drop default-width default-height 2array ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index d33b78f29c..5b92b3a434 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -12,8 +12,8 @@ TUPLE: player < oint { speed float } ; ! speeds are in GL units / second -: default-speed ( -- speed ) 1.0 ; -: max-speed ( -- speed ) 30.0 ; +CONSTANT: default-speed 1.0 +CONSTANT: max-speed 30.0 : ( name sounds -- player ) [ float-array{ 0 0 5 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] 2dip diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 4c4b3e6812..d951a37f0c 100644 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -3,7 +3,7 @@ USING: accessors arrays colors combinators kernel locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ; IN: jamshred.tunnel -: n-segments ( -- n ) 5000 ; inline +CONSTANT: n-segments 5000 TUPLE: segment < oint number color radius ; C: segment @@ -14,8 +14,10 @@ C: segment : random-color ( -- color ) { 100 100 100 } [ random 100 / >float ] map first3 1.0 ; -: tunnel-segment-distance ( -- n ) 0.4 ; -: random-rotation-angle ( -- theta ) pi 20 / ; +CONSTANT: tunnel-segment-distance 0.4 +USE: words.constant +DEFER: random-rotation-angle +\ random-rotation-angle pi 20 / define-constant : random-segment ( previous-segment -- segment ) clone dup random-rotation-angle random-turn @@ -27,7 +29,7 @@ C: segment [ dup peek random-segment over push ] dip 1- (random-segments) ] [ drop ] if ; -: default-segment-radius ( -- r ) 1 ; +CONSTANT: default-segment-radius 1 : initial-segment ( -- segment ) float-array{ 0 0 0 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } @@ -115,7 +117,7 @@ C: segment : wall-normal ( seg oint -- n ) location>> vector-to-centre normalize ; -: distant ( -- n ) 1000 ; +CONSTANT: distant 1000 : max-real ( a b -- c ) #! sometimes collision-coefficient yields complex roots, so we ignore these (hack) diff --git a/extra/synth/buffers/buffers.factor b/extra/synth/buffers/buffers.factor index 671ebead63..4c0ef64607 100644 --- a/extra/synth/buffers/buffers.factor +++ b/extra/synth/buffers/buffers.factor @@ -57,11 +57,11 @@ M: 8bit-stereo-buffer buffer-data M: 16bit-stereo-buffer buffer-data interleaved-stereo-data 16bit-buffer-data ; -: telephone-sample-freq ( -- n ) 8000 ; -: half-sample-freq ( -- n ) 22050 ; -: cd-sample-freq ( -- n ) 44100 ; -: digital-sample-freq ( -- n ) 48000 ; -: professional-sample-freq ( -- n ) 88200 ; +CONSTANT: telephone-sample-freq 8000 +CONSTANT: half-sample-freq 22050 +CONSTANT: cd-sample-freq 44100 +CONSTANT: digital-sample-freq 48000 +CONSTANT: professional-sample-freq 88200 : send-buffer ( buffer -- buffer ) { From 0e6f76c13d8ded676ea792020f74e1fae00eae84 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Mon, 20 Apr 2009 14:15:38 +1000 Subject: [PATCH 10/29] Using literals vocab for defining computed constants --- extra/jamshred/tunnel/tunnel.factor | 6 +- extra/morse/morse.factor | 124 ++++++++++++++-------------- 2 files changed, 62 insertions(+), 68 deletions(-) diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index d951a37f0c..6171c3053b 100644 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays colors combinators kernel locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ; +USING: accessors arrays colors combinators kernel literals locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ; IN: jamshred.tunnel CONSTANT: n-segments 5000 @@ -15,9 +15,7 @@ C: segment { 100 100 100 } [ random 100 / >float ] map first3 1.0 ; CONSTANT: tunnel-segment-distance 0.4 -USE: words.constant -DEFER: random-rotation-angle -\ random-rotation-angle pi 20 / define-constant +CONSTANT: random-rotation-angle $[ pi 20 / ] : random-segment ( previous-segment -- segment ) clone dup random-rotation-angle random-turn diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor index 49e6ae39f5..ef4b9d4b88 100644 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2007, 2008, 2009 Alex Chapman, 2009 Diego Martinelli ! See http://factorcode.org/license.txt for BSD license. -USING: accessors ascii assocs biassocs combinators hashtables kernel lists math -namespaces make multiline openal parser sequences splitting strings synth synth.buffers ; +USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ; IN: morse -DEFER: morse-code-table - -H{ - { CHAR: a ".-" } - { CHAR: b "-..." } - { CHAR: c "-.-." } - { CHAR: d "-.." } - { CHAR: e "." } - { CHAR: f "..-." } - { CHAR: g "--." } - { CHAR: h "...." } - { CHAR: i ".." } - { CHAR: j ".---" } - { CHAR: k "-.-" } - { CHAR: l ".-.." } - { CHAR: m "--" } - { CHAR: n "-." } - { CHAR: o "---" } - { CHAR: p ".--." } - { CHAR: q "--.-" } - { CHAR: r ".-." } - { CHAR: s "..." } - { CHAR: t "-" } - { CHAR: u "..-" } - { CHAR: v "...-" } - { CHAR: w ".--" } - { CHAR: x "-..-" } - { CHAR: y "-.--" } - { CHAR: z "--.." } - { CHAR: 1 ".----" } - { CHAR: 2 "..---" } - { CHAR: 3 "...--" } - { CHAR: 4 "....-" } - { CHAR: 5 "....." } - { CHAR: 6 "-...." } - { CHAR: 7 "--..." } - { CHAR: 8 "---.." } - { CHAR: 9 "----." } - { CHAR: 0 "-----" } - { CHAR: . ".-.-.-" } - { CHAR: , "--..--" } - { CHAR: ? "..--.." } - { CHAR: ' ".----." } - { CHAR: ! "-.-.--" } - { CHAR: / "-..-." } - { CHAR: ( "-.--." } - { CHAR: ) "-.--.-" } - { CHAR: & ".-..." } - { CHAR: : "---..." } - { CHAR: ; "-.-.-." } - { CHAR: = "-...- " } - { CHAR: + ".-.-." } - { CHAR: - "-....-" } - { CHAR: _ "..--.-" } - { CHAR: " ".-..-." } - { CHAR: $ "...-..-" } - { CHAR: @ ".--.-." } - { CHAR: \s "/" } -} >biassoc \ morse-code-table set-global - -: morse-code-table ( -- biassoc ) - \ morse-code-table get-global ; +CONSTANT: morse-code-table $[ + H{ + { CHAR: a ".-" } + { CHAR: b "-..." } + { CHAR: c "-.-." } + { CHAR: d "-.." } + { CHAR: e "." } + { CHAR: f "..-." } + { CHAR: g "--." } + { CHAR: h "...." } + { CHAR: i ".." } + { CHAR: j ".---" } + { CHAR: k "-.-" } + { CHAR: l ".-.." } + { CHAR: m "--" } + { CHAR: n "-." } + { CHAR: o "---" } + { CHAR: p ".--." } + { CHAR: q "--.-" } + { CHAR: r ".-." } + { CHAR: s "..." } + { CHAR: t "-" } + { CHAR: u "..-" } + { CHAR: v "...-" } + { CHAR: w ".--" } + { CHAR: x "-..-" } + { CHAR: y "-.--" } + { CHAR: z "--.." } + { CHAR: 1 ".----" } + { CHAR: 2 "..---" } + { CHAR: 3 "...--" } + { CHAR: 4 "....-" } + { CHAR: 5 "....." } + { CHAR: 6 "-...." } + { CHAR: 7 "--..." } + { CHAR: 8 "---.." } + { CHAR: 9 "----." } + { CHAR: 0 "-----" } + { CHAR: . ".-.-.-" } + { CHAR: , "--..--" } + { CHAR: ? "..--.." } + { CHAR: ' ".----." } + { CHAR: ! "-.-.--" } + { CHAR: / "-..-." } + { CHAR: ( "-.--." } + { CHAR: ) "-.--.-" } + { CHAR: & ".-..." } + { CHAR: : "---..." } + { CHAR: ; "-.-.-." } + { CHAR: = "-...- " } + { CHAR: + ".-.-." } + { CHAR: - "-....-" } + { CHAR: _ "..--.-" } + { CHAR: " ".-..-." } + { CHAR: $ "...-..-" } + { CHAR: @ ".--.-." } + { CHAR: \s "/" } + } >biassoc +] : ch>morse ( ch -- morse ) ch>lower morse-code-table at [ unknown-char ] unless* ; From bcd05337943f0b694ed0b54c1a94d3ca55e170bc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 01:42:54 -0500 Subject: [PATCH 11/29] Improve example in syntax vocab --- core/syntax/syntax-docs.factor | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index f869cff506..73335e09cf 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -525,11 +525,19 @@ HELP: (( { $description "Literal stack effect syntax." } { $notes "Useful for meta-programming with " { $link define-declared } "." } { $examples - { $code - "<< SYMBOL: my-dynamic-word" - "USING: math random words ;" - "my-dynamic-word 3 { [ + ] [ - ] [ * ] [ / ] } random curry" - "(( x -- y )) define-declared >>" + { $example + "USING: compiler.units kernel math prettyprint random words ;" + "IN: scratchpad" + "" + "SYMBOL: my-dynamic-word" + "" + "[" + " my-dynamic-word 2 { [ + ] [ * ] } random curry" + " (( x -- y )) define-declared" + "] with-compilation-unit" + "" + "2 my-dynamic-word ." + "4" } } ; From 86e5ddf449aa283ca3894b46b43cdd23df13bec7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 01:47:10 -0500 Subject: [PATCH 12/29] Improve Unix signal and Windows structured exception reporting --- basis/debugger/debugger.factor | 29 +++++++-------------------- basis/debugger/unix/authors.txt | 1 + basis/debugger/unix/unix.factor | 23 +++++++++++++++++++++ basis/debugger/windows/authors.txt | 1 + basis/debugger/windows/windows.factor | 6 ++++++ 5 files changed, 38 insertions(+), 22 deletions(-) create mode 100644 basis/debugger/unix/authors.txt create mode 100644 basis/debugger/unix/unix.factor create mode 100644 basis/debugger/windows/authors.txt create mode 100644 basis/debugger/windows/windows.factor diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 64bac3ecee..9abd5a9033 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -88,27 +88,7 @@ M: string error. print ; : divide-by-zero-error. ( obj -- ) "Division by zero" print drop ; -CONSTANT: signal-names -{ - "SIGHUP" "SIGINT" "SIGQUIT" "SIGILL" "SIGTRAP" "SIGABRT" - "SIGEMT" "SIGFPE" "SIGKILL" "SIGBUS" "SIGSEGV" "SIGSYS" - "SIGPIPE" "SIGALRM" "SIGTERM" "SIGURG" "SIGSTOP" "SIGTSIP" - "SIGCONT" "SIGCHLD" "SIGTTIN" "SIGTTOU" "SIGIO" "SIGXCPU" - "SIGXFSZ" "SIGVTALRM" "SIGPROF" "SIGWINCH" "SIGINFO" - "SIGUSR1" "SIGUSR2" -} - -: signal-name ( n -- str ) - 1- signal-names nth; - -: signal-name. ( n -- ) - dup signal-names length <= - os unix? and - [ " (" write signal-name write ")" write ] [ drop ] if ; - -: signal-error. ( obj -- ) - "Operating system signal " write - third [ pprint ] [ signal-name. ] bi nl ; +HOOK: signal-error. os ( obj -- ) : array-size-error. ( obj -- ) "Invalid array size: " write dup third . @@ -325,4 +305,9 @@ M: check-mixin-class summary drop "Not a mixin class" ; M: not-found-in-roots summary drop "Cannot resolve vocab: path" ; -M: wrong-values summary drop "Quotation called with wrong stack effect" ; \ No newline at end of file +M: wrong-values summary drop "Quotation called with wrong stack effect" ; + +{ + { [ os windows? ] [ "debugger.windows" require ] } + { [ os unix? ] [ "debugger.unix" require ] } +} cond \ No newline at end of file diff --git a/basis/debugger/unix/authors.txt b/basis/debugger/unix/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/debugger/unix/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/debugger/unix/unix.factor b/basis/debugger/unix/unix.factor new file mode 100644 index 0000000000..212908b2fd --- /dev/null +++ b/basis/debugger/unix/unix.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: debugger io kernel math prettyprint sequences system ; +IN: debugger.unix + +CONSTANT: signal-names +{ + "SIGHUP" "SIGINT" "SIGQUIT" "SIGILL" "SIGTRAP" "SIGABRT" + "SIGEMT" "SIGFPE" "SIGKILL" "SIGBUS" "SIGSEGV" "SIGSYS" + "SIGPIPE" "SIGALRM" "SIGTERM" "SIGURG" "SIGSTOP" "SIGTSIP" + "SIGCONT" "SIGCHLD" "SIGTTIN" "SIGTTOU" "SIGIO" "SIGXCPU" + "SIGXFSZ" "SIGVTALRM" "SIGPROF" "SIGWINCH" "SIGINFO" + "SIGUSR1" "SIGUSR2" +} + +: signal-name ( n -- str/f ) 1- signal-names ?nth ; + +: signal-name. ( n -- ) + signal-name [ " (" ")" surround write ] when* ; + +M: unix signal-error. ( obj -- ) + "Unix signal #" write + third [ pprint ] [ signal-name. ] bi nl ; diff --git a/basis/debugger/windows/authors.txt b/basis/debugger/windows/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/debugger/windows/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/debugger/windows/windows.factor b/basis/debugger/windows/windows.factor new file mode 100644 index 0000000000..1f4b8fb0ac --- /dev/null +++ b/basis/debugger/windows/windows.factor @@ -0,0 +1,6 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: debugger io prettyprint sequences system ; +IN: debugger.windows + +M: windows signal-error. "Windows exception #" write third .h ; \ No newline at end of file From 5ac1358aea56fd86bc93206cc940795f0849f4fc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 01:55:27 -0500 Subject: [PATCH 13/29] Report actual SEH code on Windows instead of 'signal 11' --- vm/bignum.c | 6 +++--- vm/errors.c | 9 ++------- vm/errors.h | 3 +-- vm/os-windows-nt.c | 8 +------- 4 files changed, 7 insertions(+), 19 deletions(-) mode change 100644 => 100755 vm/bignum.c diff --git a/vm/bignum.c b/vm/bignum.c old mode 100644 new mode 100755 index 497a4bbf62..c799691f36 --- a/vm/bignum.c +++ b/vm/bignum.c @@ -170,7 +170,7 @@ bignum_divide(bignum_type numerator, bignum_type denominator, { if (BIGNUM_ZERO_P (denominator)) { - divide_by_zero_error(NULL); + divide_by_zero_error(); return; } if (BIGNUM_ZERO_P (numerator)) @@ -242,7 +242,7 @@ bignum_quotient(bignum_type numerator, bignum_type denominator) { if (BIGNUM_ZERO_P (denominator)) { - divide_by_zero_error(NULL); + divide_by_zero_error(); return (BIGNUM_OUT_OF_BAND); } if (BIGNUM_ZERO_P (numerator)) @@ -295,7 +295,7 @@ bignum_remainder(bignum_type numerator, bignum_type denominator) { if (BIGNUM_ZERO_P (denominator)) { - divide_by_zero_error(NULL); + divide_by_zero_error(); return (BIGNUM_OUT_OF_BAND); } if (BIGNUM_ZERO_P (numerator)) diff --git a/vm/errors.c b/vm/errors.c index 9b7b7843d2..8e7b4818bf 100755 --- a/vm/errors.c +++ b/vm/errors.c @@ -124,9 +124,9 @@ void signal_error(int signal, F_STACK_FRAME *native_stack) general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack); } -void divide_by_zero_error(F_STACK_FRAME *native_stack) +void divide_by_zero_error(void) { - general_error(ERROR_DIVIDE_BY_ZERO,F,F,native_stack); + general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL); } void memory_signal_handler_impl(void) @@ -134,11 +134,6 @@ void memory_signal_handler_impl(void) memory_protection_error(signal_fault_addr,signal_callstack_top); } -void divide_by_zero_signal_handler_impl(void) -{ - divide_by_zero_error(signal_callstack_top); -} - void misc_signal_handler_impl(void) { signal_error(signal_number,signal_callstack_top); diff --git a/vm/errors.h b/vm/errors.h index da3ee8bbe0..56aaf60d54 100755 --- a/vm/errors.h +++ b/vm/errors.h @@ -26,7 +26,7 @@ void primitive_die(void); void throw_error(CELL error, F_STACK_FRAME *native_stack); void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, F_STACK_FRAME *native_stack); -void divide_by_zero_error(F_STACK_FRAME *native_stack); +void divide_by_zero_error(void); void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack); void signal_error(int signal, F_STACK_FRAME *native_stack); void type_error(CELL type, CELL tagged); @@ -53,7 +53,6 @@ CELL signal_fault_addr; void *signal_callstack_top; void memory_signal_handler_impl(void); -void divide_by_zero_signal_handler_impl(void); void misc_signal_handler_impl(void); void primitive_unimplemented(void); diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index bcddd0b140..501463378a 100755 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -23,12 +23,6 @@ long exception_handler(PEXCEPTION_POINTERS pe) signal_fault_addr = e->ExceptionInformation[1]; c->EIP = (CELL)memory_signal_handler_impl; } - else if(e->ExceptionCode == EXCEPTION_FLT_DIVIDE_BY_ZERO - || e->ExceptionCode == EXCEPTION_INT_DIVIDE_BY_ZERO) - { - signal_number = ERROR_DIVIDE_BY_ZERO; - c->EIP = (CELL)divide_by_zero_signal_handler_impl; - } /* If the Widcomm bluetooth stack is installed, the BTTray.exe process injects code into running programs. For some reason this results in random SEH exceptions with this (undocumented) exception code being @@ -37,7 +31,7 @@ long exception_handler(PEXCEPTION_POINTERS pe) this exception means. */ else if(e->ExceptionCode != 0x40010006) { - signal_number = 11; + signal_number = e->ExceptionCode; c->EIP = (CELL)misc_signal_handler_impl; } From ec72f33fcbe0d8dee60d83b5d5195653511dfdec Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 02:23:52 -0500 Subject: [PATCH 14/29] Documentation updates --- basis/help/handbook/handbook.factor | 1 + basis/ui/tools/profiler/profiler-docs.factor | 10 +++++++--- basis/ui/tools/tools-docs.factor | 11 ----------- core/combinators/combinators-docs.factor | 6 ------ core/parser/parser-docs.factor | 3 +-- core/quotations/quotations-docs.factor | 6 ++++++ 6 files changed, 15 insertions(+), 22 deletions(-) diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 1aac99defe..a97a46badc 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -249,6 +249,7 @@ ARTICLE: "handbook-language-reference" "The language" { $heading "Abstractions" } { $subsection "objects" } { $subsection "destructors" } +{ $subsection "parsing-words" } { $subsection "macros" } { $subsection "fry" } { $heading "Program organization" } diff --git a/basis/ui/tools/profiler/profiler-docs.factor b/basis/ui/tools/profiler/profiler-docs.factor index e2a0ef5f4e..fad2b3614f 100644 --- a/basis/ui/tools/profiler/profiler-docs.factor +++ b/basis/ui/tools/profiler/profiler-docs.factor @@ -1,10 +1,14 @@ IN: ui.tools.profiler -USING: help.markup help.syntax ui.operations help.tips ; +USING: help.markup help.syntax ui.operations ui.commands help.tips ; -ARTICLE: "ui.tools.profiler" "UI profiler tool" +ARTICLE: "ui.tools.profiler" "UI profiler tool" "The " { $vocab-link "ui.tools.profiler" } " vocabulary implements a graphical tool for viewing profiling results (see " { $link "profiling" } ")." $nl -"To use the profiler, enter a piece of code in the listener's input area and press " { $operation com-profile } "." ; +"To use the profiler, enter a piece of code in the listener input area and press " { $operation com-profile } "." +$nl +"Clicking on a vocabulary in the vocabulary list narrows down the word list to only include words from that vocabulary. The sorting options control the order of elements in the vocabulary and word lists. The search fields narrow down the list to only include words or vocabularies whose names contain a substring." +$nl +"Consult " { $link "profiling" } " for details about the profiler itself." ; TIP: "Press " { $operation com-profile } " to run the code in the input field with profiling enabled (" { $link "ui.tools.profiler" } ")." ; diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor index 92aa1be947..7be008f296 100644 --- a/basis/ui/tools/tools-docs.factor +++ b/basis/ui/tools/tools-docs.factor @@ -31,17 +31,6 @@ $nl $nl "For more about presentation gadgets, see " { $link "ui.gadgets.presentations" } "." ; -ARTICLE: "ui-profiler" "UI profiler" -"The graphical profiler is based on the terminal profiler (see " { $link "profiling" } ") and adds more convenient browsing of profiler results." -$nl -"To use the profiler, enter a piece of code in the listener input area and press " { $operation com-profile } "." -$nl -"Clicking on a vocabulary in the vocabulary list narrows down the word list to only include words from that vocabulary. The sorting options control the order of elements in the vocabulary and word lists. The search fields narrow down the list to only include words or vocabularies whose names contain a substring." -$nl -"Consult " { $link "profiling" } " for details about the profiler itself." -{ $command-map profiler-gadget "toolbar" } -"The profiler is an instance of " { $link profiler-gadget } "." ; - ARTICLE: "ui-cocoa" "Functionality specific to Mac OS X" "On Mac OS X, the Factor UI offers additional features which integrate with this operating system." $nl diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index 9c96fe34c9..dd55d5fabe 100644 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -303,13 +303,7 @@ ARTICLE: "combinators" "Combinators" { $subsection "combinators.short-circuit" } { $subsection "combinators.smart" } "More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "." -$nl -"The " { $vocab-link "combinators" } " provides some less frequently-used features." -$nl -"A combinator which can help with implementing methods on " { $link hashcode* } ":" -{ $subsection recursive-hashcode } { $subsection "combinators-quot" } -"Advanced topics:" { $see-also "quotations" } ; ABOUT: "combinators" diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index be4b345f4f..ea82f7276f 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -94,11 +94,10 @@ $nl "This section concerns itself with usage and extension of the parser. Standard syntax is described in " { $link "syntax" } "." { $subsection "parser-files" } "The parser can be extended." -{ $subsection "parsing-words" } { $subsection "parser-lexer" } "The parser can be invoked reflectively;" { $subsection parse-stream } -{ $see-also "definitions" "definition-checking" } ; +{ $see-also "parsing-words" "definitions" "definition-checking" } ; ABOUT: "parser" diff --git a/core/quotations/quotations-docs.factor b/core/quotations/quotations-docs.factor index 603d6f2847..364f186d52 100644 --- a/core/quotations/quotations-docs.factor +++ b/core/quotations/quotations-docs.factor @@ -25,6 +25,12 @@ ARTICLE: "wrappers" "Wrappers" { $subsection wrapper } { $subsection literalize } "Wrapper literal syntax is documented in " { $link "syntax-words" } "." +{ $example + "IN: scratchpad" + "DEFER: my-word" + "\\ my-word name>> ." + "\"my-word\"" +} { $see-also "combinators" } ; ABOUT: "quotations" From 0f26d02d41edd2fe4d96d00557d6c1cc68aece6a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 03:26:56 -0500 Subject: [PATCH 15/29] Passing the wrong type of sequence to M\ encoder write now throws an error --- basis/io/files/unique/unique-tests.factor | 2 +- core/io/encodings/encodings.factor | 4 +++- core/io/files/files-tests.factor | 14 +++++++++++++- 3 files changed, 17 insertions(+), 3 deletions(-) diff --git a/basis/io/files/unique/unique-tests.factor b/basis/io/files/unique/unique-tests.factor index fd8cf2c69f..53a77907cf 100644 --- a/basis/io/files/unique/unique-tests.factor +++ b/basis/io/files/unique/unique-tests.factor @@ -5,7 +5,7 @@ IN: io.files.unique.tests [ 123 ] [ "core" ".test" [ - [ [ 123 CHAR: a ] dip ascii set-file-contents ] + [ [ 123 CHAR: a ] dip ascii set-file-contents ] [ file-info size>> ] bi ] cleanup-unique-file ] unit-test diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 696de9af69..174816dd34 100644 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -130,7 +130,9 @@ M: encoder stream-element-type M: encoder stream-write1 >encoder< encode-char ; -: encoder-write ( string stream encoding -- ) +GENERIC# encoder-write 2 ( string stream encoding -- ) + +M: string encoder-write [ encode-char ] 2curry each ; M: encoder stream-write diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index ce15a69773..a2d637dcb7 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,7 +1,7 @@ USING: arrays debugger.threads destructors io io.directories io.encodings.8-bit io.encodings.ascii io.encodings.binary io.files io.files.private io.files.temp io.files.unique kernel -make math sequences system threads tools.test ; +make math sequences system threads tools.test generic.standard ; IN: io.files.tests \ exists? must-infer @@ -144,3 +144,15 @@ USE: debugger.threads -10 seek-absolute seek-input ] with-file-reader ] must-fail + +[ + "non-string-error" unique-file ascii [ + { } write + ] with-file-writer +] [ no-method? ] must-fail-with + +[ + "non-byte-array-error" unique-file binary [ + "" write + ] with-file-writer +] [ no-method? ] must-fail-with \ No newline at end of file From ec49307c88cb0db7b4fd0dc4b1ca0694a0e0c654 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 03:27:18 -0500 Subject: [PATCH 16/29] Never inline default methods, and fix inlining of methods with hints --- .../tree/propagation/inlining/inlining.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 0815351057..7ae44a5293 100755 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -3,7 +3,7 @@ USING: accessors kernel arrays sequences math math.order math.partial-dispatch generic generic.standard generic.math classes.algebra classes.union sets quotations assocs combinators -words namespaces continuations classes fry combinators.smart +words namespaces continuations classes fry combinators.smart hints compiler.tree compiler.tree.builder compiler.tree.recursive @@ -136,12 +136,10 @@ DEFER: (flat-length) [ [ classes-known? 2 0 ? ] [ - { - [ body-length-bias ] - [ "default" word-prop -4 0 ? ] - [ "specializer" word-prop 1 0 ? ] - [ method-body? 1 0 ? ] - } cleave + [ body-length-bias ] + [ "specializer" word-prop 1 0 ? ] + [ method-body? 1 0 ? ] + tri node-count-bias loop-nesting get 0 or 2 * ] bi* @@ -172,7 +170,7 @@ SYMBOL: history ] if ; : inline-word ( #call word -- ? ) - dup def>> inline-word-def ; + dup specialized-def inline-word-def ; : inline-method-body ( #call word -- ? ) 2dup should-inline? [ inline-word ] [ 2drop f ] if ; @@ -181,7 +179,9 @@ SYMBOL: history { curry compose } memq? ; : never-inline-word? ( word -- ? ) - [ deferred? ] [ { call execute } memq? ] bi or ; + [ deferred? ] + [ "default" word-prop ] + [ { call execute } memq? ] tri or or ; : custom-inlining? ( word -- ? ) "custom-inlining" word-prop ; From 7aeb13e58a150a2dd8f4e6065677e9b384b1babb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 03:27:30 -0500 Subject: [PATCH 17/29] io.buffers and io.ports performance tweaks --- basis/io/buffers/buffers.factor | 2 +- basis/io/ports/ports.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index 4df081b17d..49b5357d98 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -22,7 +22,7 @@ M: buffer dispose* ptr>> free ; swap >>fill 0 >>pos drop ; : buffer-capacity ( buffer -- n ) - [ size>> ] [ fill>> ] bi - ; inline + [ size>> ] [ fill>> ] bi - >fixnum ; inline : buffer-empty? ( buffer -- ? ) fill>> zero? ; inline diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 569366d4b8..b2d71fd535 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -189,4 +189,4 @@ HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } HINTS: decoder-readln { input-port utf8 } { input-port ascii } ; -HINTS: encoder-write { string output-port utf8 } { string output-port ascii } ; +HINTS: encoder-write { object output-port utf8 } { object output-port ascii } ; From 3b40334ccda0cd45398e4f8fd6ffca85c8c0e127 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 03:27:52 -0500 Subject: [PATCH 18/29] xml: fix compile warnings in tests --- basis/xml/tests/state-parser-tests.factor | 2 +- basis/xml/tests/xmltest.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/xml/tests/state-parser-tests.factor b/basis/xml/tests/state-parser-tests.factor index 7616efaf1d..5e214dc4a3 100644 --- a/basis/xml/tests/state-parser-tests.factor +++ b/basis/xml/tests/state-parser-tests.factor @@ -2,7 +2,7 @@ USING: tools.test xml.tokenize xml.state io.streams.string kernel io strings asc IN: xml.test.state : string-parse ( str quot -- ) - [ ] dip with-state ; + [ ] dip with-state ; inline : take-rest ( -- string ) [ f ] take-until ; diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor index c41b05eb85..55b5147abb 100644 --- a/basis/xml/tests/xmltest.factor +++ b/basis/xml/tests/xmltest.factor @@ -43,7 +43,7 @@ MACRO: drop-input ( quot -- newquot ) xml-tests [ unit-test ] assoc-each ; : works? ( result quot -- ? ) - [ first ] [ call ] bi* = ; + [ first ] [ call( -- result ) ] bi* = ; : partition-xml-tests ( -- successes failures ) xml-tests [ first2 works? ] partition ; From a4d48a1cd466ec356b42e55be51bbd1dbed8ec19 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 03:28:03 -0500 Subject: [PATCH 19/29] xml.writer: don't write arrays to output-stream --- basis/xml/writer/writer-tests.factor | 12 ++++++++++-- basis/xml/writer/writer.factor | 2 +- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor index f19e845ab9..2d31738c4c 100644 --- a/basis/xml/writer/writer-tests.factor +++ b/basis/xml/writer/writer-tests.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: xml.data xml.writer tools.test fry xml kernel multiline +USING: xml.data xml.writer tools.test fry xml xml.syntax kernel multiline xml.writer.private io.streams.string xml.traversal sequences -io.encodings.utf8 io.files accessors io.directories ; +io.encodings.utf8 io.files accessors io.directories math math.parser ; IN: xml.writer.tests \ write-xml must-infer @@ -66,3 +66,11 @@ CONSTANT: test-file "resource:basis/xml/writer/test.xml" [ ] [ "" string>xml test-file utf8 [ write-xml ] with-file-writer ] unit-test [ "x" ] [ test-file file>xml body>> name>> main>> ] unit-test [ ] [ test-file delete-file ] unit-test + +[ ] [ + { 1 2 3 4 } [ + [ number>string ] [ sq number>string ] bi + [XML <-><-> XML] + ] map [XML

Timings

<->
XML] + pprint-xml +] unit-test \ No newline at end of file diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor index 4f5bad1aa5..ab957ebc75 100755 --- a/basis/xml/writer/writer.factor +++ b/basis/xml/writer/writer.factor @@ -19,7 +19,7 @@ SYMBOL: indentation : indent-string ( -- string ) xml-pprint? get - [ indentation get indenter get concat ] + [ indentation get indenter get "" join ] [ "" ] if ; : ?indent ( -- ) From dff8f80ea657fc51cdcd8454eba0c774391e4a39 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 03:29:16 -0500 Subject: [PATCH 20/29] mason.report: fix timings-table, and add unit tests --- .../report/fake-data/benchmark-error-messages | 1 + .../report/fake-data/benchmark-error-vocabs | 1 + extra/mason/report/fake-data/benchmark-time | 1 + extra/mason/report/fake-data/benchmarks | 1 + extra/mason/report/fake-data/boot-log | 2 ++ extra/mason/report/fake-data/boot-time | 1 + extra/mason/report/fake-data/compile-log | 2 ++ .../report/fake-data/compiler-error-messages | 1 + extra/mason/report/fake-data/compiler-errors | 1 + extra/mason/report/fake-data/git-id | 1 + extra/mason/report/fake-data/help-lint-errors | 1 + extra/mason/report/fake-data/help-lint-time | 1 + extra/mason/report/fake-data/help-lint-vocabs | 1 + extra/mason/report/fake-data/html-help-time | 1 + .../report/fake-data/load-everything-errors | 1 + .../report/fake-data/load-everything-vocabs | 1 + extra/mason/report/fake-data/load-time | 1 + extra/mason/report/fake-data/test-all-errors | 1 + extra/mason/report/fake-data/test-all-vocabs | 1 + extra/mason/report/fake-data/test-log | 2 ++ extra/mason/report/fake-data/test-time | 1 + extra/mason/report/report-tests.factor | 28 +++++++++++++++++-- extra/mason/report/report.factor | 18 ++++++------ 23 files changed, 59 insertions(+), 11 deletions(-) create mode 100644 extra/mason/report/fake-data/benchmark-error-messages create mode 100644 extra/mason/report/fake-data/benchmark-error-vocabs create mode 100644 extra/mason/report/fake-data/benchmark-time create mode 100644 extra/mason/report/fake-data/benchmarks create mode 100644 extra/mason/report/fake-data/boot-log create mode 100644 extra/mason/report/fake-data/boot-time create mode 100644 extra/mason/report/fake-data/compile-log create mode 100644 extra/mason/report/fake-data/compiler-error-messages create mode 100644 extra/mason/report/fake-data/compiler-errors create mode 100644 extra/mason/report/fake-data/git-id create mode 100644 extra/mason/report/fake-data/help-lint-errors create mode 100644 extra/mason/report/fake-data/help-lint-time create mode 100644 extra/mason/report/fake-data/help-lint-vocabs create mode 100644 extra/mason/report/fake-data/html-help-time create mode 100644 extra/mason/report/fake-data/load-everything-errors create mode 100644 extra/mason/report/fake-data/load-everything-vocabs create mode 100644 extra/mason/report/fake-data/load-time create mode 100644 extra/mason/report/fake-data/test-all-errors create mode 100644 extra/mason/report/fake-data/test-all-vocabs create mode 100644 extra/mason/report/fake-data/test-log create mode 100644 extra/mason/report/fake-data/test-time diff --git a/extra/mason/report/fake-data/benchmark-error-messages b/extra/mason/report/fake-data/benchmark-error-messages new file mode 100644 index 0000000000..f738144e3c --- /dev/null +++ b/extra/mason/report/fake-data/benchmark-error-messages @@ -0,0 +1 @@ +Benchmarks diff --git a/extra/mason/report/fake-data/benchmark-error-vocabs b/extra/mason/report/fake-data/benchmark-error-vocabs new file mode 100644 index 0000000000..b5a85b9c41 --- /dev/null +++ b/extra/mason/report/fake-data/benchmark-error-vocabs @@ -0,0 +1 @@ +{ "benchmarks" } diff --git a/extra/mason/report/fake-data/benchmark-time b/extra/mason/report/fake-data/benchmark-time new file mode 100644 index 0000000000..81c545efeb --- /dev/null +++ b/extra/mason/report/fake-data/benchmark-time @@ -0,0 +1 @@ +1234 diff --git a/extra/mason/report/fake-data/benchmarks b/extra/mason/report/fake-data/benchmarks new file mode 100644 index 0000000000..ed8ec42879 --- /dev/null +++ b/extra/mason/report/fake-data/benchmarks @@ -0,0 +1 @@ +H{ { "a" 1 } { "b" 2 } } diff --git a/extra/mason/report/fake-data/boot-log b/extra/mason/report/fake-data/boot-log new file mode 100644 index 0000000000..d9e4d79562 --- /dev/null +++ b/extra/mason/report/fake-data/boot-log @@ -0,0 +1,2 @@ +Boot +Log diff --git a/extra/mason/report/fake-data/boot-time b/extra/mason/report/fake-data/boot-time new file mode 100644 index 0000000000..81c545efeb --- /dev/null +++ b/extra/mason/report/fake-data/boot-time @@ -0,0 +1 @@ +1234 diff --git a/extra/mason/report/fake-data/compile-log b/extra/mason/report/fake-data/compile-log new file mode 100644 index 0000000000..5007c38d13 --- /dev/null +++ b/extra/mason/report/fake-data/compile-log @@ -0,0 +1,2 @@ +Compile +Log diff --git a/extra/mason/report/fake-data/compiler-error-messages b/extra/mason/report/fake-data/compiler-error-messages new file mode 100644 index 0000000000..1a58d6dcf0 --- /dev/null +++ b/extra/mason/report/fake-data/compiler-error-messages @@ -0,0 +1 @@ +Compiler errors diff --git a/extra/mason/report/fake-data/compiler-errors b/extra/mason/report/fake-data/compiler-errors new file mode 100644 index 0000000000..4e5eee20e2 --- /dev/null +++ b/extra/mason/report/fake-data/compiler-errors @@ -0,0 +1 @@ +{ "compiler-errors" } diff --git a/extra/mason/report/fake-data/git-id b/extra/mason/report/fake-data/git-id new file mode 100644 index 0000000000..d4d308b176 --- /dev/null +++ b/extra/mason/report/fake-data/git-id @@ -0,0 +1 @@ +"deadbeef" diff --git a/extra/mason/report/fake-data/help-lint-errors b/extra/mason/report/fake-data/help-lint-errors new file mode 100644 index 0000000000..da540b4802 --- /dev/null +++ b/extra/mason/report/fake-data/help-lint-errors @@ -0,0 +1 @@ +Help lint diff --git a/extra/mason/report/fake-data/help-lint-time b/extra/mason/report/fake-data/help-lint-time new file mode 100644 index 0000000000..81c545efeb --- /dev/null +++ b/extra/mason/report/fake-data/help-lint-time @@ -0,0 +1 @@ +1234 diff --git a/extra/mason/report/fake-data/help-lint-vocabs b/extra/mason/report/fake-data/help-lint-vocabs new file mode 100644 index 0000000000..6d88a7fff8 --- /dev/null +++ b/extra/mason/report/fake-data/help-lint-vocabs @@ -0,0 +1 @@ +{ "help-lint" } diff --git a/extra/mason/report/fake-data/html-help-time b/extra/mason/report/fake-data/html-help-time new file mode 100644 index 0000000000..81c545efeb --- /dev/null +++ b/extra/mason/report/fake-data/html-help-time @@ -0,0 +1 @@ +1234 diff --git a/extra/mason/report/fake-data/load-everything-errors b/extra/mason/report/fake-data/load-everything-errors new file mode 100644 index 0000000000..00d830932d --- /dev/null +++ b/extra/mason/report/fake-data/load-everything-errors @@ -0,0 +1 @@ +Load everything diff --git a/extra/mason/report/fake-data/load-everything-vocabs b/extra/mason/report/fake-data/load-everything-vocabs new file mode 100644 index 0000000000..2ecd4f611c --- /dev/null +++ b/extra/mason/report/fake-data/load-everything-vocabs @@ -0,0 +1 @@ +{ "load-everything" } diff --git a/extra/mason/report/fake-data/load-time b/extra/mason/report/fake-data/load-time new file mode 100644 index 0000000000..81c545efeb --- /dev/null +++ b/extra/mason/report/fake-data/load-time @@ -0,0 +1 @@ +1234 diff --git a/extra/mason/report/fake-data/test-all-errors b/extra/mason/report/fake-data/test-all-errors new file mode 100644 index 0000000000..13a64ee834 --- /dev/null +++ b/extra/mason/report/fake-data/test-all-errors @@ -0,0 +1 @@ +Test all errors diff --git a/extra/mason/report/fake-data/test-all-vocabs b/extra/mason/report/fake-data/test-all-vocabs new file mode 100644 index 0000000000..ef6294b9c7 --- /dev/null +++ b/extra/mason/report/fake-data/test-all-vocabs @@ -0,0 +1 @@ +{ "test-all" } diff --git a/extra/mason/report/fake-data/test-log b/extra/mason/report/fake-data/test-log new file mode 100644 index 0000000000..0b8521b008 --- /dev/null +++ b/extra/mason/report/fake-data/test-log @@ -0,0 +1,2 @@ +Test +Log diff --git a/extra/mason/report/fake-data/test-time b/extra/mason/report/fake-data/test-time new file mode 100644 index 0000000000..81c545efeb --- /dev/null +++ b/extra/mason/report/fake-data/test-time @@ -0,0 +1 @@ +1234 diff --git a/extra/mason/report/report-tests.factor b/extra/mason/report/report-tests.factor index a9e8e2802b..92cada72da 100644 --- a/extra/mason/report/report-tests.factor +++ b/extra/mason/report/report-tests.factor @@ -1,4 +1,28 @@ IN: mason.report.tests -USING: mason.report tools.test ; +USING: io.files io.directories kernel mason.report mason.common +tools.test xml xml.writer ; -{ 0 0 } [ [ ] with-report ] must-infer-as \ No newline at end of file +{ 0 0 } [ [ ] with-report ] must-infer-as + +: verify-report ( -- ) + [ t ] [ "report" exists? ] unit-test + [ ] [ "report" file>xml drop ] unit-test + [ ] [ "report" delete-file ] unit-test ; + +"resource:extra/mason/report/fake-data/" [ + [ ] [ + timings-table pprint-xml + ] unit-test + + [ ] [ successful-report ] unit-test + verify-report + + [ status-error ] [ 1234 compile-failed ] unit-test + verify-report + + [ status-error ] [ 1235 boot-failed ] unit-test + verify-report + + [ status-error ] [ 1236 test-failed ] unit-test + verify-report +] with-directory diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 0839652d55..eb00107d21 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -3,7 +3,8 @@ USING: benchmark combinators.smart debugger fry io assocs io.encodings.utf8 io.files io.sockets io.streams.string kernel locals mason.common mason.config mason.platform math namespaces -prettyprint sequences xml.syntax xml.writer combinators.short-circuit ; +prettyprint sequences xml.syntax xml.writer combinators.short-circuit +literals ; IN: mason.report : common-report ( -- xml ) @@ -56,15 +57,14 @@ IN: mason.report : timings-table ( -- xml ) { - boot-time-file - load-time-file - test-time-file - help-lint-time-file - benchmark-time-file - html-help-time-file + $ boot-time-file + $ load-time-file + $ test-time-file + $ help-lint-time-file + $ benchmark-time-file + $ html-help-time-file } [ - execute( -- string ) - dup utf8 file-contents milli-seconds>time + dup eval-file milli-seconds>time [XML <-><-> XML] ] map [XML

Timings

<->
XML] ; From 5165d811d5dddee055aa5fe5641ccee1e5376965 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 04:21:00 -0500 Subject: [PATCH 21/29] Changing the stack effect of a generic word could break the compiler --- basis/compiler/tests/redefine16.factor | 10 ++++++ .../compiler/tree/optimizer/optimizer.factor | 12 ++++--- .../known-words/known-words.factor | 2 ++ core/words/words.factor | 36 ++++++++++--------- 4 files changed, 40 insertions(+), 20 deletions(-) create mode 100644 basis/compiler/tests/redefine16.factor diff --git a/basis/compiler/tests/redefine16.factor b/basis/compiler/tests/redefine16.factor new file mode 100644 index 0000000000..e0bb1773c9 --- /dev/null +++ b/basis/compiler/tests/redefine16.factor @@ -0,0 +1,10 @@ +IN: compiler.tests.redefine16 +USING: eval tools.test definitions words compiler.units +quotations stack-checker ; + +[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test + +[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test +[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test +[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test +[ "blah" "compiler.tests.redefine16" lookup 1quotation infer ] must-fail diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor index 54c6c2c117..daa8f072ca 100644 --- a/basis/compiler/tree/optimizer/optimizer.factor +++ b/basis/compiler/tree/optimizer/optimizer.factor @@ -18,11 +18,18 @@ IN: compiler.tree.optimizer SYMBOL: check-optimizer? +: ?check ( nodes -- nodes' ) + check-optimizer? get [ + compute-def-use + dup check-nodes + ] when ; + : optimize-tree ( nodes -- nodes' ) analyze-recursive normalize propagate cleanup + ?check dup run-escape-analysis? [ escape-analysis unbox-tuples @@ -30,10 +37,7 @@ SYMBOL: check-optimizer? apply-identities compute-def-use remove-dead-code - check-optimizer? get [ - compute-def-use - dup check-nodes - ] when + ?check compute-def-use optimize-modular-arithmetic finalize ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index ff7288202a..abc1f68bb6 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -218,6 +218,8 @@ M: object infer-call* alien-callback } [ t "special" set-word-prop ] each +M\ quotation call t "no-compile" set-word-prop +M\ word execute t "no-compile" set-word-prop \ clear t "no-compile" set-word-prop : non-inline-word ( word -- ) diff --git a/core/words/words.factor b/core/words/words.factor index 5b230c1b00..c388f093fd 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -68,10 +68,6 @@ M: word crossref? vocabulary>> >boolean ] if ; -GENERIC: compiled-crossref? ( word -- ? ) - -M: word compiled-crossref? crossref? ; - GENERIC# (quot-uses) 1 ( obj assoc -- ) M: object (quot-uses) 2drop ; @@ -131,26 +127,38 @@ compiled-generic-crossref [ H{ } clone ] initialize : inline? ( word -- ? ) "inline" word-prop ; inline +GENERIC: subwords ( word -- seq ) + +M: word subwords drop f ; + + + : redefined ( word -- ) [ H{ } clone visited [ (redefined) ] with-variable ] [ changed-definition ] @@ -199,10 +207,6 @@ M: word reset-word "writer" "delimiter" } reset-props ; -GENERIC: subwords ( word -- seq ) - -M: word subwords drop f ; - : reset-generic ( word -- ) [ subwords forget-all ] [ reset-word ] From 74d352434c02faef127f884b241af6b3205f9158 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 20 Apr 2009 04:25:11 -0500 Subject: [PATCH 22/29] morse: fix help lint --- extra/morse/morse-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/morse/morse-docs.factor b/extra/morse/morse-docs.factor index 93350ad02d..e2fab1528b 100644 --- a/extra/morse/morse-docs.factor +++ b/extra/morse/morse-docs.factor @@ -5,7 +5,7 @@ IN: morse HELP: ch>morse { $values - { "ch" "A character that has a morse code translation" } { "str" "A string consisting of zero or more dots and dashes" } } + { "ch" "A character that has a morse code translation" } { "morse" "A string consisting of zero or more dots and dashes" } } { $description "If the given character has a morse code translation, then return that translation, otherwise return a ? character." } ; HELP: morse>ch @@ -15,12 +15,12 @@ HELP: morse>ch HELP: >morse { $values - { "str" "A string of ASCII characters which can be translated into morse code" } { "str" "A string in morse code" } } + { "str" "A string of ASCII characters which can be translated into morse code" } { "newstr" "A string in morse code" } } { $description "Translates ASCII text into morse code, represented by a series of dots, dashes, and slashes." } { $see-also morse> ch>morse } ; HELP: morse> -{ $values { "str" "A string of morse code, in which the character '.' represents dots, '-' dashes, ' ' spaces between letters, and ' / ' spaces between words." } { "str" "The ASCII translation of the given string" } } +{ $values { "morse" "A string of morse code, in which the character '.' represents dots, '-' dashes, ' ' spaces between letters, and ' / ' spaces between words." } { "plain" "The ASCII translation of the given string" } } { $description "Translates morse code into ASCII text" } { $see-also >morse morse>ch } ; From 5c236d6585afe7751263ca4d9c74722ef6e17ea7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 16:52:18 -0500 Subject: [PATCH 23/29] add a size-on-disk slot to file-info, the each-file combinator now works better, add a path>sizes word --- basis/io/directories/search/search.factor | 44 +++++++++++++++++----- basis/io/files/info/info.factor | 4 +- basis/io/files/info/unix/unix.factor | 1 + basis/io/files/info/windows/windows.factor | 28 +++++++++++++- basis/windows/kernel32/kernel32.factor | 3 +- 5 files changed, 66 insertions(+), 14 deletions(-) diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 6db83ebca6..38d8ec957e 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays continuations deques dlists fry io.directories io.files io.files.info io.pathnames kernel -sequences system vocabs.loader ; +sequences system vocabs.loader locals math namespaces +sorting assocs ; IN: io.directories.search > ] [ bfs>> ] bi + [ qualified-directory ] dip '[ + _ [ queue>> ] [ bfs>> ] bi [ push-front ] [ push-back ] if - ] curry each ; + ] each ; : ( path bfs? -- iterator ) directory-iterator boa @@ -28,12 +29,11 @@ TUPLE: directory-iterator path bfs queue ; [ over push-directory next-file ] [ nip ] if ] if ; -: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) - over next-file [ - over call - [ 2nip ] [ iterate-directory ] if* +:: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) + iter next-file [ + quot call [ iter quot iterate-directory ] unless* ] [ - 2drop f + f ] if* ; inline recursive PRIVATE> @@ -70,4 +70,30 @@ ERROR: file-not-found ; : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) '[ _ _ find-all-files ] map concat ; inline +: with-qualified-directory-files ( path quot -- ) + '[ + "" directory-files current-directory get + '[ _ prepend-path ] map @ + ] with-directory ; inline + +: with-qualified-directory-entries ( path quot -- ) + '[ + "" directory-entries current-directory get + '[ [ _ prepend-path ] change-name ] map @ + ] with-directory ; inline + +: directory-size ( path -- n ) + 0 swap t [ file-info size-on-disk>> + ] each-file ; + +: path>sizes ( path -- assoc ) + [ + [ + [ name>> dup ] [ directory? ] bi [ + directory-size + ] [ + file-info size-on-disk>> + ] if + ] { } map>assoc + ] with-qualified-directory-entries sort-values ; + os windows? [ "io.directories.search.windows" require ] when diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index fd21850612..5c5d2c93d2 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -5,7 +5,7 @@ vocabs.loader io.files.types ; IN: io.files.info ! File info -TUPLE: file-info type size permissions created modified +TUPLE: file-info type size size-on-disk permissions created modified accessed ; HOOK: file-info os ( path -- info ) @@ -25,4 +25,4 @@ HOOK: file-system-info os ( path -- file-system-info ) { { [ os unix? ] [ "io.files.info.unix." os name>> append ] } { [ os windows? ] [ "io.files.info.windows" ] } -} cond require \ No newline at end of file +} cond require diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index 616f70cccc..d4762a536d 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -80,6 +80,7 @@ M: unix stat>file-info ( stat -- file-info ) [ stat-st_rdev >>rdev ] [ stat-st_blocks >>blocks ] [ stat-st_blksize >>blocksize ] + [ drop blocks>> blocksize>> * >>size-on-disk ] } cleave ; : n>file-type ( n -- type ) diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index fdff368491..81e43f8dd9 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -5,11 +5,33 @@ io.files.windows io.files.windows.nt kernel windows.kernel32 windows.time windows accessors alien.c-types combinators generalizations system alien.strings io.encodings.utf16n sequences splitting windows.errors fry continuations destructors -calendar ascii combinators.short-circuit ; +calendar ascii combinators.short-circuit locals ; IN: io.files.info.windows +:: round-up-to ( n multiple -- n' ) + n multiple rem dup 0 = [ + drop n + ] [ + multiple swap - n + + ] if ; + TUPLE: windows-file-info < file-info attributes ; +: get-compressed-file-size ( path -- n ) + "DWORD" [ GetCompressedFileSize ] keep + over INVALID_FILE_SIZE = [ + win32-error-string throw + ] [ + *uint >64bit + ] if ; + +: set-windows-size-on-disk ( file-info path -- file-info ) + over attributes>> +compressed+ swap member? [ + get-compressed-file-size + ] [ + drop dup size>> 4096 round-up-to + ] if >>size-on-disk ; + : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) [ \ windows-file-info new ] dip { @@ -79,7 +101,9 @@ TUPLE: windows-file-info < file-info attributes ; ] if ; M: windows file-info ( path -- info ) - normalize-path get-file-information-stat ; + normalize-path + [ get-file-information-stat ] + [ set-windows-size-on-disk ] bi ; M: windows link-info ( path -- info ) file-info ; diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 4d3dd81a0e..1a513df186 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -1139,7 +1139,8 @@ FUNCTION: BOOL GetCommState ( HANDLE hFile, LPDCB lpDCB ) ; ! FUNCTION: GetCommTimeouts ! FUNCTION: GetComPlusPackageInstallStatus ! FUNCTION: GetCompressedFileSizeA -! FUNCTION: GetCompressedFileSizeW +FUNCTION: DWORD GetCompressedFileSizeW ( LPCTSTR lpFileName, LPDWORD lpFileSizeHigh ) ; +ALIAS: GetCompressedFileSize GetCompressedFileSizeW FUNCTION: BOOL GetComputerNameW ( LPTSTR lpBuffer, LPDWORD lpnSize ) ; ALIAS: GetComputerName GetComputerNameW FUNCTION: BOOL GetComputerNameExW ( COMPUTER_NAME_FORMAT NameType, LPTSTR lpBuffer, LPDWORD lpnSize ) ; From 12a89f15500cc5ff9b6a7fcdf08ede7e8ce391ca Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 17:25:18 -0500 Subject: [PATCH 24/29] fix size-on-disk for unix --- basis/io/files/info/unix/unix.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index d4762a536d..11fa3130d1 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -80,7 +80,7 @@ M: unix stat>file-info ( stat -- file-info ) [ stat-st_rdev >>rdev ] [ stat-st_blocks >>blocks ] [ stat-st_blksize >>blocksize ] - [ drop blocks>> blocksize>> * >>size-on-disk ] + [ drop dup [ blocks>> ] [ blocksize>> ] bi * >>size-on-disk ] } cleave ; : n>file-type ( n -- type ) From bd6eb42d0f48b412228dbc073ac4a31bdacd9f7a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 17:44:12 -0500 Subject: [PATCH 25/29] fix size-on-disk for unix --- basis/io/files/info/unix/unix.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index 11fa3130d1..80f4b74ac8 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -63,6 +63,8 @@ M: unix link-info ( path -- info ) M: unix new-file-info ( -- class ) unix-file-info new ; +CONSTANT: standard-unix-block-size 512 + M: unix stat>file-info ( stat -- file-info ) [ new-file-info ] dip { @@ -80,7 +82,7 @@ M: unix stat>file-info ( stat -- file-info ) [ stat-st_rdev >>rdev ] [ stat-st_blocks >>blocks ] [ stat-st_blksize >>blocksize ] - [ drop dup [ blocks>> ] [ blocksize>> ] bi * >>size-on-disk ] + [ drop dup blocks>> standard-unix-block-size * >>size-on-disk ] } cleave ; : n>file-type ( n -- type ) From bf0b1e63c812a2eb835165de55d93d0d19cd2e78 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 17:50:26 -0500 Subject: [PATCH 26/29] use link-info instead of file-info --- basis/io/directories/search/search.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 38d8ec957e..236da09489 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -83,15 +83,15 @@ ERROR: file-not-found ; ] with-directory ; inline : directory-size ( path -- n ) - 0 swap t [ file-info size-on-disk>> + ] each-file ; + 0 swap t [ link-info size-on-disk>> + ] each-file ; -: path>sizes ( path -- assoc ) +: directory-usage ( path -- assoc ) [ [ [ name>> dup ] [ directory? ] bi [ directory-size ] [ - file-info size-on-disk>> + link-info size-on-disk>> ] if ] { } map>assoc ] with-qualified-directory-entries sort-values ; From 3af8f7fba128fc6781c45a7053cd5ba203e8aeb9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 19:11:07 -0500 Subject: [PATCH 27/29] search for emacs.exe on windows by default --- basis/editors/emacs/emacs.factor | 5 ++++- basis/editors/emacs/windows/windows.factor | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 366bc53104..31fcaf114e 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -11,7 +11,10 @@ M: object default-emacsclient ( -- path ) "emacsclient" ; : emacsclient ( file line -- ) [ - { [ emacsclient-path get ] [ default-emacsclient ] } 0|| , + { + [ emacsclient-path get-global ] + [ default-emacsclient dup emacsclient-path set-global ] + } 0|| , "--no-wait" , number>string "+" prepend , , diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor index 91d6e878e4..0b8efcf3ae 100755 --- a/basis/editors/emacs/windows/windows.factor +++ b/basis/editors/emacs/windows/windows.factor @@ -8,5 +8,5 @@ M: windows default-emacsclient { [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ] [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ] - [ "emacsclient.exe" ] + [ "emacs.exe" ] } 0|| ; From 3d895de0cc9468aa3d3bde14d549e1f1ddb09ae1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 19:11:47 -0500 Subject: [PATCH 28/29] oops, really search for emacs.exe --- basis/editors/emacs/windows/windows.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor index 0b8efcf3ae..0fb6c8e68c 100755 --- a/basis/editors/emacs/windows/windows.factor +++ b/basis/editors/emacs/windows/windows.factor @@ -8,5 +8,6 @@ M: windows default-emacsclient { [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ] [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ] + [ "Emacs" [ "emacs.exe" tail? ] find-in-program-files ] [ "emacs.exe" ] } 0|| ; From be2639c1680f04416d8be3e0405b5afaa834c169 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 19:52:50 -0500 Subject: [PATCH 29/29] look for emacsclient.exe not emacs.exe --- basis/editors/emacs/windows/windows.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor index 0fb6c8e68c..91d6e878e4 100755 --- a/basis/editors/emacs/windows/windows.factor +++ b/basis/editors/emacs/windows/windows.factor @@ -8,6 +8,5 @@ M: windows default-emacsclient { [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ] [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ] - [ "Emacs" [ "emacs.exe" tail? ] find-in-program-files ] - [ "emacs.exe" ] + [ "emacsclient.exe" ] } 0|| ;